Mercurial > hg > octave-lyh
diff src/variables.cc @ 605:4f65175911a6
[project @ 1994-08-13 20:10:39 by jwe]
author | jwe |
---|---|
date | Sat, 13 Aug 1994 20:10:39 +0000 |
parents | 80a8a79ea6e4 |
children | 14b2a186a5c0 |
line wrap: on
line diff
--- a/src/variables.cc +++ b/src/variables.cc @@ -25,60 +25,52 @@ #include "config.h" #endif +#if 0 +#include <ctype.h> +#include <iostream.h> + +#include "mappers.h" +#endif + #include <sys/types.h> #ifdef HAVE_UNISTD_H #include <unistd.h> #endif -#include <ctype.h> #include <float.h> #include <string.h> -#include <fstream.h> -#include <iostream.h> #include <strstream.h> +#include "defaults.h" +#include "version.h" #include "octave-hist.h" #include "unwind-prot.h" +#include "variables.h" #include "user-prefs.h" +#include "statdefs.h" #include "tree-base.h" #include "tree-expr.h" #include "tree-const.h" -#include "variables.h" -#include "statdefs.h" -#include "defaults.h" -#include "version.h" -#include "mappers.h" +#include "dirfns.h" #include "oct-obj.h" #include "sysdep.h" -#include "dirfns.h" #include "symtab.h" #include "octave.h" +#include "pager.h" #include "error.h" -#include "pager.h" +#include "defun.h" #include "utils.h" -#include "defun.h" +#include "parse.h" #include "input.h" -#include "parse.h" #include "help.h" #include "lex.h" extern "C" { #include <readline/readline.h> -#include <readline/tilde.h> #include "fnmatch.h" } -#if SIZEOF_SHORT == 4 -#define FOUR_BYTE_TYPE short -#elif SIZEOF_INT == 4 -#define FOUR_BYTE_TYPE int -#elif SIZEOF_LONG == 4 -#define FOUR_BYTE_TYPE long -#else -LOSE! LOSE! -#endif - // Symbol table for symbols at the top level. symbol_table *top_level_sym_tab = 0; @@ -127,28 +119,13 @@ // Is this function globally in this scope? -static int +int is_globally_visible (const char *name) { symbol_record *sr = curr_sym_tab->lookup (name, 0, 0); return (sr && sr->is_linked_to_global ()); } -// Is this name a valid identifier? - -static int -valid_identifier (char *s) -{ - if (! s || ! (isalnum (*s) || *s == '_')) - return 0; - - while (*++s != '\0') - if (! (isalnum (*s) || *s == '_')) - return 0; - - return 1; -} - // Is this tree_constant a valid function? tree_fvc * @@ -832,865 +809,7 @@ } } -// Loading variables from files. - -// Extract a keyword and its value from a file. Input should look -// something like: -// -// #[ \t]*keyword[ \t]*:[ \t]*string-value\n -// -// Returns a pointer to new storage. The caller is responsible for -// deleting it. - -static char * -extract_keyword (istream& is, char *keyword) -{ - ostrstream buf; - - char *retval = 0; - - char c; - while (is.get (c)) - { - if (c == '#') - { - while (is.get (c) && (c == ' ' || c == '\t' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - buf << ends; - char *tmp = buf.str (); - int match = (strncmp (tmp, keyword, strlen (keyword)) == 0); - delete [] tmp; - - if (match) - { - ostrstream value; - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - if (c != '\n') - { - value << c; - while (is.get (c) && c != '\n') - value << c; - } - value << ends; - retval = value.str (); - break; - } - } - } - return retval; -} - -static int -extract_keyword (istream& is, char *keyword, int& value) -{ - ostrstream buf; - - int status = 0; - value = 0; - - char c; - while (is.get (c)) - { - if (c == '#') - { - while (is.get (c) && (c == ' ' || c == '\t' || c == '#')) - ; // Skip whitespace and comment characters. - - if (isalpha (c)) - buf << c; - - while (is.get (c) && isalpha (c)) - buf << c; - - buf << ends; - char *tmp = buf.str (); - int match = (strncmp (tmp, keyword, strlen (keyword)) == 0); - delete [] tmp; - - if (match) - { - while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) - ; // Skip whitespace and the colon. - - is.putback (c); - if (c != '\n') - is >> value; - if (is) - status = 1; - while (is.get (c) && c != '\n') - ; // Skip to beginning of next line; - break; - } - } - } - return status; -} - -// Skip white space and comments. - -static void -skip_comments (istream& is) -{ - char c = '\0'; - while (is.get (c)) - { - if (c == ' ' || c == '\t' || c == '\n') - ; // Skip whitespace on way to beginning of next line. - else - break; - } - - for (;;) - { - if (is && c == '#') - while (is.get (c) && c != '\n') - ; // Skip to beginning of next line, ignoring everything. - else - break; - } -} - -static tree_constant -load_variable (istream& is, int& is_global) -{ - tree_constant retval; - - is_global = 0; - -// Look for type keyword - - char *tag = extract_keyword (is, "type"); - - if (tag && *tag) - { - char *ptr = strchr (tag, ' '); - if (ptr) - { - *ptr = '\0'; - is_global = (strncmp (tag, "global", 6) == 0); - *ptr = ' '; - if (is_global) - ptr++; - else - ptr = tag; - } - else - ptr = tag; - - if (strncmp (ptr, "scalar", 6) == 0) - { - double tmp; - is >> tmp; - if (is) - retval = tmp; - else - error ("failed to load scalar constant"); - } - else if (strncmp (ptr, "matrix", 6) == 0) - { - int nr = 0, nc = 0; - - if (extract_keyword (is, "rows", nr) && nr > 0 - && extract_keyword (is, "columns", nc) && nc > 0) - { - Matrix tmp (nr, nc); - is >> tmp; - if (is) - retval = tmp; - else - error ("failed to load matrix constant"); - } - else - error ("failed to extract number of rows and columns"); - } - else if (strncmp (ptr, "complex scalar", 14) == 0) - { - Complex tmp; - is >> tmp; - if (is) - retval = tmp; - else - error ("failed to load complex scalar constant"); - } - else if (strncmp (ptr, "complex matrix", 14) == 0) - { - int nr = 0, nc = 0; - - if (extract_keyword (is, "rows", nr) && nr > 0 - && extract_keyword (is, "columns", nc) && nc > 0) - { - ComplexMatrix tmp (nr, nc); - is >> tmp; - if (is) - retval = tmp; - else - error ("failed to load complex matrix constant"); - } - else - error ("failed to extract number of rows and columns"); - } - else if (strncmp (ptr, "string", 6) == 0) - { - int len; - if (extract_keyword (is, "length", len) && len > 0) - { - char *tmp = new char [len+1]; - is.get (tmp, len+1, EOF); - if (is) - retval = tmp; - else - error ("failed to load string constant"); - } - else - error ("failed to extract string length"); - } - else if (strncmp (ptr, "range", 5) == 0) - { - skip_comments (is); // # base, limit, range comment added by save(). - Range tmp; - is >> tmp; - if (is) - retval = tmp; - else - error ("failed to load range constant"); - } - else - error ("unknown constant type `%s'", tag); - } - else - error ("failed to extract keyword specifying value type"); - - delete [] tag; - - return retval; -} - -static void -install_loaded_variable (int force, char *nm, const tree_constant& tc, - int global) -{ -// Is there already a symbol by this name? If so, what is it? - - symbol_record *lsr = curr_sym_tab->lookup (nm, 0, 0); - - int is_undefined = 1; - int is_variable = 0; - int is_function = 0; - int is_global = 0; - - if (lsr) - { - is_undefined = ! lsr->is_defined (); - is_variable = lsr->is_variable (); - is_function = lsr->is_function (); - is_global = lsr->is_linked_to_global (); - } - -// Try to read data for this name. - - if (tc.is_undefined ()) - { - error ("load: unable to load variable `%s'", nm); - return; - } - - symbol_record *sr = 0; - - if (global) - { - if (is_global || is_undefined) - { - if (force || is_undefined) - { - lsr = curr_sym_tab->lookup (nm, 1, 0); - link_to_global_variable (lsr); - sr = lsr; - } - else - { - warning ("load: global variable name `%s' exists.", nm); - warning ("use `load -force' to overwrite"); - } - } - else if (is_function) - { - if (force) - { - lsr = curr_sym_tab->lookup (nm, 1, 0); - link_to_global_variable (lsr); - sr = lsr; - } - else - { - warning ("load: `%s' is currently a function in this scope", nm); - warning ("`load -force' will load variable and hide function"); - } - } - else if (is_variable) - { - if (force) - { - lsr = curr_sym_tab->lookup (nm, 1, 0); - link_to_global_variable (lsr); - sr = lsr; - } - else - { - warning ("load: local variable name `%s' exists.", nm); - warning ("use `load -force' to overwrite"); - } - } - else - panic_impossible (); - } - else - { - if (is_global) - { - if (force || is_undefined) - { - lsr = curr_sym_tab->lookup (nm, 1, 0); - link_to_global_variable (lsr); - sr = lsr; - } - else - { - warning ("load: global variable name `%s' exists.", nm); - warning ("use `load -force' to overwrite"); - } - } - else if (is_function) - { - if (force) - { - lsr = curr_sym_tab->lookup (nm, 1, 0); - link_to_global_variable (lsr); - sr = lsr; - } - else - { - warning ("load: `%s' is currently a function in this scope", nm); - warning ("`load -force' will load variable and hide function"); - } - } - else if (is_variable || is_undefined) - { - if (force || is_undefined) - { - lsr = curr_sym_tab->lookup (nm, 1, 0); - sr = lsr; - } - else - { - warning ("load: local variable name `%s' exists.", nm); - warning ("use `load -force' to overwrite"); - } - } - else - panic_impossible (); - } - - if (sr) - { - tree_constant *tmp_tc = new tree_constant (tc); - sr->define (tmp_tc); - return; - } - else - error ("load: unable to load variable `%s'", nm); - - return; -} - -// XXX FIXME XXX -- need to check stream states in more places. - -static char * -read_ascii_data (istream& stream, const char *filename, int& global, - tree_constant& tc) -{ -// Read name for this entry or break on EOF. - - char *nm = extract_keyword (stream, "name"); - - if (! nm) - return 0; - - if (! *nm) - { - error ("load: empty name keyword found in file `%s'", filename); - delete [] nm; - return 0; - } - - - if (! valid_identifier (nm)) - { - error ("load: bogus identifier `%s' found in file `%s'", nm, filename); - delete [] nm; - return 0; - } - - tc = load_variable (stream, global); - - if (error_state) - { - error ("reading file %s", filename); - return 0; - } - - return nm; -} - -static void -swap_2_bytes (char *t) -{ - char tmp = t[0]; - t[0] = t[1]; - t[1] = tmp; -} - -static void -swap_4_bytes (char *t) -{ - char tmp = t[0]; - t[0] = t[3]; - t[3] = tmp; - - tmp = t[1]; - t[1] = t[2]; - t[2] = tmp; -} - -static void -swap_8_bytes (char *t) -{ - char tmp = t[0]; - t[0] = t[7]; - t[7] = tmp; - - tmp = t[1]; - t[1] = t[6]; - t[6] = tmp; - - tmp = t[2]; - t[2] = t[5]; - t[5] = tmp; - - tmp = t[3]; - t[3] = t[4]; - t[4] = tmp; -} - -static char *floating_point_format[] = -{ - "IEEE little endian", - "IEEE big endian", - "VAX D floating", - "VAX G floating", - "Cray", - 0, -}; - -static char * -read_binary_data (istream& stream, const char *filename, int& global, - tree_constant& tc) -{ - global = 0; - - FOUR_BYTE_TYPE mopt, nr, nc, imag, len; - - int swap = 0; - - stream.read (&mopt, 4); - - if (mopt > 9999) - { - swap = 1; - swap_4_bytes ((char *) &mopt); - } - - if (mopt > 9999) - { - error ("load: can't read binary file"); - return 0; - } - - stream.read (&nr, 4); - stream.read (&nc, 4); - stream.read (&imag, 4); - stream.read (&len, 4); - - if (swap) - { - swap_4_bytes ((char *) &nr); - swap_4_bytes ((char *) &nc); - swap_4_bytes ((char *) &imag); - swap_4_bytes ((char *) &len); - } - - int type = mopt % 10; // Full, sparse, etc. - mopt /= 10; // Eliminate first digit. - int prec = mopt % 10; // double, float, int, etc. - mopt /= 100; // Skip unused third digit too. - int mach = mopt % 10; // IEEE, VAX, etc. - - if (mach < 0 || mach > 4) - { - error ("load: unrecognized binary format!"); - return 0; - } - -#if defined (IEEE_LITTLE_ENDIAN) - if (mach != 0) - { - error ("load: can't convert from %s to %s yet", - floating_point_format [mach], floating_point_format [0]); - return 0; - } -#elif defined (IEEE_BIG_ENDIAN) - if (mach != 1) - { - error ("load: can't convert from %s to %s yet", - floating_point_format [mach], floating_point_format [1]); - return 0; - } -#elif defined (VAX_D_FLOAT) - if (mach != 2) - { - error ("load: can't convert from %s to %s yet", - floating_point_format [mach], floating_point_format [2]); - return 0; - } -#elif defined (VAX_G_FLOAT) - if (mach != 3) - { - error ("load: can't convert from %s to %s yet", - floating_point_format [mach], floating_point_format [3]); - return 0; - } -#else -LOSE! LOSE! -#endif - - if (prec != 0) - { - error ("load: can only read binary files with data stored as doubles"); - return 0; - } - - if (type != 0 && type != 1) - { - error ("load: can't read sparse matrices"); - return 0; - } - - if (imag && type == 1) - { - error ("load: encountered complex matrix with string flag set!"); - return 0; - } - - char *name = new char [len]; - stream.read (name, len); - - int dlen = nr * nc; - if (dlen < 0) - { - error ("load: matrix with negative size!"); - return 0; - } - -// This could probably be faster... - -// XXX FIXME XXX -- 8 is magic here! - - Matrix re (nr, nc); - stream.read (re.fortran_vec (), dlen * 8); - - if (imag) - { - Matrix im (nr, nc); - stream.read (im.fortran_vec (), dlen * 8); - - ComplexMatrix ctmp (nr, nc); - - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - ctmp.elem (i, j) = Complex (re.elem (i, j), im.elem (i, j)); - - tc = ctmp; - } - else - tc = re; - -// If we were going to do it, this is probably where we would convert -// the raw data to the proper floating point format. - - if (type == 1) - tc = tc.convert_to_str (); - - return name; -} - -DEFUN_TEXT ("load", Fload, Sload, -1, 1, - "load [-force] [-binary] file\n -\n\ -load variables from a file") -{ - Octave_object retval; - - DEFINE_ARGV("load"); - - argc--; - argv++; - - int force = 0; - int binary = 0; - - while (argc > 0) - { - if (strcmp (*argv, "-force") == 0) - { - force++; - argc--; - argv++; - } - else if (strcmp (*argv, "-binary") == 0) - { - binary++; - argc--; - argv++; - } - else - break; - } - - if (argc < 1) - { - error ("load: you must specify a single file to read"); - DELETE_ARGV; - return retval; - } - - static istream stream; - static ifstream file; - if (strcmp (*argv, "-") == 0) - { - stream = cin; - } - else - { - char *fname = tilde_expand (*argv); - - unsigned mode = ios::in; - if (binary) - mode |= ios::bin; - - file.open (fname, mode); - - if (! file) - { - error ("load: couldn't open input file `%s'", *argv); - DELETE_ARGV; - return retval; - } - stream = file; - } - - int count = 0; - for (;;) - { - int global = 0; - tree_constant tc; - - char *name = 0; - delete [] name; - - - if (binary) - name = read_binary_data (stream, *argv, global, tc); - else - name = read_ascii_data (stream, *argv, global, tc); - - if (! error_state && name && tc.is_defined ()) - { - count++; - install_loaded_variable (force, name, tc, global); - } - else - { - if (count == 0) - error ("load: are you sure `%s' is an Octave data file?", *argv); - - break; - } - } - - if (file); - file.close (); - - DELETE_ARGV; - - return retval; -} - -// Return nonzero if PATTERN has any special globbing chars in it. - -static int -glob_pattern_p (char *pattern) -{ - char *p = pattern; - char c; - int open = 0; - - while ((c = *p++) != '\0') - { - switch (c) - { - case '?': - case '*': - return 1; - - case '[': // Only accept an open brace if there is a close - open++; // brace to match it. Bracket expressions must be - continue; // complete, according to Posix.2 - - case ']': - if (open) - return 1; - continue; - - case '\\': - if (*p++ == '\0') - return 0; - - default: - continue; - } - } - - return 0; -} - -DEFUN_TEXT ("save", Fsave, Ssave, -1, 1, - "save file [var ...]\n\ -\n\ -save variables in a file") -{ - Octave_object retval; - - DEFINE_ARGV("save"); - - if (argc < 2) - { - print_usage ("save"); - DELETE_ARGV; - return retval; - } - - argc--; - argv++; - - static ostream stream; - static ofstream file; - if (strcmp (*argv, "-") == 0) - { -// XXX FIXME XXX -- should things intended for the screen end up in a -// tree_constant (string)? - stream = cout; - } - else if (argc == 1 && glob_pattern_p (*argv)) // Guard against things - { // like `save a*', - print_usage ("save"); // which are probably - DELETE_ARGV; // mistakes... - return retval; - } - else - { - char *fname = tilde_expand (*argv); - file.open (fname); - if (! file) - { - error ("save: couldn't open output file `%s'", *argv); - DELETE_ARGV; - return retval; - } - stream = file; - - } - - int prec = user_pref.save_precision; - - if (argc == 1) - { - int count; - char **vars = curr_sym_tab->list (count, 0, - symbol_def::USER_VARIABLE, - SYMTAB_ALL_SCOPES); - - for (int i = 0; i < count; i++) - curr_sym_tab->save (stream, vars[i], - is_globally_visible (vars[i]), prec); - - delete [] vars; - } - else - { - while (--argc > 0) - { - argv++; - - int count; - char **lvars = curr_sym_tab->list (count, 0, - symbol_def::USER_VARIABLE); - - int saved_or_error = 0; - int i; - for (i = 0; i < count; i++) - { - if (fnmatch (*argv, lvars[i], __FNM_FLAGS) == 0 - && curr_sym_tab->save (stream, lvars[i], - is_globally_visible (lvars[i]), - prec) != 0) - saved_or_error++; - } - - char **bvars = global_sym_tab->list (count, 0, - symbol_def::BUILTIN_VARIABLE); - - for (i = 0; i < count; i++) - { - if (fnmatch (*argv, bvars[i], __FNM_FLAGS) == 0 - && global_sym_tab->save (stream, bvars[i], 0, prec) != 0) - saved_or_error++; - } - - delete [] lvars; - delete [] bvars; - - if (! saved_or_error) - warning ("save: no such variable `%s'", *argv); - } - } - - if (file); - file.close (); - - DELETE_ARGV; - - return retval; -} - -// Help stuff. +// Help stuff. Shouldn't this go in help.cc? // It's not likely that this does the right thing now. XXX FIXME XXX @@ -1890,17 +1009,13 @@ show_functions++; show_variables++; } - else if (strcmp (*argv, "-builtins") == 0 - || strcmp (*argv, "-b") == 0) + else if (strcmp (*argv, "-builtins") == 0 || strcmp (*argv, "-b") == 0) show_builtins++; - else if (strcmp (*argv, "-functions") == 0 - || strcmp (*argv, "-f") == 0) + else if (strcmp (*argv, "-functions") == 0 || strcmp (*argv, "-f") == 0) show_functions++; - else if (strcmp (*argv, "-long") == 0 - || strcmp (*argv, "-l") == 0) - show_verbose++; - else if (strcmp (*argv, "-variables") == 0 - || strcmp (*argv, "-v") == 0) + else if (strcmp (*argv, "-long") == 0 || strcmp (*argv, "-l") == 0) + show_verbose++; + else if (strcmp (*argv, "-variables") == 0 || strcmp (*argv, "-v") == 0) show_variables++; else warning ("%s: unrecognized option `%s'", my_name, *argv); @@ -2212,6 +1327,11 @@ 0, 0, 1, commas_in_literal_matrix, "control auto-insertion of commas in literal matrices"); + DEFVAR ("default_save_format", SBV_default_save_format, "ascii", + 0, 0, 1, sv_default_save_format, + "default format for files created with save, may be either\n\ +\"binary\" or \"text\""); + DEFVAR ("do_fortran_indexing", SBV_do_fortran_indexing, "false", 0, 0, 1, do_fortran_indexing, "allow single indices for matrices");