Mercurial > octave-nkf
annotate src/ov-fcn-handle.cc @ 7756:45de7d8dac72
ov-fcn-handle.cc (Ffunctions): fix structure assignment
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Sun, 04 May 2008 23:46:35 -0400 |
parents | 0ff0fc033f28 |
children | 5adeea5de26c |
rev | line source |
---|---|
4343 | 1 /* |
2 | |
7017 | 3 Copyright (C) 2003, 2004, 2005, 2006, 2007 John W. Eaton |
4343 | 4 |
5 This file is part of Octave. | |
6 | |
7 Octave is free software; you can redistribute it and/or modify it | |
8 under the terms of the GNU General Public License as published by the | |
7016 | 9 Free Software Foundation; either version 3 of the License, or (at your |
10 option) any later version. | |
4343 | 11 |
12 Octave is distributed in the hope that it will be useful, but WITHOUT | |
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
15 for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
7016 | 18 along with Octave; see the file COPYING. If not, see |
19 <http://www.gnu.org/licenses/>. | |
4343 | 20 |
21 */ | |
22 | |
23 #ifdef HAVE_CONFIG_H | |
24 #include <config.h> | |
25 #endif | |
26 | |
27 #include <iostream> | |
5765 | 28 #include <sstream> |
5164 | 29 #include <vector> |
4343 | 30 |
7336 | 31 #include "file-ops.h" |
32 | |
4343 | 33 #include "defun.h" |
4654 | 34 #include "error.h" |
35 #include "gripes.h" | |
5663 | 36 #include "input.h" |
4343 | 37 #include "oct-map.h" |
38 #include "ov-base.h" | |
39 #include "ov-fcn-handle.h" | |
4980 | 40 #include "ov-usr-fcn.h" |
4343 | 41 #include "pr-output.h" |
4980 | 42 #include "pt-pr-code.h" |
43 #include "pt-misc.h" | |
44 #include "pt-stmt.h" | |
45 #include "pt-cmd.h" | |
46 #include "pt-exp.h" | |
47 #include "pt-assign.h" | |
4343 | 48 #include "variables.h" |
4988 | 49 #include "parse.h" |
6625 | 50 #include "unwind-prot.h" |
51 #include "defaults.h" | |
52 #include "file-stat.h" | |
53 #include "load-path.h" | |
54 #include "oct-env.h" | |
4988 | 55 |
56 #include "byte-swap.h" | |
57 #include "ls-oct-ascii.h" | |
6625 | 58 #include "ls-oct-binary.h" |
4988 | 59 #include "ls-hdf5.h" |
60 #include "ls-utils.h" | |
4343 | 61 |
62 DEFINE_OCTAVE_ALLOCATOR (octave_fcn_handle); | |
63 | |
4612 | 64 DEFINE_OV_TYPEID_FUNCTIONS_AND_DATA (octave_fcn_handle, |
65 "function handle", | |
5946 | 66 "function_handle"); |
4343 | 67 |
4924 | 68 octave_value_list |
69 octave_fcn_handle::subsref (const std::string& type, | |
70 const std::list<octave_value_list>& idx, | |
71 int nargout) | |
72 { | |
73 octave_value_list retval; | |
74 | |
75 switch (type[0]) | |
76 { | |
77 case '(': | |
78 { | |
7336 | 79 out_of_date_check (fcn); |
5663 | 80 |
7336 | 81 if (fcn.is_defined ()) |
82 { | |
83 octave_function *f = function_value (); | |
5663 | 84 |
7336 | 85 if (f) |
86 retval = f->subsref (type, idx, nargout); | |
5663 | 87 else |
7336 | 88 error ("invalid function handle"); |
5663 | 89 } |
5312 | 90 else |
91 error ("invalid function handle"); | |
4924 | 92 } |
93 break; | |
94 | |
95 case '{': | |
96 case '.': | |
97 { | |
4930 | 98 std::string typ_nm = type_name (); |
99 error ("%s cannot be indexed with %c", typ_nm.c_str (), type[0]); | |
4924 | 100 } |
101 break; | |
102 | |
103 default: | |
104 panic_impossible (); | |
105 } | |
106 | |
7689
a9d25da4ed9c
octave_fcn_handle::subsref: don't call next_subsref
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
107 // There's no need to call next_subsref here -- |
a9d25da4ed9c
octave_fcn_handle::subsref: don't call next_subsref
John W. Eaton <jwe@octave.org>
parents:
7336
diff
changeset
|
108 // octave_function::subsref will handle that for us. |
4924 | 109 |
110 return retval; | |
111 } | |
112 | |
4988 | 113 bool |
6625 | 114 octave_fcn_handle::set_fcn (const std::string &octaveroot, |
115 const std::string& fpath) | |
4988 | 116 { |
6625 | 117 bool success = true; |
118 | |
7745
0ff0fc033f28
better handling of functions found by relative lookup
John W. Eaton <jwe@octave.org>
parents:
7744
diff
changeset
|
119 if (octaveroot.length () != 0 |
0ff0fc033f28
better handling of functions found by relative lookup
John W. Eaton <jwe@octave.org>
parents:
7744
diff
changeset
|
120 && fpath.length () >= octaveroot.length () |
0ff0fc033f28
better handling of functions found by relative lookup
John W. Eaton <jwe@octave.org>
parents:
7744
diff
changeset
|
121 && fpath.substr (0, octaveroot.length ()) == octaveroot |
0ff0fc033f28
better handling of functions found by relative lookup
John W. Eaton <jwe@octave.org>
parents:
7744
diff
changeset
|
122 && OCTAVE_EXEC_PREFIX != octaveroot) |
6625 | 123 { |
124 // First check if just replacing matlabroot is enough | |
125 std::string str = OCTAVE_EXEC_PREFIX + | |
126 fpath.substr (octaveroot.length ()); | |
127 file_stat fs (str); | |
128 | |
129 if (fs.exists ()) | |
130 { | |
7336 | 131 size_t xpos = str.find_last_of (file_ops::dir_sep_chars); |
6625 | 132 |
7336 | 133 std::string dir_name = str.substr (0, xpos); |
6625 | 134 |
7336 | 135 octave_function *xfcn |
136 = load_fcn_from_file (str, dir_name, "", nm); | |
6625 | 137 |
7336 | 138 if (xfcn) |
139 { | |
140 octave_value tmp (xfcn); | |
6625 | 141 |
7336 | 142 fcn = octave_value (new octave_fcn_handle (tmp, nm)); |
6625 | 143 } |
144 else | |
145 { | |
146 error ("function handle points to non-existent function"); | |
147 success = false; | |
148 } | |
149 } | |
150 else | |
151 { | |
152 // Next just search for it anywhere in the system path | |
153 string_vector names(3); | |
154 names(0) = nm + ".oct"; | |
155 names(1) = nm + ".mex"; | |
156 names(2) = nm + ".m"; | |
157 | |
6626 | 158 dir_path p (load_path::system_path ()); |
6625 | 159 |
160 str = octave_env::make_absolute | |
161 (p.find_first_of (names), octave_env::getcwd ()); | |
162 | |
7336 | 163 size_t xpos = str.find_last_of (file_ops::dir_sep_chars); |
6625 | 164 |
7336 | 165 std::string dir_name = str.substr (0, xpos); |
166 | |
167 octave_function *xfcn = load_fcn_from_file (str, dir_name, "", nm); | |
4989 | 168 |
7336 | 169 if (xfcn) |
170 { | |
171 octave_value tmp (xfcn); | |
6625 | 172 |
7336 | 173 fcn = octave_value (new octave_fcn_handle (tmp, nm)); |
6625 | 174 } |
175 else | |
176 { | |
177 error ("function handle points to non-existent function"); | |
178 success = false; | |
179 } | |
180 } | |
181 } | |
182 else | |
183 { | |
184 if (fpath.length () > 0) | |
185 { | |
7336 | 186 size_t xpos = fpath.find_last_of (file_ops::dir_sep_chars); |
6625 | 187 |
7336 | 188 std::string dir_name = fpath.substr (0, xpos); |
189 | |
190 octave_function *xfcn = load_fcn_from_file (fpath, dir_name, "", nm); | |
6625 | 191 |
7336 | 192 if (xfcn) |
193 { | |
194 octave_value tmp (xfcn); | |
6625 | 195 |
7336 | 196 fcn = octave_value (new octave_fcn_handle (tmp, nm)); |
6625 | 197 } |
198 else | |
199 { | |
200 error ("function handle points to non-existent function"); | |
201 success = false; | |
202 } | |
203 } | |
204 else | |
205 { | |
7336 | 206 fcn = symbol_table::find_function (nm); |
207 | |
6625 | 208 if (! fcn.is_function ()) |
209 { | |
210 error ("function handle points to non-existent function"); | |
211 success = false; | |
212 } | |
213 } | |
214 } | |
215 | |
216 return success; | |
217 } | |
218 | |
219 bool | |
6974 | 220 octave_fcn_handle::save_ascii (std::ostream& os) |
6625 | 221 { |
4988 | 222 if (nm == "@<anonymous>") |
223 { | |
6625 | 224 os << nm << "\n"; |
225 | |
4989 | 226 print_raw (os, true); |
227 os << "\n"; | |
6625 | 228 |
7336 | 229 if (fcn.is_undefined ()) |
6625 | 230 return false; |
231 | |
232 octave_user_function *f = fcn.user_function_value (); | |
233 | |
7336 | 234 std::list<symbol_table::symbol_record> vars |
235 = symbol_table::all_variables (f->scope ()); | |
6625 | 236 |
7336 | 237 size_t varlen = vars.size (); |
6625 | 238 |
239 if (varlen > 0) | |
240 { | |
241 os << "# length: " << varlen << "\n"; | |
242 | |
7336 | 243 for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin (); |
244 p != vars.end (); p++) | |
6625 | 245 { |
7336 | 246 if (! save_ascii_data (os, p->varval (), p->name (), false, 0)) |
6625 | 247 return os; |
248 } | |
249 } | |
250 } | |
251 else | |
252 { | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
253 octave_function *f = function_value (); |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
254 std::string fnm = f ? f->fcn_file_name () : std::string (); |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
255 |
6625 | 256 os << "# octaveroot: " << OCTAVE_EXEC_PREFIX << "\n"; |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
257 if (! fnm.empty ()) |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
258 os << "# path: " << fnm << "\n"; |
6625 | 259 os << nm << "\n"; |
4988 | 260 } |
261 | |
262 return true; | |
263 } | |
264 | |
265 bool | |
266 octave_fcn_handle::load_ascii (std::istream& is) | |
267 { | |
6625 | 268 bool success = true; |
269 | |
270 std::streampos pos = is.tellg (); | |
271 std::string octaveroot = extract_keyword (is, "octaveroot", true); | |
272 if (octaveroot.length() == 0) | |
273 { | |
274 is.seekg (pos); | |
275 is.clear (); | |
276 } | |
277 pos = is.tellg (); | |
278 std::string fpath = extract_keyword (is, "path", true); | |
279 if (fpath.length() == 0) | |
280 { | |
281 is.seekg (pos); | |
282 is.clear (); | |
283 } | |
284 | |
4988 | 285 is >> nm; |
4989 | 286 |
4988 | 287 if (nm == "@<anonymous>") |
288 { | |
6625 | 289 octave_idx_type len = 0; |
4988 | 290 char c; |
5765 | 291 std::ostringstream buf; |
4988 | 292 |
4989 | 293 // Skip preceeding newline(s). |
294 while (is.get (c) && c == '\n') | |
295 /* do nothing */; | |
4988 | 296 |
297 if (is) | |
298 { | |
299 buf << c; | |
300 | |
301 // Get a line of text whitespace characters included, leaving | |
4989 | 302 // newline in the stream. |
303 | |
4988 | 304 while (is.peek () != '\n') |
305 { | |
306 is.get (c); | |
307 if (! is) | |
308 break; | |
309 buf << c; | |
310 } | |
311 } | |
312 | |
6625 | 313 pos = is.tellg (); |
7336 | 314 |
315 symbol_table::scope_id local_scope = symbol_table::alloc_scope (); | |
4988 | 316 |
6625 | 317 if (extract_keyword (is, "length", len, true) && len >= 0) |
4989 | 318 { |
6625 | 319 if (len > 0) |
320 { | |
321 for (octave_idx_type i = 0; i < len; i++) | |
322 { | |
323 octave_value t2; | |
324 bool dummy; | |
325 | |
326 std::string name | |
327 = read_ascii_data (is, std::string (), dummy, t2, i); | |
328 | |
329 if (!is) | |
330 { | |
331 error ("load: failed to load anonymous function handle"); | |
332 break; | |
333 } | |
334 | |
7336 | 335 symbol_table::varref (name, local_scope) = t2; |
6625 | 336 } |
337 } | |
4989 | 338 } |
339 else | |
6625 | 340 { |
341 is.seekg (pos); | |
342 is.clear (); | |
343 } | |
344 | |
345 if (is && success) | |
346 { | |
347 unwind_protect::begin_frame ("anon_ascii_load"); | |
348 | |
7336 | 349 symbol_table::push_scope (local_scope); |
350 | |
351 unwind_protect::add (symbol_table::pop_scope); | |
6625 | 352 |
353 int parse_status; | |
354 octave_value anon_fcn_handle = | |
355 eval_string (buf.str (), true, parse_status); | |
356 | |
357 if (parse_status == 0) | |
358 { | |
359 octave_fcn_handle *fh = | |
360 anon_fcn_handle.fcn_handle_value (); | |
361 if (fh) | |
362 fcn = fh->fcn; | |
363 else | |
364 success = false; | |
365 } | |
366 else | |
367 success = false; | |
368 | |
369 unwind_protect::run_frame ("anon_ascii_load"); | |
370 } | |
371 else | |
372 success = false; | |
373 | |
7336 | 374 symbol_table::erase_scope (local_scope); |
4988 | 375 } |
376 else | |
6625 | 377 success = set_fcn (octaveroot, fpath); |
4988 | 378 |
6625 | 379 return success; |
4988 | 380 } |
381 | |
382 bool | |
6625 | 383 octave_fcn_handle::save_binary (std::ostream& os, bool& save_as_floats) |
4988 | 384 { |
385 if (nm == "@<anonymous>") | |
386 { | |
6625 | 387 std::ostringstream nmbuf; |
388 | |
7336 | 389 if (fcn.is_undefined ()) |
6625 | 390 return false; |
391 | |
392 octave_user_function *f = fcn.user_function_value (); | |
393 | |
7336 | 394 std::list<symbol_table::symbol_record> vars |
395 = symbol_table::all_variables (f->scope ()); | |
6625 | 396 |
7336 | 397 size_t varlen = vars.size (); |
6625 | 398 |
399 if (varlen > 0) | |
400 nmbuf << nm << " " << varlen; | |
401 else | |
402 nmbuf << nm; | |
403 | |
404 std::string buf_str = nmbuf.str(); | |
405 int32_t tmp = buf_str.length (); | |
406 os.write (reinterpret_cast<char *> (&tmp), 4); | |
407 os.write (buf_str.c_str (), buf_str.length ()); | |
408 | |
5765 | 409 std::ostringstream buf; |
4988 | 410 print_raw (buf, true); |
5765 | 411 std::string stmp = buf.str (); |
4988 | 412 tmp = stmp.length (); |
5760 | 413 os.write (reinterpret_cast<char *> (&tmp), 4); |
4988 | 414 os.write (stmp.c_str (), stmp.length ()); |
6625 | 415 |
416 if (varlen > 0) | |
417 { | |
7336 | 418 for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin (); |
419 p != vars.end (); p++) | |
6625 | 420 { |
7336 | 421 if (! save_binary_data (os, p->varval (), p->name (), |
6625 | 422 "", 0, save_as_floats)) |
423 return os; | |
424 } | |
425 } | |
426 } | |
427 else | |
428 { | |
429 std::ostringstream nmbuf; | |
430 | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
431 octave_function *f = function_value (); |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
432 std::string fnm = f ? f->fcn_file_name () : std::string (); |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
433 |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
434 nmbuf << nm << "\n" << OCTAVE_EXEC_PREFIX << "\n" << fnm; |
6625 | 435 |
436 std::string buf_str = nmbuf.str (); | |
437 int32_t tmp = buf_str.length (); | |
438 os.write (reinterpret_cast<char *> (&tmp), 4); | |
439 os.write (buf_str.c_str (), buf_str.length ()); | |
4988 | 440 } |
7336 | 441 |
4988 | 442 return true; |
443 } | |
444 | |
445 bool | |
446 octave_fcn_handle::load_binary (std::istream& is, bool swap, | |
6625 | 447 oct_mach_info::float_format fmt) |
4988 | 448 { |
6625 | 449 bool success = true; |
7336 | 450 |
5828 | 451 int32_t tmp; |
5760 | 452 if (! is.read (reinterpret_cast<char *> (&tmp), 4)) |
4988 | 453 return false; |
454 if (swap) | |
455 swap_bytes<4> (&tmp); | |
456 | |
457 OCTAVE_LOCAL_BUFFER (char, ctmp1, tmp+1); | |
458 is.read (ctmp1, tmp); | |
459 nm = std::string (ctmp1); | |
460 | |
461 if (! is) | |
462 return false; | |
463 | |
6625 | 464 if (nm.length() >= 12 && nm.substr (0, 12) == "@<anonymous>") |
4988 | 465 { |
6625 | 466 octave_idx_type len = 0; |
467 | |
468 if (nm.length() > 12) | |
469 { | |
470 std::istringstream nm_is (nm.substr(12)); | |
471 nm_is >> len; | |
472 nm = nm.substr(0,12); | |
473 } | |
474 | |
5760 | 475 if (! is.read (reinterpret_cast<char *> (&tmp), 4)) |
4988 | 476 return false; |
477 if (swap) | |
478 swap_bytes<4> (&tmp); | |
479 | |
480 OCTAVE_LOCAL_BUFFER (char, ctmp2, tmp+1); | |
481 is.read (ctmp2, tmp); | |
482 | |
7336 | 483 symbol_table::scope_id local_scope = symbol_table::alloc_scope (); |
484 | |
6625 | 485 if (len > 0) |
4989 | 486 { |
6625 | 487 for (octave_idx_type i = 0; i < len; i++) |
488 { | |
489 octave_value t2; | |
490 bool dummy; | |
491 std::string doc; | |
492 | |
493 std::string name = | |
494 read_binary_data (is, swap, fmt, std::string (), | |
495 dummy, t2, doc); | |
496 | |
497 if (!is) | |
498 { | |
499 error ("load: failed to load anonymous function handle"); | |
500 break; | |
501 } | |
502 | |
7336 | 503 symbol_table::varref (name, local_scope) = t2; |
6625 | 504 } |
505 } | |
506 | |
507 if (is && success) | |
508 { | |
509 unwind_protect::begin_frame ("anon_binary_load"); | |
510 | |
7336 | 511 symbol_table::push_scope (local_scope); |
512 | |
513 unwind_protect::add (symbol_table::pop_scope); | |
6625 | 514 |
515 int parse_status; | |
516 octave_value anon_fcn_handle = | |
517 eval_string (ctmp2, true, parse_status); | |
518 | |
519 if (parse_status == 0) | |
520 { | |
521 octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); | |
522 if (fh) | |
523 fcn = fh->fcn; | |
524 else | |
525 success = false; | |
526 } | |
4989 | 527 else |
6625 | 528 success = false; |
529 | |
530 unwind_protect::run_frame ("anon_binary_load"); | |
4989 | 531 } |
6625 | 532 |
7336 | 533 symbol_table::erase_scope (local_scope); |
4988 | 534 } |
535 else | |
536 { | |
6625 | 537 std::string octaveroot; |
538 std::string fpath; | |
539 | |
540 if (nm.find_first_of ("\n") != NPOS) | |
6225 | 541 { |
6625 | 542 size_t pos1 = nm.find_first_of ("\n"); |
543 size_t pos2 = nm.find_first_of ("\n", pos1 + 1); | |
544 octaveroot = nm.substr (pos1 + 1, pos2 - pos1 - 1); | |
545 fpath = nm.substr (pos2 + 1); | |
546 nm = nm.substr (0, pos1); | |
6225 | 547 } |
6625 | 548 |
549 success = set_fcn (octaveroot, fpath); | |
550 } | |
551 | |
552 return success; | |
4988 | 553 } |
554 | |
555 #if defined (HAVE_HDF5) | |
556 bool | |
557 octave_fcn_handle::save_hdf5 (hid_t loc_id, const char *name, | |
6625 | 558 bool save_as_floats) |
4988 | 559 { |
7336 | 560 bool retval = true; |
561 | |
4988 | 562 hid_t group_hid = -1; |
563 group_hid = H5Gcreate (loc_id, name, 0); | |
7336 | 564 if (group_hid < 0) |
565 return false; | |
4988 | 566 |
567 hid_t space_hid = -1, data_hid = -1, type_hid = -1;; | |
568 | |
569 // attach the type of the variable | |
570 type_hid = H5Tcopy (H5T_C_S1); | |
571 H5Tset_size (type_hid, nm.length () + 1); | |
572 if (type_hid < 0) | |
573 { | |
574 H5Gclose (group_hid); | |
575 return false; | |
576 } | |
577 | |
578 OCTAVE_LOCAL_BUFFER (hsize_t, hdims, 2); | |
579 hdims[0] = 0; | |
580 hdims[1] = 0; | |
5760 | 581 space_hid = H5Screate_simple (0 , hdims, 0); |
4988 | 582 if (space_hid < 0) |
583 { | |
584 H5Tclose (type_hid); | |
585 H5Gclose (group_hid); | |
586 return false; | |
587 } | |
588 | |
589 data_hid = H5Dcreate (group_hid, "nm", type_hid, space_hid, H5P_DEFAULT); | |
590 if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, | |
5760 | 591 H5P_DEFAULT, nm.c_str ()) < 0) |
4988 | 592 { |
593 H5Sclose (space_hid); | |
594 H5Tclose (type_hid); | |
595 H5Gclose (group_hid); | |
596 return false; | |
597 } | |
598 H5Dclose (data_hid); | |
599 | |
600 if (nm == "@<anonymous>") | |
601 { | |
5765 | 602 std::ostringstream buf; |
4988 | 603 print_raw (buf, true); |
5765 | 604 std::string stmp = buf.str (); |
4988 | 605 |
606 // attach the type of the variable | |
607 H5Tset_size (type_hid, stmp.length () + 1); | |
608 if (type_hid < 0) | |
609 { | |
6695 | 610 H5Sclose (space_hid); |
4988 | 611 H5Gclose (group_hid); |
612 return false; | |
613 } | |
614 | |
615 data_hid = H5Dcreate (group_hid, "fcn", type_hid, space_hid, | |
616 H5P_DEFAULT); | |
617 if (data_hid < 0 || H5Dwrite (data_hid, type_hid, H5S_ALL, H5S_ALL, | |
5760 | 618 H5P_DEFAULT, stmp.c_str ()) < 0) |
4988 | 619 { |
620 H5Sclose (space_hid); | |
621 H5Tclose (type_hid); | |
622 H5Gclose (group_hid); | |
623 return false; | |
624 } | |
625 | |
626 H5Dclose (data_hid); | |
6625 | 627 |
628 octave_user_function *f = fcn.user_function_value (); | |
629 | |
7336 | 630 std::list<symbol_table::symbol_record> vars |
631 = symbol_table::all_variables (f->scope ()); | |
632 | |
633 size_t varlen = vars.size (); | |
6625 | 634 |
635 if (varlen > 0) | |
636 { | |
637 hid_t as_id = H5Screate (H5S_SCALAR); | |
638 | |
639 if (as_id >= 0) | |
640 { | |
641 hid_t a_id = H5Acreate (group_hid, "SYMBOL_TABLE", | |
642 H5T_NATIVE_IDX, as_id, H5P_DEFAULT); | |
643 | |
644 if (a_id >= 0) | |
645 { | |
646 retval = (H5Awrite (a_id, H5T_NATIVE_IDX, &varlen) >= 0); | |
647 | |
648 H5Aclose (a_id); | |
649 } | |
650 else | |
651 retval = false; | |
652 | |
653 H5Sclose (as_id); | |
654 } | |
655 else | |
656 retval = false; | |
657 | |
658 data_hid = H5Gcreate (group_hid, "symbol table", 0); | |
659 if (data_hid < 0) | |
660 { | |
661 H5Sclose (space_hid); | |
662 H5Tclose (type_hid); | |
663 H5Gclose (group_hid); | |
664 return false; | |
665 } | |
666 | |
7336 | 667 for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin (); |
668 p != vars.end (); p++) | |
6625 | 669 { |
7336 | 670 if (! add_hdf5_data (data_hid, p->varval (), p->name (), |
6625 | 671 "", false, save_as_floats)) |
672 break; | |
673 } | |
674 H5Gclose (data_hid); | |
675 } | |
676 } | |
677 else | |
678 { | |
679 std::string octaveroot = OCTAVE_EXEC_PREFIX; | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
680 |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
681 octave_function *f = function_value (); |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
682 std::string fpath = f ? f->fcn_file_name () : std::string (); |
6625 | 683 |
684 H5Sclose (space_hid); | |
685 hdims[0] = 1; | |
686 hdims[1] = octaveroot.length (); | |
687 space_hid = H5Screate_simple (0 , hdims, 0); | |
688 if (space_hid < 0) | |
689 { | |
690 H5Tclose (type_hid); | |
691 H5Gclose (group_hid); | |
692 return false; | |
693 } | |
694 | |
695 H5Tclose (type_hid); | |
696 type_hid = H5Tcopy (H5T_C_S1); | |
697 H5Tset_size (type_hid, octaveroot.length () + 1); | |
698 | |
699 hid_t a_id = H5Acreate (group_hid, "OCTAVEROOT", | |
700 type_hid, space_hid, H5P_DEFAULT); | |
701 | |
702 if (a_id >= 0) | |
703 { | |
704 retval = (H5Awrite (a_id, type_hid, octaveroot.c_str ()) >= 0); | |
705 | |
706 H5Aclose (a_id); | |
707 } | |
708 else | |
6695 | 709 { |
710 H5Sclose (space_hid); | |
711 H5Tclose (type_hid); | |
712 H5Gclose (group_hid); | |
713 return false; | |
714 } | |
6625 | 715 |
716 H5Sclose (space_hid); | |
717 hdims[0] = 1; | |
718 hdims[1] = fpath.length (); | |
719 space_hid = H5Screate_simple (0 , hdims, 0); | |
720 if (space_hid < 0) | |
721 { | |
722 H5Tclose (type_hid); | |
723 H5Gclose (group_hid); | |
724 return false; | |
725 } | |
726 | |
727 H5Tclose (type_hid); | |
728 type_hid = H5Tcopy (H5T_C_S1); | |
729 H5Tset_size (type_hid, fpath.length () + 1); | |
730 | |
731 a_id = H5Acreate (group_hid, "FILE", type_hid, space_hid, H5P_DEFAULT); | |
732 | |
733 if (a_id >= 0) | |
734 { | |
735 retval = (H5Awrite (a_id, type_hid, fpath.c_str ()) >= 0); | |
736 | |
737 H5Aclose (a_id); | |
738 } | |
739 else | |
740 retval = false; | |
4988 | 741 } |
742 | |
743 H5Sclose (space_hid); | |
744 H5Tclose (type_hid); | |
745 H5Gclose (group_hid); | |
746 | |
747 return retval; | |
748 } | |
749 | |
750 bool | |
751 octave_fcn_handle::load_hdf5 (hid_t loc_id, const char *name, | |
6625 | 752 bool have_h5giterate_bug) |
4988 | 753 { |
7336 | 754 bool success = true; |
755 | |
4988 | 756 hid_t group_hid, data_hid, space_hid, type_hid, type_class_hid, st_id; |
757 hsize_t rank; | |
758 int slen; | |
759 | |
760 group_hid = H5Gopen (loc_id, name); | |
7336 | 761 if (group_hid < 0) |
762 return false; | |
4988 | 763 |
764 data_hid = H5Dopen (group_hid, "nm"); | |
765 | |
766 if (data_hid < 0) | |
767 { | |
768 H5Gclose (group_hid); | |
769 return false; | |
770 } | |
771 | |
772 type_hid = H5Dget_type (data_hid); | |
773 type_class_hid = H5Tget_class (type_hid); | |
774 | |
775 if (type_class_hid != H5T_STRING) | |
776 { | |
777 H5Tclose (type_hid); | |
778 H5Dclose (data_hid); | |
779 H5Gclose (group_hid); | |
780 return false; | |
781 } | |
782 | |
783 space_hid = H5Dget_space (data_hid); | |
784 rank = H5Sget_simple_extent_ndims (space_hid); | |
785 | |
786 if (rank != 0) | |
787 { | |
788 H5Sclose (space_hid); | |
789 H5Tclose (type_hid); | |
790 H5Dclose (data_hid); | |
791 H5Gclose (group_hid); | |
792 return false; | |
793 } | |
794 | |
795 slen = H5Tget_size (type_hid); | |
796 if (slen < 0) | |
797 { | |
798 H5Sclose (space_hid); | |
799 H5Tclose (type_hid); | |
800 H5Dclose (data_hid); | |
801 H5Gclose (group_hid); | |
802 return false; | |
803 } | |
804 | |
805 OCTAVE_LOCAL_BUFFER (char, nm_tmp, slen); | |
806 | |
807 // create datatype for (null-terminated) string to read into: | |
808 st_id = H5Tcopy (H5T_C_S1); | |
809 H5Tset_size (st_id, slen); | |
810 | |
5760 | 811 if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, nm_tmp) < 0) |
4988 | 812 { |
6695 | 813 H5Tclose (st_id); |
4988 | 814 H5Sclose (space_hid); |
815 H5Tclose (type_hid); | |
6695 | 816 H5Dclose (data_hid); |
4988 | 817 H5Gclose (group_hid); |
818 return false; | |
819 } | |
820 H5Tclose (st_id); | |
821 H5Dclose (data_hid); | |
822 nm = nm_tmp; | |
823 | |
824 if (nm == "@<anonymous>") | |
825 { | |
826 data_hid = H5Dopen (group_hid, "fcn"); | |
827 | |
828 if (data_hid < 0) | |
829 { | |
6695 | 830 H5Sclose (space_hid); |
831 H5Tclose (type_hid); | |
4988 | 832 H5Gclose (group_hid); |
833 return false; | |
834 } | |
835 | |
6695 | 836 H5Tclose (type_hid); |
4988 | 837 type_hid = H5Dget_type (data_hid); |
838 type_class_hid = H5Tget_class (type_hid); | |
839 | |
840 if (type_class_hid != H5T_STRING) | |
841 { | |
6695 | 842 H5Sclose (space_hid); |
4988 | 843 H5Tclose (type_hid); |
844 H5Dclose (data_hid); | |
845 H5Gclose (group_hid); | |
846 return false; | |
847 } | |
848 | |
6695 | 849 H5Sclose (space_hid); |
4988 | 850 space_hid = H5Dget_space (data_hid); |
851 rank = H5Sget_simple_extent_ndims (space_hid); | |
852 | |
853 if (rank != 0) | |
854 { | |
855 H5Sclose (space_hid); | |
856 H5Tclose (type_hid); | |
857 H5Dclose (data_hid); | |
858 H5Gclose (group_hid); | |
859 return false; | |
860 } | |
861 | |
862 slen = H5Tget_size (type_hid); | |
863 if (slen < 0) | |
864 { | |
865 H5Sclose (space_hid); | |
866 H5Tclose (type_hid); | |
867 H5Dclose (data_hid); | |
868 H5Gclose (group_hid); | |
869 return false; | |
870 } | |
871 | |
872 OCTAVE_LOCAL_BUFFER (char, fcn_tmp, slen); | |
873 | |
874 // create datatype for (null-terminated) string to read into: | |
875 st_id = H5Tcopy (H5T_C_S1); | |
876 H5Tset_size (st_id, slen); | |
877 | |
5760 | 878 if (H5Dread (data_hid, st_id, H5S_ALL, H5S_ALL, H5P_DEFAULT, fcn_tmp) < 0) |
4988 | 879 { |
6695 | 880 H5Tclose (st_id); |
4988 | 881 H5Sclose (space_hid); |
882 H5Tclose (type_hid); | |
6695 | 883 H5Dclose (data_hid); |
4988 | 884 H5Gclose (group_hid); |
885 return false; | |
886 } | |
6695 | 887 H5Tclose (st_id); |
4988 | 888 H5Dclose (data_hid); |
6625 | 889 |
890 octave_idx_type len = 0; | |
891 | |
892 // we have to pull some shenanigans here to make sure | |
893 // HDF5 doesn't print out all sorts of error messages if we | |
894 // call H5Aopen for a non-existing attribute | |
895 | |
896 H5E_auto_t err_func; | |
897 void *err_func_data; | |
4988 | 898 |
6625 | 899 // turn off error reporting temporarily, but save the error |
900 // reporting function: | |
901 H5Eget_auto (&err_func, &err_func_data); | |
902 H5Eset_auto (0, 0); | |
903 | |
904 hid_t attr_id = H5Aopen_name (group_hid, "SYMBOL_TABLE"); | |
4988 | 905 |
6625 | 906 if (attr_id >= 0) |
907 { | |
908 if (H5Aread (attr_id, H5T_NATIVE_IDX, &len) < 0) | |
909 success = false; | |
910 | |
911 H5Aclose (attr_id); | |
912 } | |
913 | |
914 // restore error reporting: | |
915 H5Eset_auto (err_func, err_func_data); | |
916 | |
7336 | 917 symbol_table::scope_id local_scope = symbol_table::alloc_scope (); |
918 | |
6625 | 919 if (len > 0 && success) |
4989 | 920 { |
6625 | 921 #ifdef HAVE_H5GGET_NUM_OBJS |
922 hsize_t num_obj = 0; | |
923 data_hid = H5Gopen (group_hid, "symbol table"); | |
924 H5Gget_num_objs (data_hid, &num_obj); | |
925 H5Gclose (data_hid); | |
926 | |
927 if (num_obj != static_cast<hsize_t>(len)) | |
928 { | |
929 error ("load: failed to load anonymous function handle"); | |
930 success = false; | |
931 } | |
932 #endif | |
933 | |
934 if (! error_state) | |
935 { | |
936 hdf5_callback_data dsub; | |
937 int current_item = 0; | |
938 for (octave_idx_type i = 0; i < len; i++) | |
939 { | |
940 if (H5Giterate (group_hid, "symbol table", ¤t_item, | |
941 hdf5_read_next_data, &dsub) <= 0) | |
942 { | |
943 error ("load: failed to load anonymous function handle"); | |
944 success = false; | |
945 break; | |
946 } | |
947 | |
948 if (have_h5giterate_bug) | |
949 current_item++; // H5Giterate returns last index processed | |
950 | |
7336 | 951 symbol_table::varref (dsub.name, local_scope) = dsub.tc; |
6625 | 952 } |
953 } | |
954 } | |
955 | |
956 if (success) | |
957 { | |
958 unwind_protect::begin_frame ("anon_hdf5_load"); | |
959 | |
7336 | 960 symbol_table::push_scope (local_scope); |
961 | |
962 unwind_protect::add (symbol_table::pop_scope); | |
6625 | 963 |
964 int parse_status; | |
965 octave_value anon_fcn_handle = | |
966 eval_string (fcn_tmp, true, parse_status); | |
967 | |
968 if (parse_status == 0) | |
969 { | |
970 octave_fcn_handle *fh = anon_fcn_handle.fcn_handle_value (); | |
971 if (fh) | |
972 fcn = fh->fcn; | |
973 else | |
974 success = false; | |
975 } | |
4989 | 976 else |
6625 | 977 success = false; |
978 | |
979 unwind_protect::run_frame ("anon_hdf5_load"); | |
4989 | 980 } |
6625 | 981 |
7336 | 982 symbol_table::erase_scope (local_scope); |
4988 | 983 } |
984 else | |
985 { | |
6625 | 986 std::string octaveroot; |
987 std::string fpath; | |
988 | |
989 // we have to pull some shenanigans here to make sure | |
990 // HDF5 doesn't print out all sorts of error messages if we | |
991 // call H5Aopen for a non-existing attribute | |
992 | |
993 H5E_auto_t err_func; | |
994 void *err_func_data; | |
995 | |
996 // turn off error reporting temporarily, but save the error | |
997 // reporting function: | |
998 H5Eget_auto (&err_func, &err_func_data); | |
999 H5Eset_auto (0, 0); | |
1000 | |
1001 hid_t attr_id = H5Aopen_name (group_hid, "OCTAVEROOT"); | |
1002 if (attr_id >= 0) | |
6225 | 1003 { |
6695 | 1004 H5Tclose (type_hid); |
6625 | 1005 type_hid = H5Aget_type (attr_id); |
1006 type_class_hid = H5Tget_class (type_hid); | |
1007 | |
1008 if (type_class_hid != H5T_STRING) | |
1009 success = false; | |
1010 else | |
1011 { | |
1012 slen = H5Tget_size (type_hid); | |
1013 st_id = H5Tcopy (H5T_C_S1); | |
1014 H5Tset_size (st_id, slen); | |
1015 OCTAVE_LOCAL_BUFFER (char, root_tmp, slen); | |
1016 | |
1017 if (H5Aread (attr_id, st_id, root_tmp) < 0) | |
1018 success = false; | |
1019 else | |
1020 octaveroot = root_tmp; | |
6695 | 1021 |
1022 H5Tclose (st_id); | |
6625 | 1023 } |
1024 | |
1025 H5Aclose (attr_id); | |
6225 | 1026 } |
6625 | 1027 |
6695 | 1028 if (success) |
6625 | 1029 { |
6695 | 1030 attr_id = H5Aopen_name (group_hid, "FILE"); |
1031 if (attr_id >= 0) | |
1032 { | |
1033 H5Tclose (type_hid); | |
1034 type_hid = H5Aget_type (attr_id); | |
1035 type_class_hid = H5Tget_class (type_hid); | |
6625 | 1036 |
6695 | 1037 if (type_class_hid != H5T_STRING) |
6625 | 1038 success = false; |
1039 else | |
6695 | 1040 { |
1041 slen = H5Tget_size (type_hid); | |
1042 st_id = H5Tcopy (H5T_C_S1); | |
1043 H5Tset_size (st_id, slen); | |
1044 OCTAVE_LOCAL_BUFFER (char, path_tmp, slen); | |
1045 | |
1046 if (H5Aread (attr_id, st_id, path_tmp) < 0) | |
1047 success = false; | |
1048 else | |
1049 fpath = path_tmp; | |
1050 | |
1051 H5Tclose (st_id); | |
1052 } | |
1053 | |
1054 H5Aclose (attr_id); | |
6625 | 1055 } |
1056 } | |
1057 | |
1058 // restore error reporting: | |
1059 H5Eset_auto (err_func, err_func_data); | |
1060 | |
1061 success = (success ? set_fcn (octaveroot, fpath) : success); | |
4988 | 1062 } |
1063 | |
6695 | 1064 H5Tclose (type_hid); |
1065 H5Sclose (space_hid); | |
1066 H5Gclose (group_hid); | |
1067 | |
6625 | 1068 return success; |
4988 | 1069 } |
6625 | 1070 |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1071 #endif |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1072 |
6625 | 1073 /* |
1074 | |
1075 %!test | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1076 %! a = 2; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1077 %! f = @(x) a + x; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1078 %! g = @(x) 2 * x; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1079 %! hm = @flops; |
7745
0ff0fc033f28
better handling of functions found by relative lookup
John W. Eaton <jwe@octave.org>
parents:
7744
diff
changeset
|
1080 %! hdld = @svd; |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1081 %! hbi = @log2; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1082 %! f2 = f; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1083 %! g2 = g; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1084 %! hm2 = hm; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1085 %! hdld2 = hdld; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1086 %! hbi2 = hbi; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1087 %! modes = {"-text", "-binary"}; |
6625 | 1088 %! if (!isempty(findstr(octave_config_info ("DEFS"),"HAVE_HDF5"))) |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1089 %! modes(end+1) = "-hdf5"; |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1090 %! endif |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1091 %! for i = modes |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1092 %! mode = modes{1}; |
6625 | 1093 %! nm = tmpnam(); |
1094 %! unwind_protect | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1095 %! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2"); |
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1096 %! clear f2 g2 hm2 hdld2 hbi2 |
6625 | 1097 %! load (nm); |
1098 %! assert (f(2),f2(2)); | |
1099 %! assert (g(2),g2(2)); | |
1100 %! assert (g(3),g2(3)); | |
1101 %! unlink (nm); | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1102 %! save (mode, nm, "f2", "g2", "hm2", "hdld2", "hbi2"); |
6625 | 1103 %! unwind_protect_cleanup |
1104 %! unlink (nm); | |
1105 %! end_unwind_protect | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1106 %! endfor |
6625 | 1107 |
1108 */ | |
4988 | 1109 |
4343 | 1110 void |
1111 octave_fcn_handle::print (std::ostream& os, bool pr_as_read_syntax) const | |
1112 { | |
1113 print_raw (os, pr_as_read_syntax); | |
1114 newline (os); | |
1115 } | |
1116 | |
1117 void | |
1118 octave_fcn_handle::print_raw (std::ostream& os, bool pr_as_read_syntax) const | |
1119 { | |
4980 | 1120 bool printed = false; |
1121 | |
1122 if (nm == "@<anonymous>") | |
1123 { | |
1124 tree_print_code tpc (os); | |
1125 | |
4989 | 1126 // FCN is const because this member function is, so we can't |
4980 | 1127 // use it to call user_function_value, so we make a copy first. |
1128 | |
1129 octave_value ftmp = fcn; | |
1130 | |
1131 octave_user_function *f = ftmp.user_function_value (); | |
1132 | |
1133 if (f) | |
1134 { | |
1135 tree_parameter_list *p = f->parameter_list (); | |
1136 | |
1137 os << "@("; | |
1138 | |
1139 if (p) | |
1140 p->accept (tpc); | |
1141 | |
1142 os << ") "; | |
1143 | |
1144 tree_statement_list *b = f->body (); | |
1145 | |
1146 if (b) | |
1147 { | |
1148 assert (b->length () == 1); | |
1149 | |
1150 tree_statement *s = b->front (); | |
1151 | |
1152 if (s) | |
1153 { | |
1154 if (s->is_expression ()) | |
1155 { | |
1156 tree_expression *e = s->expression (); | |
1157 | |
1158 if (e) | |
6657 | 1159 e->accept (tpc); |
4980 | 1160 } |
1161 else | |
1162 { | |
1163 tree_command *c = s->command (); | |
1164 | |
1165 tpc.suspend_newline (); | |
1166 c->accept (tpc); | |
1167 tpc.resume_newline (); | |
1168 } | |
1169 } | |
1170 } | |
1171 | |
1172 printed = true; | |
1173 } | |
1174 } | |
1175 | |
1176 if (! printed) | |
1177 octave_print_internal (os, nm, pr_as_read_syntax, | |
1178 current_print_indent_level ()); | |
4343 | 1179 } |
1180 | |
1181 octave_value | |
1182 make_fcn_handle (const std::string& nm) | |
1183 { | |
1184 octave_value retval; | |
1185 | |
7336 | 1186 octave_value f = symbol_table::find_function (nm); |
6481 | 1187 |
7336 | 1188 if (f.is_defined ()) |
4930 | 1189 retval = octave_value (new octave_fcn_handle (f, nm)); |
4343 | 1190 else |
1191 error ("error creating function handle \"@%s\"", nm.c_str ()); | |
1192 | |
1193 return retval; | |
1194 } | |
1195 | |
4933 | 1196 DEFUN (functions, args, , |
4343 | 1197 "-*- texinfo -*-\n\ |
4933 | 1198 @deftypefn {Built-in Function} {} functions (@var{fcn_handle})\n\ |
1199 Return a struct containing information about the function handle\n\ | |
1200 @var{fcn_handle}.\n\ | |
1201 @end deftypefn") | |
4343 | 1202 { |
1203 octave_value retval; | |
1204 | |
4933 | 1205 if (args.length () == 1) |
4343 | 1206 { |
4933 | 1207 octave_fcn_handle *fh = args(0).fcn_handle_value (); |
4343 | 1208 |
1209 if (! error_state) | |
1210 { | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1211 octave_function *fcn = fh ? fh->function_value () : 0; |
4343 | 1212 |
4933 | 1213 if (fcn) |
4930 | 1214 { |
4933 | 1215 Octave_map m; |
4649 | 1216 |
4933 | 1217 std::string fh_nm = fh->fcn_name (); |
1218 | |
6625 | 1219 if (fh_nm == "@<anonymous>") |
1220 { | |
1221 std::ostringstream buf; | |
1222 fh->print_raw (buf); | |
1223 m.assign ("function", buf.str ()); | |
1224 | |
1225 m.assign ("type", "anonymous"); | |
1226 } | |
1227 else | |
1228 { | |
1229 m.assign ("function", fh_nm); | |
4343 | 1230 |
6625 | 1231 if (fcn->is_nested_function ()) |
1232 { | |
1233 m.assign ("type", "subfunction"); | |
1234 Cell parentage (dim_vector (1, 2)); | |
1235 parentage.elem(0) = fh_nm; | |
1236 parentage.elem(1) = fcn->parent_fcn_name (); | |
7756
45de7d8dac72
ov-fcn-handle.cc (Ffunctions): fix structure assignment
John W. Eaton <jwe@octave.org>
parents:
7745
diff
changeset
|
1237 m.assign ("parentage", octave_value (parentage)); |
6625 | 1238 } |
1239 else | |
1240 m.assign ("type", "simple"); | |
1241 } | |
4933 | 1242 |
1243 std::string nm = fcn->fcn_file_name (); | |
4343 | 1244 |
4933 | 1245 if (nm.empty ()) |
4935 | 1246 { |
1247 if (fh_nm == "@<anonymous>") | |
6625 | 1248 { |
1249 m.assign ("file", ""); | |
1250 | |
1251 octave_user_function *fu = fh->user_function_value (); | |
1252 | |
7336 | 1253 std::list<symbol_table::symbol_record> vars |
1254 = symbol_table::all_variables (fu->scope ()); | |
1255 | |
1256 size_t varlen = vars.size (); | |
6625 | 1257 |
1258 if (varlen > 0) | |
1259 { | |
1260 Octave_map ws; | |
7336 | 1261 for (std::list<symbol_table::symbol_record>::const_iterator p = vars.begin (); |
1262 p != vars.end (); p++) | |
6625 | 1263 { |
7336 | 1264 ws.assign (p->name (), p->varval ()); |
6625 | 1265 } |
1266 | |
1267 m.assign ("workspace", ws); | |
1268 } | |
1269 } | |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1270 else if (fcn->is_user_function () || fcn->is_user_script ()) |
6625 | 1271 { |
7744
14b841c47a5f
handle load/save for handles to built-in functions
John W. Eaton <jwe@octave.org>
parents:
7740
diff
changeset
|
1272 octave_function *fu = fh->function_value (); |
6625 | 1273 m.assign ("file", fu->fcn_file_name ()); |
1274 } | |
4935 | 1275 else |
6625 | 1276 m.assign ("file", ""); |
4935 | 1277 } |
4343 | 1278 else |
4933 | 1279 m.assign ("file", nm); |
1280 | |
1281 retval = m; | |
4343 | 1282 } |
1283 else | |
4933 | 1284 error ("functions: invalid function handle object"); |
4343 | 1285 } |
1286 else | |
4933 | 1287 error ("functions: argument must be a function handle object"); |
4343 | 1288 } |
1289 else | |
5823 | 1290 print_usage (); |
4343 | 1291 |
1292 return retval; | |
1293 } | |
1294 | |
4933 | 1295 DEFUN (func2str, args, , |
4343 | 1296 "-*- texinfo -*-\n\ |
4933 | 1297 @deftypefn {Built-in Function} {} func2str (@var{fcn_handle})\n\ |
1298 Return a string containing the name of the function referenced by\n\ | |
1299 the function handle @var{fcn_handle}.\n\ | |
1300 @end deftypefn") | |
4343 | 1301 { |
1302 octave_value retval; | |
1303 | |
4933 | 1304 if (args.length () == 1) |
4930 | 1305 { |
4933 | 1306 octave_fcn_handle *fh = args(0).fcn_handle_value (); |
4930 | 1307 |
4933 | 1308 if (! error_state && fh) |
1309 { | |
1310 std::string fh_nm = fh->fcn_name (); | |
6416 | 1311 |
1312 if (fh_nm == "@<anonymous>") | |
1313 { | |
1314 std::ostringstream buf; | |
1315 | |
1316 fh->print_raw (buf); | |
1317 | |
1318 retval = buf.str (); | |
1319 } | |
1320 else | |
1321 retval = fh_nm; | |
4933 | 1322 } |
4343 | 1323 else |
4933 | 1324 error ("func2str: expecting valid function handle as first argument"); |
4343 | 1325 } |
1326 else | |
5823 | 1327 print_usage (); |
4343 | 1328 |
1329 return retval; | |
1330 } | |
1331 | |
4933 | 1332 DEFUN (str2func, args, , |
4343 | 1333 "-*- texinfo -*-\n\ |
4933 | 1334 @deftypefn {Built-in Function} {} str2func (@var{fcn_name})\n\ |
1335 Return a function handle constructed from the string @var{fcn_name}.\n\ | |
1336 @end deftypefn") | |
4343 | 1337 { |
1338 octave_value retval; | |
1339 | |
4933 | 1340 if (args.length () == 1) |
4343 | 1341 { |
4933 | 1342 std::string nm = args(0).string_value (); |
4343 | 1343 |
4933 | 1344 if (! error_state) |
1345 retval = make_fcn_handle (nm); | |
4343 | 1346 else |
4933 | 1347 error ("str2func: expecting string as first argument"); |
4343 | 1348 } |
1349 else | |
5823 | 1350 print_usage (); |
4343 | 1351 |
1352 return retval; | |
1353 } | |
1354 | |
1355 /* | |
1356 ;;; Local Variables: *** | |
1357 ;;; mode: C++ *** | |
1358 ;;; End: *** | |
1359 */ |