// variables.cc -*- C++ -*- /* Copyright (C) 1992, 1993 John W. Eaton This file is part of Octave. Octave is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. Octave is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with Octave; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ #ifdef __GNUG__ #pragma implementation #endif #include #ifdef HAVE_UNISTD_H #include #endif #include #include #include "statdefs.h" #include "tree-const.h" #include "variables.h" #include "symtab.h" #include "error.h" #include "utils.h" #include "tree.h" // Symbol table for symbols at the top level. symbol_table *top_level_sym_tab; // Symbol table for the current scope. symbol_table *curr_sym_tab; // Symbol table for global symbols. symbol_table *global_sym_tab; /* * Is there a corresponding M-file that is newer than the symbol * definition? */ int symbol_out_of_date (symbol_record *sr) { int status = 0; if (sr != (symbol_record *) NULL) { tree *ans = sr->def (); if (ans != NULL_TREE) { char *mf = ans->m_file_name (); if (mf != (char *) NULL) { time_t tp = ans->time_parsed (); status = is_newer (mf, tp); } } } return status; } /* * Force a symbol into the global symbol table. */ symbol_record * force_global (char *name) { symbol_record *retval = (symbol_record *) NULL; if (valid_identifier (name)) { symbol_record *sr; sr = curr_sym_tab->lookup (name, 0, 0); if (sr == (symbol_record *) NULL) { retval = global_sym_tab->lookup (name, 1, 0); } else if (sr->is_formal_parameter ()) { error ("formal parameter `%s' can't be made global", name); } else { retval = global_sym_tab->lookup (name, 1, 0); retval->alias (sr); curr_sym_tab->clear (name); } } else warning ("`%s' is invalid as an identifier", name); return retval; } int bind_variable (char *varname, tree_constant *val) { // Look for the symbol in the current symbol table. If it's there, // great. If not, don't insert it, but look for it in the global // symbol table. If it's there, great. If not, insert it in the // original current symbol table. symbol_record *sr; sr = curr_sym_tab->lookup (varname, 0, 0); if (sr == (symbol_record *) NULL) { sr = global_sym_tab->lookup (varname, 0, 0); if (sr == (symbol_record *) NULL) { sr = curr_sym_tab->lookup (varname, 1); } } if (sr != (symbol_record *) NULL) { sr->define (val); return 0; } else return 1; } int bind_protected_variable (char *varname, tree_constant *val) { // Look for the symbol in the current symbol table. If it's there, // great. If not, don't insert it, but look for it in the global // symbol table. If it's there, great. If not, insert it in the // original current symbol table. symbol_record *sr; sr = curr_sym_tab->lookup (varname, 0, 0); if (sr == (symbol_record *) NULL) { sr = global_sym_tab->lookup (varname, 0, 0); if (sr == (symbol_record *) NULL) { sr = curr_sym_tab->lookup (varname, 1); } } if (sr != (symbol_record *) NULL) { sr->unprotect (); sr->define (val); sr->protect (); return 0; } else return 1; } /* * Look for name first in current then in global symbol tables. If * name is found and it refers to a string, return a new string * containing its value. Otherwise, return NULL. */ char * octave_string_variable (char *name) { char *retval = (char *) NULL; symbol_record *sr; sr = curr_sym_tab->lookup (name, 0, 0); if (sr == (symbol_record *) NULL) { sr = global_sym_tab->lookup (name, 0, 0); if (sr == (symbol_record *) NULL) return retval; } tree *defn = sr->def (); if (defn != NULL_TREE) { tree_constant val = defn->eval (0); if (val.is_string_type ()) { char *s = val.string_value (); if (s != (char *) NULL) retval = strsave (s); } } return retval; } /* * Look for name first in current then in global symbol tables. If * name is found and it refers to a real scalar, place the value in d * and return 0. Otherwise, return -1. */ int octave_real_scalar_variable (char *name, double& d) { int status = -1; symbol_record *sr; sr = curr_sym_tab->lookup (name, 0, 0); if (sr == (symbol_record *) NULL) { sr = global_sym_tab->lookup (name, 0, 0); if (sr == (symbol_record *) NULL) return status; } tree *defn = sr->def (); if (defn != NULL_TREE) { tree_constant val = defn->eval (0); if (val.const_type () == tree_constant_rep::scalar_constant) { d = val.double_value (); status = 0; } } return status; } /* * Extract a keyword and its value from a file. Input should look * something like: * * #[ \t]*keyword[ \t]*:[ \t]*string-value\n */ int extract_keyword (istream& is, char *keyword, char *value) { char *ptr = value; int status = 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)) *ptr++ = c; while (is.get (c) && isalpha (c)) *ptr++ = c; if (strncmp (value, keyword, strlen (keyword)) == 0) { ptr = value; while (is.get (c) && (c == ' ' || c == '\t' || c == ':')) ; // Skip whitespace and the colon. if (c != '\n') { *ptr++ = c; while (is.get (c) && c != '\n') *ptr++ = c; } *ptr = '\0'; status = 1; break; } } } return status; } int extract_keyword (istream& is, char *keyword, int& value) { char buf [128]; char *ptr = 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)) *ptr++ = c; while (is.get (c) && isalpha (c)) *ptr++ = c; if (strncmp (buf, keyword, strlen (keyword)) == 0) { ptr = buf; 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 trailing white space and */ 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; } } /* * Is `s' a valid identifier? */ int valid_identifier (char *s) { if (s == (char *) NULL || ! (isalnum (*s) || *s == '_')) return 0; while (*++s != '\0') if (! (isalnum (*s) || *s == '_')) return 0; return 1; } /* * See if the identifier is in scope. */ int identifier_exists (char *name) { int status = 0; if (curr_sym_tab->lookup (name, 0, 0) != (symbol_record *) NULL || global_sym_tab->lookup (name, 0, 0) != (symbol_record *) NULL) status = 1; else { char *path = m_file_in_path (name); if (path != (char *) NULL) { delete [] path; status = 2; } else { struct stat buf; if (stat (name, &buf) == 0 && S_ISREG (buf.st_mode)) status = 2; } } return status; } /* * Is this tree_constant a valid function? */ tree * is_valid_function (tree_constant& arg, char *warn_for, int warn = 0) { tree *ans = NULL_TREE; if (! arg.is_string_type ()) { if (warn) message (warn_for, "expecting function name as argument"); return ans; } char *fcn_name = arg.string_value (); symbol_record *sr = global_sym_tab->lookup (fcn_name, 0, 0); if (sr == (symbol_record *) NULL) { sr = global_sym_tab->lookup (fcn_name, 1, 0); tree_identifier tmp (sr); tmp.parse_m_file (0); } else if (symbol_out_of_date (sr)) { tree_identifier tmp (sr); tmp.parse_m_file (0); } ans = sr->def (); if (ans == NULL_TREE || ! sr->is_function ()) { if (warn) message (warn_for, "the symbol `%s' is not valid as a function", fcn_name); ans = NULL_TREE; } return ans; } /* * Does this function take the right number of arguments? */ int takes_correct_nargs (tree *fcn, int expected_nargin, char *warn_for, int warn = 0) { int nargs = fcn->max_expected_args () - 1; int e_nargs = expected_nargin - 1; if (nargs != e_nargs) { if (warn) message (warn_for, "expecting function to take %d argument%c", e_nargs, s_plural (e_nargs)); return 0; } return 1; } char ** make_name_list (void) { int key_len = 0; int glb_len = 0; int top_len = 0; int lcl_len = 0; int mfl_len = 0; char **key = (char **) NULL; char **glb = (char **) NULL; char **top = (char **) NULL; char **lcl = (char **) NULL; char **mfl = (char **) NULL; key = names (keyword_help (), key_len); glb = global_sym_tab->list (glb_len); top = top_level_sym_tab->list (top_len); if (top_level_sym_tab != curr_sym_tab) lcl = curr_sym_tab->list (lcl_len); mfl = get_m_file_names (mfl_len, 1); int total_len = key_len + glb_len + top_len + lcl_len + mfl_len; char **list = new char * [total_len+1]; int j = 0; int i = 0; for (i = 0; i < key_len; i++) list[j++] = key[i]; for (i = 0; i < glb_len; i++) list[j++] = glb[i]; for (i = 0; i < top_len; i++) list[j++] = top[i]; for (i = 0; i < lcl_len; i++) list[j++] = lcl[i]; for (i = 0; i < mfl_len; i++) list[j++] = mfl[i]; list[j] = (char *) NULL; delete [] key; delete [] glb; delete [] top; delete [] lcl; delete [] mfl; return list; } /* ;;; Local Variables: *** ;;; mode: C++ *** ;;; page-delimiter: "^/\\*" *** ;;; End: *** */