Mercurial > octave
changeset 195:13c6086c325c
[project @ 1993-11-06 10:12:29 by jwe]
| author | jwe |
|---|---|
| date | Sat, 06 Nov 1993 10:14:11 +0000 |
| parents | 4f3364dcf450 |
| children | b025ad539b43 |
| files | src/builtins.cc src/defaults.h.in src/g-builtins.cc src/g-builtins.h src/input.cc src/lex.l src/oct-hist.cc src/octave.cc src/parse.h src/parse.y src/pr-output.cc src/pt-base.h src/symtab.cc src/symtab.h src/t-builtins.cc src/toplev.h src/tree.h.old src/user-prefs.cc src/user-prefs.h src/utils.cc src/utils.h src/variables.cc src/variables.h |
| diffstat | 23 files changed, 1671 insertions(+), 945 deletions(-) [+] |
line wrap: on
line diff
--- a/src/builtins.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/builtins.cc Sat Nov 06 10:14:11 1993 +0000 @@ -31,7 +31,6 @@ #include <float.h> #include "tree-const.h" -#include "symtab.h" #include "t-builtins.h" #include "g-builtins.h" #include "builtins.h" @@ -396,6 +395,9 @@ { "inverse", 2, 1, builtin_inv, "inverse (X): inverse of a square matrix", }, + { "is_global", 2, 1, builtin_is_global, + "is_global (X): return 1 if the string X names a global variable", }, + { "isstr", 2, 1, builtin_isstr, "isstr (X): return 1 if X is a string", }, @@ -573,6 +575,9 @@ static builtin_string_variables string_variables[] = { + { "EDITOR", "??", sv_editor, + "name of the editor to be invoked by the edit_history command", }, + { "I", "??", NULL, "sqrt (-1)", }, @@ -629,6 +634,10 @@ { "i", "??", NULL, "sqrt (-1)", }, + { "ignore_function_time_stamp", "system", ignore_function_time_stamp, + "don't check to see if M-files have changed since they were last\n\ +compiled. Possible values are \"system\" and \"all\"", }, + { "implicit_str_to_num_ok", "false", implicit_str_to_num_ok, "allow implicit string to number conversion", }, @@ -710,75 +719,30 @@ { NULL, NULL, NULL, NULL, }, }; -static void -make_eternal (const char *s) -{ - symbol_record *sym_rec = curr_sym_tab->lookup (s, 0, 0); - if (sym_rec != (symbol_record *) NULL) - sym_rec->make_eternal (); -} - void install_builtins (void) { - symbol_record *sym_rec; - - tree_builtin *tb_tmp; - // So that the clear function can't delete other builtin variables and // functions, they are given eternal life. builtin_mapper_functions *mfptr = mapper_functions; while (mfptr->name != (char *) NULL) { - sym_rec = curr_sym_tab->lookup (mfptr->name, 1); - sym_rec->unprotect (); - - Mapper_fcn mfcn; - mfcn.neg_arg_complex = mfptr->neg_arg_complex; - mfcn.d_d_mapper = mfptr->d_d_mapper; - mfcn.d_c_mapper = mfptr->d_c_mapper; - mfcn.c_c_mapper = mfptr->c_c_mapper; - - tb_tmp = new tree_builtin (mfptr->nargin_max, mfptr->nargout_max, - mfcn, sym_rec); - - sym_rec->define (tb_tmp); - sym_rec->document (mfptr->help_string); - sym_rec->make_eternal (); - sym_rec->protect (); + install_builtin_mapper_function (mfptr); mfptr++; } builtin_text_functions *tfptr = text_functions; while (tfptr->name != (char *) NULL) { - sym_rec = curr_sym_tab->lookup (tfptr->name, 1); - sym_rec->unprotect (); - - tb_tmp = new tree_builtin (tfptr->nargin_max, 1, - tfptr->text_fcn, sym_rec); - - sym_rec->define (tb_tmp); - sym_rec->document (tfptr->help_string); - sym_rec->make_eternal (); - sym_rec->protect (); + install_builtin_text_function (tfptr); tfptr++; } builtin_general_functions *gfptr = general_functions; while (gfptr->name != (char *) NULL) { - sym_rec = curr_sym_tab->lookup (gfptr->name, 1); - sym_rec->unprotect (); - - tb_tmp = new tree_builtin (gfptr->nargin_max, gfptr->nargout_max, - gfptr->general_fcn, sym_rec); - - sym_rec->define (tb_tmp); - sym_rec->document (gfptr->help_string); - sym_rec->make_eternal (); - sym_rec->protect (); + install_builtin_general_function (gfptr); gfptr++; } @@ -788,110 +752,75 @@ builtin_string_variables *svptr = string_variables; while (svptr->name != (char *) NULL) { - sym_rec = curr_sym_tab->lookup (svptr->name, 1); - sym_rec->unprotect (); - - tree_constant *tmp = new tree_constant (svptr->value); - - sym_rec->set_sv_function (svptr->sv_function); - sym_rec->define (tmp); - sym_rec->document (svptr->help_string); - sym_rec->make_eternal (); + install_builtin_variable (svptr); svptr++; } -// XXX FIXME XXX -- Need a convenient way to document these variables. - // IMPORTANT: Always create a new tree_constant for each variable. tree_constant *tmp = NULL_TREE_CONST; - bind_variable ("ans", tmp); + bind_builtin_variable ("ans", tmp); Complex ctmp (0.0, 1.0); tmp = new tree_constant (ctmp); - bind_protected_variable ("I", tmp); - make_eternal ("I"); + bind_builtin_variable ("I", tmp, 1, 1); tmp = new tree_constant (ctmp); - bind_protected_variable ("J", tmp); - make_eternal ("J"); + bind_builtin_variable ("J", tmp, 1, 1); // Let i and j be functions so they can be redefined without being // wiped out. - char *tmp_help; - tmp = new tree_constant (ctmp); - sym_rec = curr_sym_tab->lookup ("i", 1); - tmp_help = sym_rec->help (); - sym_rec->define_as_fcn (tmp); - sym_rec->document (tmp_help); - sym_rec->protect (); - sym_rec->make_eternal (); + install_builtin_variable_as_function ("i", tmp, 1, 1); tmp = new tree_constant (ctmp); - sym_rec = curr_sym_tab->lookup ("j", 1); - tmp_help = sym_rec->help (); - sym_rec->define_as_fcn (tmp); - sym_rec->document (tmp_help); - sym_rec->protect (); - sym_rec->make_eternal (); + install_builtin_variable_as_function ("j", tmp, 1, 1); tmp = new tree_constant (get_working_directory ("initialize_globals")); - bind_protected_variable ("PWD", tmp); - make_eternal ("PWD"); + bind_builtin_variable ("PWD", tmp, 1, 1); tmp = new tree_constant (load_path); - bind_variable ("LOADPATH", tmp); - make_eternal ("LOADPATH"); + bind_builtin_variable ("LOADPATH", tmp, 0, 1); tmp = new tree_constant (info_file); - bind_variable ("INFO_FILE", tmp); - make_eternal ("INFO_FILE"); + bind_builtin_variable ("INFO_FILE", tmp, 0, 1); + + tmp = new tree_constant (editor); + bind_builtin_variable ("EDITOR", tmp, 0, 1); tmp = new tree_constant (default_pager ()); - bind_variable ("PAGER", tmp); - make_eternal ("PAGER"); + bind_builtin_variable ("PAGER", tmp, 0, 1); tmp = new tree_constant (0.0); - bind_variable ("SEEK_SET", tmp); - make_eternal ("SEEK_SET"); + bind_builtin_variable ("SEEK_SET", tmp, 0, 1); tmp = new tree_constant (1.0); - bind_variable ("SEEK_CUR", tmp); - make_eternal ("SEEK_CUR"); + bind_builtin_variable ("SEEK_CUR", tmp, 0, 1); tmp = new tree_constant (2.0); - bind_variable ("SEEK_END", tmp); - make_eternal ("SEEK_END"); + bind_builtin_variable ("SEEK_END", tmp, 0, 1); tmp = new tree_constant (DBL_EPSILON); - bind_protected_variable ("eps", tmp); - make_eternal ("eps"); + bind_builtin_variable ("eps", tmp, 1, 1); tmp = new tree_constant (10.0); - bind_variable ("output_max_field_width", tmp); - make_eternal ("output_max_field_width"); + bind_builtin_variable ("output_max_field_width", tmp, 0, 1); tmp = new tree_constant (5.0); - bind_variable ("output_precision", tmp); - make_eternal ("output_precision"); + bind_builtin_variable ("output_precision", tmp, 0, 1); tmp = new tree_constant (4.0 * atan (1.0)); - bind_protected_variable ("pi", tmp); - make_eternal ("pi"); + bind_builtin_variable ("pi", tmp, 1, 1); tmp = new tree_constant (0.0); - bind_protected_variable ("stdin", tmp); - make_eternal ("stdin"); + bind_builtin_variable ("stdin", tmp, 1, 1); tmp = new tree_constant (1.0); - bind_protected_variable ("stdout", tmp); - make_eternal ("stdout"); + bind_builtin_variable ("stdout", tmp, 1, 1); tmp = new tree_constant (2.0); - bind_protected_variable ("stderr", tmp); - make_eternal ("stderr"); + bind_builtin_variable ("stderr", tmp, 1, 1); // If using 1.0 / 0.0 doesn't work, you might also try using a very // large constant like 1.0e100000. @@ -904,12 +833,10 @@ #endif tmp = new tree_constant (tmp_inf); - bind_protected_variable ("Inf", tmp); - make_eternal ("Inf"); + bind_builtin_variable ("Inf", tmp, 1, 1); tmp = new tree_constant (tmp_inf); - bind_protected_variable ("inf", tmp); - make_eternal ("inf"); + bind_builtin_variable ("inf", tmp, 1, 1); #else @@ -917,31 +844,27 @@ // off completely, or writing an entire IEEE emulation package? tmp = new tree_constant (DBL_MAX); - bind_protected_variable ("Inf", tmp); - make_eternal ("Inf"); + bind_builtin_variable ("Inf", tmp, 1, 1); tmp = new tree_constant (DBL_MAX); - bind_protected_variable ("inf", tmp); - make_eternal ("inf"); + bind_builtin_variable ("inf", tmp, 1, 1); #endif -// If tmp_inf / tmp_inf fails to produce a NaN, you might also try -// something like 0.0 / 0.0. +// If 0.0 / 0.0 fails to produce a NaN, you might also try +// something like Inf / Inf. #if defined (HAVE_ISNAN) #ifdef linux double tmp_nan = NAN; #else - double tmp_nan = tmp_inf / tmp_inf; + double tmp_nan = 0.0 / 0.0; #endif tmp = new tree_constant (tmp_nan); - bind_protected_variable ("NaN", tmp); - make_eternal ("NaN"); + bind_builtin_variable ("NaN", tmp, 1, 1); tmp = new tree_constant (tmp_nan); - bind_protected_variable ("nan", tmp); - make_eternal ("nan"); + bind_builtin_variable ("nan", tmp, 1, 1); #endif }
--- a/src/defaults.h.in Wed Nov 03 21:38:05 1993 +0000 +++ b/src/defaults.h.in Sat Nov 06 10:14:11 1993 +0000 @@ -28,14 +28,6 @@ #define DEFAULT_PAGER %DEFAULT_PAGER% #endif -#ifndef DEFAULT_INFO_PROG -#define DEFAULT_INFO_PROG %DEFAULT_INFO_PROG% -#endif - -#ifndef DEFAULT_INFO_FILE -#define DEFAULT_INFO_FILE %DEFAULT_INFO_FILE% -#endif - #ifndef OCTAVE_HOME #define OCTAVE_HOME %OCTAVE_HOME% #endif
--- a/src/g-builtins.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/g-builtins.cc Sat Nov 06 10:14:11 1993 +0000 @@ -900,6 +900,27 @@ } /* + * Does the given string name a global variable? + */ +tree_constant * +builtin_is_global (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = new tree_constant [2]; + retval[0] = tree_constant (0.0); + + if (nargin == 2 && args[1].is_string_type ()) + { + char *name = args[1].string_value (); + if (is_globally_visible (name)) + retval[0] = tree_constant (1.0); + } + else + print_usage ("is_global"); + + return retval; +} + +/* * Is the argument a string? */ tree_constant *
--- a/src/g-builtins.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/g-builtins.h Sat Nov 06 10:14:11 1993 +0000 @@ -82,6 +82,7 @@ extern tree_constant *builtin_input (const tree_constant *, int, int); extern tree_constant *builtin_ifft (const tree_constant *, int, int); extern tree_constant *builtin_inv (const tree_constant *, int, int); +extern tree_constant *builtin_is_global (const tree_constant *, int, int); extern tree_constant *builtin_isstr (const tree_constant *, int, int); extern tree_constant *builtin_keyboard (const tree_constant *, int, int); extern tree_constant *builtin_logm (const tree_constant *, int, int);
--- a/src/input.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/input.cc Sat Nov 06 10:14:11 1993 +0000 @@ -29,6 +29,7 @@ #include <stdio.h> #include <stdlib.h> +#include <iostream.h> #include <string.h> #include <assert.h> @@ -75,7 +76,6 @@ #include "input.h" #include "pager.h" #include "help.h" -#include "symtab.h" #include "octave-hist.h" #include "sighandlers.h" #include "parse.h"
--- a/src/lex.l Wed Nov 03 21:38:05 1993 +0000 +++ b/src/lex.l Sat Nov 06 10:14:11 1993 +0000 @@ -1037,24 +1037,12 @@ } /* - * Try to find an identifier in one symbol table or another. + * Try to find an identifier. All binding to global or builtin + * variables occurs when expressions are evaluated. */ static symbol_record * lookup_identifier (char *name) { - if (curr_sym_tab == top_level_sym_tab) - { - symbol_record *lsr = curr_sym_tab->lookup (name, 0, 0); - if (lsr != (symbol_record *) NULL && lsr->is_defined ()) - return lsr; - - symbol_record *gsr = global_sym_tab->lookup (name, 0, 0); - if (gsr != (symbol_record *) NULL - && ! (looping || iffing) - && (gsr->is_defined () || gsr->is_forced_global ())) - return gsr; - } - return curr_sym_tab->lookup (name, 1, 0); }
--- a/src/oct-hist.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/oct-hist.cc Sat Nov 06 10:14:11 1993 +0000 @@ -49,6 +49,7 @@ #include "error.h" #include "input.h" #include "octave.h" +#include "user-prefs.h" #include "unwind-prot.h" #include "octave-hist.h" #include "sighandlers.h" @@ -415,8 +416,6 @@ #define histline(i) (hlist[(i)]->line) -#define EDIT_COMMAND "${EDITOR:-vi}" - static char * mk_tmp_hist_file (int argc, char **argv, int insert_curr, char *warn_for) { @@ -529,7 +528,7 @@ // Call up our favorite editor on the file of commands. ostrstream buf; - buf << EDIT_COMMAND << " " << name << ends; + buf << user_pref.editor << " " << name << ends; char *cmd = buf.str (); // Ignore interrupts while we are off editing commands. Should we
--- a/src/octave.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/octave.cc Sat Nov 06 10:14:11 1993 +0000 @@ -48,7 +48,6 @@ #include "variables.h" #include "error.h" #include "tree-const.h" -#include "symtab.h" #include "utils.h" #include "builtins.h" #include "input.h" @@ -101,6 +100,9 @@ // Name of the info file specified on command line. char *info_file = (char *) NULL; +// Name of the editor to be invoked by the edit_history command. +char *editor = (char *) NULL; + // If nonzero, don't do fancy line editing. int no_line_editing = 0; @@ -116,6 +118,17 @@ // Top level context (?) jmp_buf toplevel; +// This is not really the right place to do this... +typedef void (*one_arg_error_handler_t) (const char*); +extern one_arg_error_handler_t set_Complex_error_handler + (one_arg_error_handler_t f); + +static void +octave_Complex_error_handler (const char* msg) +{ + warning (msg); +} + // Nonzero means we read ~/.octaverc and ./.octaverc. static int read_init_files = 1; @@ -179,6 +192,8 @@ load_path = default_path (); info_file = default_info_file (); + + editor = default_editor (); } void @@ -320,7 +335,7 @@ /* * Fix up things before exiting. */ -volatile void +void clean_up_and_exit (int retval) { raw_mode (0); @@ -338,6 +353,11 @@ retval = 0; exit (retval); + +// This is bogus but should prevent g++ from giving a warning saying +// that this volatile function does return. + + panic_impossible (); } static void @@ -357,6 +377,9 @@ // details. sysdep_init (); +// This is not really the right place to do this... + set_Complex_error_handler (octave_Complex_error_handler); + // Do this first, since some command line arguments may override the // defaults. initialize_globals (argv[0]); @@ -409,14 +432,10 @@ initialize_file_io (); - global_sym_tab = new symbol_table (); - curr_sym_tab = global_sym_tab; + initialize_symbol_tables (); install_builtins (); - top_level_sym_tab = new symbol_table (); - curr_sym_tab = top_level_sym_tab; - if (read_init_files) { saving_history = 0;
--- a/src/parse.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/parse.h Sat Nov 06 10:14:11 1993 +0000 @@ -36,9 +36,6 @@ class tree_identifier; class symbol_table; -// Identifier to define if we are reading an M-fie. -extern tree_identifier *id_to_define; - // Nonzero means we're in the middle of defining a function. extern int defining_func;
--- a/src/parse.y Wed Nov 03 21:38:05 1993 +0000 +++ b/src/parse.y Sat Nov 06 10:14:11 1993 +0000 @@ -46,9 +46,6 @@ #include "lex.h" #include "token.h" -// Identifier to define if we are reading an M-fie. -tree_identifier *id_to_define; - // Nonzero means we're in the middle of defining a function. int defining_func = 0; @@ -151,6 +148,7 @@ tree_word_list *tree_word_list_type; tree_command *tree_command_type; tree_if_command *tree_if_command_type; + tree_global_command *tree_global_command_type; tree_command_list *tree_command_list_type; tree_word_list_command *tree_word_list_command_type; tree_plot_command *tree_plot_command_type; @@ -193,8 +191,8 @@ %type <tree_word_list_type> word_list word_list1 %type <tree_command_type> statement %type <tree_if_command_type> elseif +%type <tree_global_command_type> global_decl global_decl1 %type <tree_command_list_type> simple_list simple_list1 list list1 opt_list -%type <tree_command_list_type> global_decl global_decl1 %type <tree_word_list_command_type> word_list_cmd %type <tree_plot_command_type> plot_command %type <tree_subplot_list_type> plot_command1 plot_command2 plot_options @@ -478,37 +476,29 @@ global_decl : GLOBAL global_decl1 { $$ = $2->reverse (); } + | GLOBAL global_decl1 ',' + { $$ = $2->reverse (); } ; global_decl1 : NAME { - force_global ($1->sym_rec()->name ()); - $$ = new tree_command_list (); + $$ = new tree_global_command + ($1->sym_rec (), $1->line (), $1->column ()); } | NAME '=' expression { - symbol_record *sr = force_global ($1->sym_rec()->name ()); - tree_identifier *id = new tree_identifier - (sr, $1->line (), $1->column ()); - tree_simple_assignment_expression *expr = - new tree_simple_assignment_expression - (id, $3, $2->line (), $2->column ()); - $$ = new tree_command_list (expr); + $$ = new tree_global_command + ($1->sym_rec (), $3, $1->line (), $1->column ()); } | global_decl1 optcomma NAME { - force_global ($3->sym_rec()->name ()); - $$ = $1; + $$ = $1->chain ($3->sym_rec (), $3->line (), + $3->column ()); } | global_decl1 optcomma NAME '=' expression { - symbol_record *sr = force_global ($3->sym_rec()->name ()); - tree_identifier *id = new tree_identifier - (sr, $3->line (), $3->column ()); - tree_simple_assignment_expression *expr = - new tree_simple_assignment_expression - (id, $5, $4->line (), $4->column ()); - $$ = $1->chain (expr); + $$ = $1->chain ($3->sym_rec (), $5, $3->line (), + $3->column ()); } ; @@ -891,26 +881,30 @@ if (reading_m_file) { if (strcmp (curr_m_file_name, id_name) != 0) - warning ("function name `%s' does not agree\ + { + warning ("function name `%s' does not agree\ with M-file name `%s.m'", id_name, curr_m_file_name); - id_to_define->define ($4); - id_to_define->document (help_buf); + $1->rename (curr_m_file_name); + } + + $4->stash_m_file_name (curr_m_file_name); + $4->stash_m_file_time (time ((time_t *) NULL)); + $4->mark_as_system_m_file (); } - else + else if (! input_from_tmp_history_file + && reading_script_file + && strcmp (curr_m_file_name, id_name) == 0) { - if (! input_from_tmp_history_file - && reading_script_file - && strcmp (curr_m_file_name, id_name) == 0) - warning ("function `%s' defined within\ + warning ("function `%s' defined within\ script file `%s.m'", id_name, curr_m_file_name); - - $1->define ($4); - $1->document (help_buf); - top_level_sym_tab->clear (id_name); } $4->stash_function_name (id_name); + + $1->define ($4); + $1->document (help_buf); + $$ = $4; } ; @@ -1182,40 +1176,32 @@ * * XXX FIXME XXX. This isn't quite sufficient. For example, try the * command `x = 4, x' for `x' previously undefined. + * + * XXX FIXME XXX -- we should probably delay doing this until eval-time. */ tree * maybe_convert_to_ans_assign (tree *expr) { - tree *retval = expr; - - symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0); - - assert (sr != (symbol_record *) NULL); - if (expr->is_index_expression ()) { - tree_index_expression *idx_expr = (tree_index_expression *) expr; - tree_argument_list *args = idx_expr->arg_list (); + expr->mark_for_possible_ans_assign (); + return expr; + } + else if (expr->is_assignment_expression () + || expr->is_prefix_expression ()) + { + return expr; + } + else + { + symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0); - if (args == (tree_argument_list *) NULL) - { - tree_identifier *tmp = idx_expr->ident (); - tree *defn = tmp->def (); - if (defn != NULL_TREE && ! defn->is_builtin ()) - { - return retval; - } - } + assert (sr != (symbol_record *) NULL); + + tree_identifier *ans = new tree_identifier (sr); + + return new tree_simple_assignment_expression (ans, expr); } - else if (expr->is_assignment_expression ()) - { - return retval; - } - - tree_identifier *ans = new tree_identifier (sr); - retval = new tree_simple_assignment_expression (ans, expr); - - return retval; } void
--- a/src/pr-output.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/pr-output.cc Sat Nov 06 10:14:11 1993 +0000 @@ -1145,10 +1145,10 @@ tree_constant *tmp = NULL_TREE_CONST; tmp = new tree_constant ((double) prec); - bind_variable ("output_precision", tmp); + bind_builtin_variable ("output_precision", tmp); tmp = new tree_constant ((double) fw); - bind_variable ("output_max_field_width", tmp); + bind_builtin_variable ("output_max_field_width", tmp); } void
--- a/src/pt-base.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/pt-base.h Sat Nov 06 10:14:11 1993 +0000 @@ -111,9 +111,9 @@ virtual int is_assignment_expression (void) const { return 0; } - virtual tree *def (void) - { assert (0); return (tree *) NULL; } - + virtual int is_prefix_expression (void) const + { return 0; } + virtual char *name (void) { assert (0); return (char *) NULL; } @@ -123,24 +123,24 @@ virtual void set_print_flag (int print) { assert (0); } + virtual void mark_for_possible_ans_assign (void) + { assert (0); } + virtual tree_constant assign (tree_constant& t, tree_constant *args, int nargs); virtual void bump_value (tree::expression_type) { assert (0); } - virtual void stash_m_file_name (char *s) - { assert (0); } - - virtual void stash_m_file_time (time_t t) - { assert (0); } - virtual char *m_file_name (void) { return (char *) NULL; } virtual time_t time_parsed (void) { assert (0); return 0; } + virtual int is_system_m_file (void) const + { return 0; } + virtual tree_constant eval (int print) = 0; virtual tree_constant *eval (int print, int nargout);
--- a/src/symtab.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/symtab.cc Sat Nov 06 10:14:11 1993 +0000 @@ -39,38 +39,41 @@ */ symbol_def::symbol_def (void) { - help_string = (char *) NULL; - type = unknown_type; - lifespan = temporary; - sym_class = read_write; - definition = (tree *) NULL; + init_state (); } symbol_def::symbol_def (tree_constant *t) { - help_string = (char *) NULL; - type = variable; - lifespan = temporary; - sym_class = read_write; + init_state (); definition = t; + type = USER_VARIABLE; } symbol_def::symbol_def (tree_builtin *t) { - help_string = (char *) NULL; - type = builtin_function; - lifespan = temporary; - sym_class = read_write; + init_state (); definition = t; + type = BUILTIN_FUNCTION; } symbol_def::symbol_def (tree_function *t) { + init_state (); + definition = t; + type = USER_FUNCTION; +} + +void +symbol_def::init_state (void) +{ + type = UNKNOWN; + eternal = 0; + read_only = 0; + help_string = (char *) NULL; - type = user_function; - lifespan = temporary; - sym_class = read_write; - definition = t; + definition = NULL_TREE; + next_elem = (symbol_def *) NULL; + count = 0; } symbol_def::~symbol_def (void) @@ -79,25 +82,81 @@ delete definition; } +int +symbol_def::is_variable (void) const +{ + return (type == USER_VARIABLE || type == BUILTIN_VARIABLE); +} + +int +symbol_def::is_function (void) const +{ + return (type == USER_FUNCTION || type == BUILTIN_FUNCTION); +} + +int +symbol_def::is_user_variable (void) const +{ + return (type == USER_VARIABLE); +} + +int +symbol_def::is_user_function (void) const +{ + return (type == USER_FUNCTION); +} + +int +symbol_def::is_builtin_variable (void) const +{ + return (type == BUILTIN_VARIABLE); +} + +int +symbol_def::is_builtin_function (void) const +{ + return (type == BUILTIN_FUNCTION); +} + void symbol_def::define (tree_constant *t) { definition = t; - type = variable; + if (! is_builtin_variable ()) + type = USER_VARIABLE; } void symbol_def::define (tree_builtin *t) { definition = t; - type = builtin_function; + type = BUILTIN_FUNCTION; } void symbol_def::define (tree_function *t) { definition = t; - type = user_function; + type = USER_FUNCTION; +} + +void +symbol_def::protect (void) +{ + read_only = 1; +} + +void +symbol_def::unprotect (void) +{ + read_only = 0; + +} + +void +symbol_def::make_eternal (void) +{ + eternal = 1; } tree * @@ -125,51 +184,53 @@ return definition->save (os, mark_as_global); } +int +maybe_delete (symbol_def *def) +{ + int count = 0; + if (def != (symbol_def *) NULL) + { + if (def->count > 0) + { + def->count--; + count = def->count; + if (def->count == 0) + delete def; + } + } + return count; +} + /* * Individual records in a symbol table. */ symbol_record::symbol_record (void) { - nm = (char *) NULL; - formal_param = 0; - forced_global = 0; - var = (symbol_def *) NULL; - fcn = (symbol_def *) NULL; - sv_fcn = (sv_Function) NULL; - next_elem = (symbol_record *) NULL; + init_state (); } -symbol_record::symbol_record (const char *n) +symbol_record::symbol_record (const char *n, + symbol_record *nxt = (symbol_record *) NULL) { + init_state (); nm = strsave (n); - formal_param = 0; - forced_global = 0; - var = (symbol_def *) NULL; - fcn = (symbol_def *) NULL; - sv_fcn = (sv_Function) NULL; - next_elem = (symbol_record *) NULL; + next_elem = nxt; } -symbol_record::symbol_record (const char *n, symbol_record *nxt) +void +symbol_record::init_state (void) { - nm = strsave (n); formal_param = 0; - forced_global = 0; - var = (symbol_def *) NULL; - fcn = (symbol_def *) NULL; + linked_to_global = 0; + nm = (char *) NULL; sv_fcn = (sv_Function) NULL; - next_elem = nxt; + definition = (symbol_def *) NULL; + next_elem = (symbol_record *) NULL; } symbol_record::~symbol_record (void) { delete [] nm; - - if (var != (symbol_def *) NULL && --var->count <= 0) - delete var; - - if (fcn != (symbol_def *) NULL && --fcn->count <= 0) - delete fcn; } char * @@ -181,41 +242,147 @@ char * symbol_record::help (void) const { - if (var != (symbol_def *) NULL) - return var->help (); - else if (fcn != (symbol_def *) NULL) - return fcn->help (); + if (definition != (symbol_def *) NULL) + return definition->help (); else return (char *) NULL; } +void +symbol_record::rename (const char *n) +{ + delete [] nm; + nm = strsave (n); +} + tree * symbol_record::def (void) const { - if (var != (symbol_def *) NULL) - return var->def (); - else if (fcn != (symbol_def *) NULL) - return fcn->def (); + if (definition != (symbol_def *) NULL) + return definition->def (); else - return (tree *) NULL; + return NULL_TREE; } int symbol_record::is_function (void) const { - return (var == (symbol_def *) NULL && fcn != (symbol_def *) NULL); + if (definition != (symbol_def *) NULL) + return definition->is_function (); + else + return 0; +} + +int +symbol_record::is_user_function (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->is_user_function (); + else + return 0; +} + +int +symbol_record::is_builtin_function (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->is_builtin_function (); + else + return 0; } int symbol_record::is_variable (void) const { - return (var != (symbol_def *) NULL); + if (definition != (symbol_def *) NULL) + return definition->is_variable (); + else + return 0; +} + +int +symbol_record::is_user_variable (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->is_user_variable (); + else + return 0; +} + +int +symbol_record::is_builtin_variable (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->is_builtin_variable (); + else + return 0; +} + +unsigned +symbol_record::type (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->type; + else + return 0; } int symbol_record::is_defined (void) const { - return (var != (symbol_def *) NULL || fcn != (symbol_def *) NULL); + if (definition != (symbol_def *) NULL) + return (definition->def () != NULL_TREE); + else + return 0; +} + +int +symbol_record::is_read_only (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->read_only; + else + return 0; +} + +int +symbol_record::is_eternal (void) const +{ + if (definition != (symbol_def *) NULL) + return definition->eternal; + else + return 0; +} + +void +symbol_record::protect (void) +{ + if (definition != (symbol_def *) NULL) + { + definition->protect (); + + if (! is_defined ()) + warning ("protecting undefined variable `%s'", nm); + } +} + +void +symbol_record::unprotect (void) +{ + if (definition != (symbol_def *) NULL) + definition->unprotect (); +} + +void +symbol_record::make_eternal (void) +{ + if (definition != (symbol_def *) NULL) + { + definition->make_eternal (); + + if (! is_defined ()) + warning ("giving eternal life to undefined variable `%s'", nm); + } } void @@ -225,55 +392,34 @@ } int -symbol_record::var_read_only (void) -{ - if (var != (symbol_def *) NULL - && var->sym_class == symbol_def::read_only) - { - error ("can't assign to read only symbol `%s'", nm); - return 1; - } - else - return 0; -} - -int -symbol_record::read_only (void) -{ - if ((var != (symbol_def *) NULL - && var->sym_class == symbol_def::read_only) - || (fcn != (symbol_def *) NULL - && fcn->sym_class == symbol_def::read_only)) - { - error ("can't assign to read only symbol `%s'", nm); - return 1; - } - else - return 0; -} - -int symbol_record::define (tree_constant *t) { - if (var_read_only ()) + if (is_variable () && read_only_error ()) return 0; - tree_constant *saved_def = NULL_TREE_CONST; - - if (var != (symbol_def *) NULL) + tree *saved_def = NULL_TREE; + if (definition == (symbol_def *) NULL) + { + definition = new symbol_def (); + definition->count = 1; + } + else if (is_function ()) { - saved_def = (tree_constant *) var->def (); // XXX FIXME XXX - var->define (t); + symbol_def *new_def = new symbol_def (); + push_def (new_def); + definition->count = 1; } - else + else if (is_variable ()) { - var = new symbol_def (t); - var->count = 1; + saved_def = definition->def (); } + definition->define (t); + if (sv_fcn != (sv_Function) NULL && sv_fcn () < 0) { - var->define (saved_def); +// Would be nice to be able to avoid this cast. XXX FIXME XXX + definition->define ((tree_constant *) saved_def); delete t; return 0; } @@ -286,115 +432,97 @@ int symbol_record::define (tree_builtin *t) { - if (read_only ()) + if (read_only_error ()) return 0; - if (var != (symbol_def *) NULL) + if (is_variable ()) { - if (--var->count <= 0) - delete var; - var = (symbol_def *) NULL; + symbol_def *old_def = pop_def (); + maybe_delete (old_def); } - if (fcn != (symbol_def *) NULL) - fcn->define (t); - else + if (is_function ()) { - fcn = new symbol_def (t); - fcn->count = 1; + symbol_def *old_def = pop_def (); + maybe_delete (old_def); } + symbol_def *new_def = new symbol_def (t); + push_def (new_def); + definition->count = 1; + return 1; } int symbol_record::define (tree_function *t) { - if (read_only ()) + if (read_only_error ()) return 0; - if (var != (symbol_def *) NULL) + if (is_variable ()) { - if (--var->count <= 0) - delete var; - var = (symbol_def *) NULL; + symbol_def *old_def = pop_def (); + maybe_delete (old_def); } - if (fcn != (symbol_def *) NULL) - fcn->define (t); - else + if (is_function ()) { - fcn = new symbol_def (t); - fcn->count = 1; + symbol_def *old_def = pop_def (); + maybe_delete (old_def); } + symbol_def *new_def = new symbol_def (t); + push_def (new_def); + definition->count = 1; + return 1; } int symbol_record::define_as_fcn (tree_constant *t) { - if (read_only ()) + if (is_variable () && read_only_error ()) return 0; - if (var != (symbol_def *) NULL) + if (is_variable ()) { - if (--var->count <= 0) - delete var; - var = (symbol_def *) NULL; + symbol_def *old_def = pop_def (); + maybe_delete (old_def); + } + + if (is_function ()) + { + symbol_def *old_def = pop_def (); + maybe_delete (old_def); } - if (fcn != (symbol_def *) NULL) - fcn->define (t); - else - { - fcn = new symbol_def (t); - fcn->count = 1; - } + symbol_def *new_def = new symbol_def (t); + push_def (new_def); + definition->count = 1; + definition->type = symbol_def::BUILTIN_FUNCTION; return 1; } +int +symbol_record::define_builtin_var (tree_constant *t) +{ + define (t); + if (is_variable ()) + definition->type = symbol_def::BUILTIN_VARIABLE; +} + void symbol_record::document (const char *h) { - if (var != (symbol_def *) NULL) - var->document (h); - else if (fcn != (symbol_def *) NULL) - fcn->document (h); - else - warning ("couldn't document undefined variable `%s'", nm); -} - -void -symbol_record::protect (void) -{ - if (var != (symbol_def *) NULL) - var->sym_class = symbol_def::read_only; - else if (fcn != (symbol_def *) NULL) - fcn->sym_class = symbol_def::read_only; - else - warning ("couldn't protect undefined variable `%s'", nm); -} + if (definition != (symbol_def *) NULL) + { + definition->document (h); -void -symbol_record::unprotect (void) -{ - if (var != (symbol_def *) NULL) - var->sym_class = symbol_def::read_write; - else if (fcn != (symbol_def *) NULL) - fcn->sym_class = symbol_def::read_write; -} - -void -symbol_record::make_eternal (void) -{ - if (var != (symbol_def *) NULL) - var->lifespan = symbol_def::eternal; - else if (fcn != (symbol_def *) NULL) - fcn->lifespan = symbol_def::eternal; - else - warning ("couldn't give eternal life to the variable `%s'", nm); + if (! is_defined ()) + warning ("documenting undefined variable `%s'", nm); + } } int @@ -402,74 +530,65 @@ { int status = 0; - if (var != (symbol_def *) NULL && var->def () != (tree *) NULL) +// This is a kludge, but hey, it doesn't make sense to save them +// anyway, does it? Even if it did, we would just have trouble trying +// to read NaN and Inf on lots of systems anyway... + + if (is_read_only ()) { -// For now, eternal implies builtin. - if (var->lifespan != symbol_def::eternal) - { -// Should we also save the help string? Maybe someday. - os << "# name: " << nm << "\n"; - status = var->save (os, mark_as_global); - } + warning ("save: sorry, can't save read-only variable `%s'", nm); + status = -1; } - else if (fcn != (symbol_def *) NULL) - message ("save", "sorry, can't save functions yet"); + else if (is_function ()) + { + warning ("save: sorry, can't save function `%s'", nm); + status = -1; + } else { -// Kludge! We probably don't want to print warnings for ans, but it -// does seem reasonable to print them for other undefined variables. - if (strcmp (nm, "ans") != 0) - warning ("not saving undefined symbol `%s'", nm); +// Should we also save the help string? Maybe someday. + + os << "# name: " << nm << "\n"; + + status = definition->save (os, mark_as_global); } return status; } int -symbol_record::clear_visible (void) +symbol_record::clear (void) { - int status = 0; - - if (is_defined ()) + int count = 0; + if (linked_to_global) { - if (var != (symbol_def *) NULL - && var->lifespan != symbol_def::eternal) - { - if (--var->count <= 0) - delete var; - var = (symbol_def *) NULL; - forced_global = 0; - status = 1; - } - else if (fcn != (symbol_def *) NULL - && fcn->lifespan != symbol_def::eternal) - { - if (--fcn->count <= 0) - delete fcn; - fcn = (symbol_def *) NULL; - status = 1; - } + count = maybe_delete (definition); + definition = (symbol_def *) NULL; + linked_to_global = 0; } - - return status; + else + { + symbol_def *old_def = pop_def (); + count = maybe_delete (old_def); + } + return count; } void -symbol_record::clear_all (void) +symbol_record::alias (symbol_record *s, int force = 0) { - if (var != (symbol_def *) NULL && var->lifespan != symbol_def::eternal) + sv_fcn = s->sv_fcn; + + if (force && s->definition == (symbol_def *) NULL) { - if (--var->count <= 0) - delete var; - var = (symbol_def *) NULL; - forced_global = 0; + s->definition = new symbol_def (); + definition = s->definition; + definition->count = 2; // Yes, this is correct. } - - if (fcn != (symbol_def *) NULL && fcn->lifespan != symbol_def::eternal) + else if (s->definition != (symbol_def *) NULL) { - if (--fcn->count <= 0) - delete fcn; - fcn = (symbol_def *) NULL; + definition = s->definition; + definition->count++; } } @@ -486,44 +605,15 @@ } void -symbol_record::mark_as_forced_global (void) +symbol_record::mark_as_linked_to_global (void) { - forced_global = 1; + linked_to_global = 1; } int -symbol_record::is_forced_global (void) const -{ - return forced_global; -} - -void -symbol_record::alias (symbol_record *s, int force = 0) +symbol_record::is_linked_to_global (void) const { - sv_fcn = s->sv_fcn; // Maybe this should go in the var symbol_def? - -// formal_param = s->formal_param; // Hmm. -// forced_global = s->forced_global; // Hmm. - - if (force && s->var == (symbol_def *) NULL - && s->fcn == (symbol_def *) NULL) - { - s->var = new symbol_def (); - var = s->var; - var->count = 2; // Yes, this is correct. - return; - } - - if (s->var != (symbol_def *) NULL) - { - var = s->var; - var->count++; - } - else if (s->fcn != (symbol_def *) NULL) - { - fcn = s->fcn; - fcn->count++; - } + return linked_to_global; } symbol_record * @@ -532,6 +622,247 @@ return next_elem; } +void +symbol_record::chain (symbol_record *s) +{ + next_elem = s; +} + +int +symbol_record::read_only_error (void) +{ + if (is_read_only ()) + { + char *tag = "symbol"; + if (is_variable ()) + tag = "variable"; + else if (is_function ()) + tag = "function"; + + error ("can't redefined read-only %s `%s'", tag, nm); + + return 1; + } + else + return 0; +} + +void +symbol_record::push_def (symbol_def *sd) +{ + if (sd == (symbol_def *) NULL) + return; + + sd->next_elem = definition; + definition = sd; +} + +symbol_def * +symbol_record::pop_def (void) +{ + symbol_def *top = definition; + if (definition != (symbol_def *) NULL) + definition = definition->next_elem; + return top; +} + +/* + * A structure for handling verbose information about a symbol_record. + */ + +symbol_record_info::symbol_record_info (void) +{ + init_state (); +} + +symbol_record_info::symbol_record_info (const symbol_record& sr) +{ + init_state (); + + type = sr.type (); + + if (sr.is_variable () && sr.is_defined ()) + { +// Would be nice to avoid this cast. XXX FIXME XXX + tree_constant *tmp = (tree_constant *) sr.def (); + switch (tmp->const_type ()) + { + case tree_constant_rep::scalar_constant: + const_type = SR_INFO_SCALAR; + break; + case tree_constant_rep::complex_scalar_constant: + const_type = SR_INFO_COMPLEX_SCALAR; + break; + case tree_constant_rep::matrix_constant: + const_type = SR_INFO_MATRIX; + break; + case tree_constant_rep::complex_matrix_constant: + const_type = SR_INFO_COMPLEX_MATRIX; + break; + case tree_constant_rep::range_constant: + const_type = SR_INFO_RANGE; + break; + case tree_constant_rep::string_constant: + const_type = SR_INFO_STRING; + break; + default: + break; + } + + nr = tmp->rows (); + nc = tmp->columns (); + + symbol_def *sr_def = sr.definition; + symbol_def *hidden_def = sr_def->next_elem; + if (hidden_def != (symbol_def *) NULL) + { + if (hidden_def->is_user_function ()) + hides = SR_INFO_USER_FUNCTION; + else if (hidden_def->is_builtin_function ()) + hides = SR_INFO_BUILTIN_FUNCTION; + } + } + + eternal = sr.is_eternal (); + read_only = sr.is_read_only (); + + nm = strsave (sr.name ()); + + initialized = 1; +} + +symbol_record_info::symbol_record_info (const symbol_record_info& s) +{ + type = s.type; + const_type = s.const_type; + hides = s.hides; + eternal = s.eternal; + read_only = s.read_only; + nr = s.nr; + nc = s.nc; + nm = strsave (s.nm); + initialized = s.initialized; +} + +symbol_record_info::~symbol_record_info (void) +{ + delete nm; +} + +symbol_record_info& +symbol_record_info::operator = (const symbol_record_info& s) +{ + if (this != &s) + { + delete nm; + type = s.type; + const_type = s.const_type; + hides = s.hides; + eternal = s.eternal; + read_only = s.read_only; + nr = s.nr; + nc = s.nc; + nm = strsave (s.nm); + initialized = s.initialized; + } + return *this; +} + +int +symbol_record_info::is_defined (void) const +{ + return initialized; +} + +int +symbol_record_info::is_read_only (void) const +{ + return read_only; +} + +int +symbol_record_info::is_eternal (void) const +{ + return eternal; +} + +int +symbol_record_info::hides_fcn (void) const +{ + return (hides & SR_INFO_USER_FUNCTION); +} + +int +symbol_record_info::hides_builtin (void) const +{ + return (hides & SR_INFO_BUILTIN_FUNCTION); +} + +char * +symbol_record_info::type_as_string (void) const +{ + if (type == symbol_def::USER_FUNCTION) + return "user function"; + else if (type == symbol_def::BUILTIN_FUNCTION) + return "builtin function"; + else + { + if (const_type == SR_INFO_SCALAR) + return "real scalar"; + else if (const_type == SR_INFO_COMPLEX_SCALAR) + return "complex scalar"; + else if (const_type == SR_INFO_MATRIX) + return "real matrix"; + else if (const_type == SR_INFO_COMPLEX_MATRIX) + return "complex matrix"; + else if (const_type == SR_INFO_RANGE) + return "range"; + else if (const_type == SR_INFO_STRING) + return "string"; + else + return ""; + } +} + +int +symbol_record_info::is_function (void) const +{ + return (type == symbol_def::USER_FUNCTION + || type == symbol_def::BUILTIN_FUNCTION); +} + +int +symbol_record_info::rows (void) const +{ + return nr; +} + +int +symbol_record_info::columns (void) const +{ + return nc; +} + +char * +symbol_record_info::name (void) const +{ + return nm; +} + +void +symbol_record_info::init_state (void) +{ + initialized = 0; + type = symbol_def::UNKNOWN; + const_type = SR_INFO_UNKNOWN; + hides = SR_INFO_NONE; + eternal = 0; + read_only = 0; + nr = -1; + nc = -1; + nm = (char *) NULL; +} + /* * A symbol table. */ @@ -558,7 +889,7 @@ { symbol_record *new_sym; new_sym = new symbol_record (nm, table[index].next ()); - table[index].next_elem = new_sym; + table[index].chain (new_sym); return new_sym; } else if (warn) @@ -568,7 +899,7 @@ } void -symbol_table::clear (void) +symbol_table::clear (int clear_user_functions = 1) { for (int i = 0; i < HASH_TABLE_SIZE; i++) { @@ -576,61 +907,45 @@ while (ptr != (symbol_record *) NULL) { - ptr->clear_all (); + if (ptr->is_user_variable () + || (clear_user_functions && ptr->is_user_function ())) + { + ptr->clear (); + } + ptr = ptr->next (); } } } int -symbol_table::clear (const char *nm) +symbol_table::clear (const char *nm, int clear_user_functions = 1) { int index = hash (nm) & HASH_MASK; - symbol_record *prev = &table[index]; - symbol_record *curr = prev->next (); + symbol_record *ptr = table[index].next (); - while (curr != (symbol_record *) NULL) + while (ptr != (symbol_record *) NULL) { - if (strcmp (curr->name (), nm) == 0) + if (strcmp (ptr->name (), nm) == 0 + && (ptr->is_user_variable () + || (clear_user_functions && ptr->is_user_function ()))) { - if (curr->clear_visible ()) - return 1; + ptr->clear (); + return 1; } - prev = curr; - curr = curr->next (); + ptr = ptr->next (); } return 0; } -// Ugh. - -void -symbol_table::bind_globals (void) -{ - assert (this != global_sym_tab); - - for (int i = 0; i < HASH_TABLE_SIZE; i++) - { - symbol_record *ptr = table[i].next (); - - while (ptr != (symbol_record *) NULL && ! ptr->formal_param) - { - char *nm = ptr->name (); - symbol_record *sr = global_sym_tab->lookup (nm, 0, 0); - if (sr != (symbol_record *) NULL && sr->is_forced_global ()) - ptr->alias (sr, 1); - ptr = ptr->next (); - } - } -} - int symbol_table::save (ostream& os, int mark_as_global = 0) { int status = 0; - char **names = sorted_var_list (); + int count; + char **names = list (count, 1, symbol_def::USER_VARIABLE); if (names != (char **) NULL) { while (*names != (char *) NULL) @@ -670,52 +985,60 @@ return count; } -char ** -symbol_table::list (void) const +static inline int +pstrcmp (char **a, char **b) { - int count; - return list (count); + return strcmp (*a, *b); } -char ** -symbol_table::var_list (void) const +static inline int +symbol_record_info_cmp (symbol_record_info *a, symbol_record_info *b) { - int count; - return var_list (count); + return strcmp (a->name (), b->name ()); } -char ** -symbol_table::fcn_list (void) const -{ - int count; - return fcn_list (count); -} +// This function should probably share code with symbol_table::list. +// XXX FIXME XXX -char ** -symbol_table::list (int& count) const +symbol_record_info * +symbol_table::long_list (int& count, int sort = 0, + unsigned type = SYMTAB_ALL_TYPES, + unsigned scope = SYMTAB_ALL_SCOPES) const { count = 0; int n = size (); if (n == 0) - return (char **) NULL; + return (symbol_record_info *) NULL; - char **symbols = new char * [n+1]; + symbol_record_info *symbols = new symbol_record_info [n+1]; for (int i = 0; i < HASH_TABLE_SIZE; i++) { symbol_record *ptr = table[i].next (); while (ptr != (symbol_record *) NULL) { assert (count < n); - symbols[count++] = strsave (ptr->name ()); + unsigned my_scope = ptr->is_linked_to_global () + 1; // Tricky... + unsigned my_type = ptr->type (); + if ((type & my_type) && (scope & my_scope)) + { + symbols[count++] = symbol_record_info (*ptr); + } ptr = ptr->next (); } } - symbols[count] = (char *) NULL; + symbols[count] = symbol_record_info (); + + if (sort && symbols != (symbol_record_info *) NULL) + qsort ((void *) symbols, count, sizeof (symbol_record_info), + (int (*)(void*, void*)) symbol_record_info_cmp); + return symbols; } char ** -symbol_table::var_list (int& count) const +symbol_table::list (int& count, int sort = 0, + unsigned type = SYMTAB_ALL_TYPES, + unsigned scope = SYMTAB_ALL_SCOPES) const { count = 0; int n = size (); @@ -729,93 +1052,19 @@ while (ptr != (symbol_record *) NULL) { assert (count < n); - if (ptr->is_variable ()) - symbols[count++] = strsave (ptr->name ()); - ptr = ptr->next (); - } - } - symbols[count] = (char *) NULL; - return symbols; -} - -char ** -symbol_table::fcn_list (int& count) const -{ - count = 0; - int n = size (); - if (n == 0) - return (char **) NULL; - - char **symbols = new char * [n+1]; - for (int i = 0; i < HASH_TABLE_SIZE; i++) - { - symbol_record *ptr = table[i].next (); - while (ptr != (symbol_record *) NULL) - { - assert (count < n); - if (ptr->is_function ()) + unsigned my_scope = ptr->is_linked_to_global () + 1; // Tricky... + unsigned my_type = ptr->type (); + if ((type & my_type) && (scope & my_scope)) symbols[count++] = strsave (ptr->name ()); ptr = ptr->next (); } } symbols[count] = (char *) NULL; - return symbols; -} -static inline int -pstrcmp (char **a, char **b) -{ - return strcmp (*a, *b); -} - -char ** -symbol_table::sorted_list (void) const -{ - int count = 0; - return sorted_list (count); -} - -char ** -symbol_table::sorted_var_list (void) const -{ - int count = 0; - return sorted_var_list (count); -} - -char ** -symbol_table::sorted_fcn_list (void) const -{ - int count = 0; - return sorted_fcn_list (count); -} - -char ** -symbol_table::sorted_list (int& count) const -{ - char **symbols = list (count); - if (symbols != (char **) NULL) + if (sort && symbols != (char **) NULL) qsort ((void **) symbols, count, sizeof (char *), (int (*)(void*, void*)) pstrcmp); - return symbols; -} -char ** -symbol_table::sorted_var_list (int& count) const -{ - char **symbols = var_list (count); - if (symbols != (char **) NULL) - qsort ((void **) symbols, count, sizeof (char *), - (int (*)(void*, void*)) pstrcmp); - return symbols; -} - -char ** -symbol_table::sorted_fcn_list (int& count) const -{ - char **symbols = fcn_list (count); - if (symbols != (char **) NULL) - qsort ((void **) symbols, count, sizeof (char *), - (int (*)(void*, void*)) pstrcmp); return symbols; }
--- a/src/symtab.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/symtab.h Sat Nov 06 10:14:11 1993 +0000 @@ -50,6 +50,7 @@ class symbol_def; class symbol_record; +class symbol_record_info; class symbol_table; /* @@ -58,29 +59,10 @@ class symbol_def { friend class symbol_record; + friend class symbol_record_info; public: - enum symbol_type - { - unknown_type, - variable, - builtin_function, - user_function, - }; - - enum symbol_lifespan - { - temporary, - eternal, - }; - - enum symbol_class - { - read_write, - read_only, - }; - symbol_def (void); symbol_def (tree_constant *t); symbol_def (tree_builtin *t); @@ -88,25 +70,50 @@ ~symbol_def (void); + int is_variable (void) const; + int is_function (void) const; + int is_user_variable (void) const; + int is_user_function (void) const; + int is_builtin_variable (void) const; + int is_builtin_function (void) const; + void define (tree_constant *t); void define (tree_builtin *t); void define (tree_function *t); + void protect (void); + void unprotect (void); + void make_eternal (void); + tree *def (void) const; char *help (void) const; void document (const char *h); int save (ostream& os, int mark_as_global); + enum TYPE + { + UNKNOWN = 0, + USER_FUNCTION = 1, + USER_VARIABLE = 2, + BUILTIN_FUNCTION = 4, + BUILTIN_VARIABLE = 8 + }; + + friend maybe_delete (symbol_def *def); + private: + unsigned type : 4; + unsigned eternal : 1; + unsigned read_only : 1; + char *help_string; - symbol_lifespan lifespan; - symbol_class sym_class; - symbol_type type; tree *definition; + symbol_def *next_elem; int count; - int preserve; + + void init_state (void); symbol_def (const symbol_def& sd); symbol_def& operator = (const symbol_def& sd); @@ -118,12 +125,11 @@ class symbol_record { - friend class symbol_table; + friend class symbol_record_info; public: symbol_record (void); - symbol_record (const char *n); - symbol_record (const char *n, symbol_record *nxt); + symbol_record (const char *n, symbol_record *nxt = (symbol_record *) NULL); ~symbol_record (void); @@ -131,57 +137,135 @@ char *help (void) const; tree *def (void) const; + void rename (const char *n); + int is_function (void) const; + int is_user_function (void) const; + int is_builtin_function (void) const; int is_variable (void) const; + int is_user_variable (void) const; + int is_builtin_variable (void) const; + + unsigned type (void) const; int is_defined (void) const; - - void set_sv_function (sv_Function f); - - int var_read_only (void); - int read_only (void); - - int define (tree_constant *t); - int define (tree_builtin *t); - int define (tree_function *t); - int define_as_fcn (tree_constant *t); - - void document (const char *h); + int is_read_only (void) const; + int is_eternal (void) const; void protect (void); void unprotect (void); void make_eternal (void); + void set_sv_function (sv_Function f); + + int define (tree_constant *t); + int define (tree_builtin *t); + int define (tree_function *t); + int define_as_fcn (tree_constant *t); + int define_builtin_var (tree_constant *t); + + void document (const char *h); + int save (ostream& os, int mark_as_global = 0); - int clear_visible (void); - void clear_all (void); + int clear (void); + + void alias (symbol_record *s, int force = 0); void mark_as_formal_parameter (void); int is_formal_parameter (void) const; - void mark_as_forced_global (void); - int is_forced_global (void) const; - - void alias (symbol_record *s, int force = 0); + void mark_as_linked_to_global (void); + int is_linked_to_global (void) const; symbol_record *next (void) const; + void chain (symbol_record *s); + private: + unsigned formal_param : 1; + unsigned linked_to_global : 1; + char *nm; - int formal_param; - int forced_global; - symbol_def *var; - symbol_def *fcn; sv_Function sv_fcn; + symbol_def *definition; symbol_record *next_elem; - symbol_record (const symbol_record& s) { assert (0); } + void init_state (void); + + int read_only_error (void); + + void push_def (symbol_def *sd); + symbol_def *pop_def (void); + symbol_record& operator = (const symbol_record& s); }; /* + * A structure for handling verbose information about a symbol_record. + */ + +class +symbol_record_info +{ +public: + + symbol_record_info (void); + symbol_record_info (const symbol_record& s); + + symbol_record_info (const symbol_record_info& s); + + ~symbol_record_info (void); + + symbol_record_info& operator = (const symbol_record_info& s); + + int is_defined (void) const; + int is_read_only (void) const; + int is_eternal (void) const; + int hides_fcn (void) const; + int hides_builtin (void) const; + char *type_as_string (void) const; + int is_function (void) const; + int rows (void) const; + int columns (void) const; + char *name (void) const; + + enum HIDES + { + SR_INFO_NONE = 0, + SR_INFO_USER_FUNCTION = 1, + SR_INFO_BUILTIN_FUNCTION = 2 + }; + + enum CONST_TYPE + { + SR_INFO_UNKNOWN = 0, + SR_INFO_SCALAR = 1, + SR_INFO_COMPLEX_SCALAR = 2, + SR_INFO_MATRIX = 4, + SR_INFO_COMPLEX_MATRIX = 8, + SR_INFO_RANGE = 16, + SR_INFO_STRING = 32 + }; + +private: + + void init_state (void); + + unsigned type : 4; + unsigned const_type : 6; + unsigned hides : 2; + unsigned eternal : 1; + unsigned read_only : 1; + int nr; + int nc; + char *nm; + + int initialized; +}; + +/* * A symbol table. */ class @@ -193,31 +277,31 @@ symbol_record *lookup (const char *nm, int insert = 0, int warn = 0); - void clear (void); - int clear (const char *nm); - - void bind_globals (void); + void clear (int clear_user_functions = 1); + int clear (const char *nm, int clear_user_functions = 1); int save (ostream& os, int mark_as_global = 0); int save (ostream& os, const char *name, int mark_as_global = 0); int size (void) const; - char **list (void) const; - char **var_list (void) const; - char **fcn_list (void) const; +#define SYMTAB_LOCAL_SCOPE 1 +#define SYMTAB_GLOBAL_SCOPE 2 - char **list (int& count) const; - char **var_list (int& count) const; - char **fcn_list (int& count) const; +#define SYMTAB_ALL_SCOPES (SYMTAB_LOCAL_SCOPE | SYMTAB_GLOBAL_SCOPE) - char **sorted_list (void) const; - char **sorted_var_list (void) const; - char **sorted_fcn_list (void) const; +#define SYMTAB_ALL_TYPES (symbol_def::USER_FUNCTION \ + | symbol_def::USER_VARIABLE \ + | symbol_def::BUILTIN_FUNCTION \ + | symbol_def::BUILTIN_VARIABLE) - char **sorted_list (int& count) const; - char **sorted_var_list (int& count) const; - char **sorted_fcn_list (int& count) const; + symbol_record_info *long_list (int& count, int sort = 0, + unsigned type = SYMTAB_ALL_TYPES, + unsigned scope = SYMTAB_ALL_SCOPES) const; + + char **list (int& count, int sort = 0, + unsigned type = SYMTAB_ALL_TYPES, + unsigned scope = SYMTAB_ALL_SCOPES) const; private:
--- a/src/t-builtins.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/t-builtins.cc Sat Nov 06 10:14:11 1993 +0000 @@ -92,8 +92,6 @@ extern char *replace_in_documentation (); } -extern int symbol_out_of_date (symbol_record *s); - // Is this a parametric plot? Makes a difference for 3D plotting. extern int parametric_plot; @@ -218,11 +216,12 @@ char *directory = get_working_directory ("cd"); tree_constant *dir = new tree_constant (directory); - bind_protected_variable ("PWD", dir); + bind_builtin_variable ("PWD", dir, 1); return retval; } +#if 0 static int in_list (char *s, char **list) { @@ -235,32 +234,44 @@ return 0; } +#endif /* * Wipe out user-defined variables and functions given a list of - * regular expressions. + * regular expressions. + * + * It's not likely that this works correctly now. XXX FIXME XXX */ tree_constant builtin_clear (int argc, char **argv) { tree_constant retval; + +// Always clear the local table, but don't clear currently compiled +// functions unless we are at the top level. (Allowing that to happen +// inside functions would result in pretty odd behavior...) + + int clear_user_functions = (curr_sym_tab == top_level_sym_tab); + if (argc == 1) { curr_sym_tab->clear (); - if (curr_sym_tab == top_level_sym_tab) - global_sym_tab->clear (); + global_sym_tab->clear (clear_user_functions); } else { - int count; - char **names = curr_sym_tab->list (count); - - int g_count; - char **g_names = global_sym_tab->list (g_count); - - int num_cleared = 0; - char **locals_cleared = new char * [count+1]; - locals_cleared[num_cleared] = (char *) NULL; + int lcount; + char **lvars = curr_sym_tab->list (lcount, 0, + symbol_def::USER_VARIABLE, + SYMTAB_LOCAL_SCOPE); + int gcount; + char **gvars = curr_sym_tab->list (gcount, 0, + symbol_def::USER_VARIABLE, + SYMTAB_GLOBAL_SCOPE); + int fcount; + char **fcns = curr_sym_tab->list (fcount, 0, + symbol_def::USER_FUNCTION, + SYMTAB_ALL_SCOPES); while (--argc > 0) { @@ -270,38 +281,41 @@ Regex rx (*argv); int i; - for (i = 0; i < count; i++) + for (i = 0; i < lcount; i++) { - String nm (names[i]); - if (nm.matches (rx) && curr_sym_tab->clear (names[i])) + String nm (lvars[i]); + if (nm.matches (rx)) + curr_sym_tab->clear (lvars[i]); + } + + int count; + for (i = 0; i < gcount; i++) + { + String nm (gvars[i]); + if (nm.matches (rx)) { - locals_cleared[num_cleared++] = strsave (names[i]); - locals_cleared[num_cleared] = (char *) NULL; + count = curr_sym_tab->clear (gvars[i]); + if (count > 0) + global_sym_tab->clear (gvars[i], clear_user_functions); } } - if (curr_sym_tab == top_level_sym_tab) + for (i = 0; i < fcount; i++) { - for (i = 0; i < g_count; i++) + String nm (fcns[i]); + if (nm.matches (rx)) { - String nm (g_names[i]); - if (nm.matches (rx) - && ! in_list (g_names[i], locals_cleared)) - { - global_sym_tab->clear (g_names[i]); - } + count = curr_sym_tab->clear (fcns[i]); + if (count > 0) + global_sym_tab->clear (fcns[i], clear_user_functions); } } } } - int i = 0; - while (locals_cleared[i] != (char *) NULL) - delete [] locals_cleared[i++]; - delete [] locals_cleared; - - delete [] names; - delete [] g_names; + delete [] lvars; + delete [] gvars; + delete [] fcns; } return retval; @@ -315,22 +329,9 @@ { tree_constant retval; if (argc == 3) - { - symbol_record *sym_rec = curr_sym_tab->lookup (argv[1], 0); - if (sym_rec == (symbol_record *) NULL) - { - sym_rec = global_sym_tab->lookup (argv[1], 0); - if (sym_rec == (symbol_record *) NULL) - { - error ("document: no such symbol `%s'", argv[1]); - return retval; - } - } - sym_rec->document (argv[2]); - } + document_symbol (argv[1], argv[2]); else print_usage ("document"); - return retval; } @@ -848,20 +849,54 @@ if (argc == 1) { - curr_sym_tab->save (stream); - global_sym_tab->save (stream, 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])); + + delete [] vars; } else { while (--argc > 0) { argv++; - if (! curr_sym_tab->save (stream, *argv)) - if (! global_sym_tab->save (stream, *argv, 1)) - { - warning ("save: no such variable `%s'", *argv); - continue; - } + + int count; + char **lvars = curr_sym_tab->list (count, 0, + symbol_def::USER_VARIABLE); + Regex rx (*argv); + + int saved_or_error = 0; + int i; + for (i = 0; i < count; i++) + { + String nm (lvars[i]); + if (nm.matches (rx) + && curr_sym_tab->save (stream, lvars[i]) != 0) + saved_or_error++; + } + + char **bvars = global_sym_tab->list (count, 0, + symbol_def::BUILTIN_VARIABLE); + + for (i = 0; i < count; i++) + { + String nm (bvars[i]); + if (nm.matches (rx) + && global_sym_tab->save (stream, bvars[i]) != 0) + saved_or_error++; + } + + delete [] lvars; + delete [] bvars; + + if (! saved_or_error) + warning ("save: no such variable `%s'", *argv); } } @@ -928,104 +963,160 @@ /* * List variable names. */ +static void +print_symbol_info_line (ostrstream& output_buf, const symbol_record_info& s) +{ + output_buf << (s.is_read_only () ? " -" : " w"); + output_buf << (s.is_eternal () ? "- " : "d "); +#if 0 + output_buf << (s.hides_fcn () ? "f" : (s.hides_builtin () ? "F" : "-")); +#endif + output_buf.form (" %-16s", s.type_as_string ()); + if (s.is_function ()) + output_buf << " - -"; + else + { + output_buf.form ("%7d", s.rows ()); + output_buf.form ("%7d", s.columns ()); + } + output_buf << " " << s.name () << "\n"; +} + +static void +print_long_listing (ostrstream& output_buf, symbol_record_info *s) +{ + if (s == (symbol_record_info *) NULL) + return; + + symbol_record_info *ptr = s; + while (ptr->is_defined ()) + { + print_symbol_info_line (output_buf, *ptr); + ptr++; + } +} + +static int +maybe_list (const char *header, ostrstream& output_buf, + int show_verbose, symbol_table *sym_tab, unsigned type, + unsigned scope) +{ + int count; + int status = 0; + if (show_verbose) + { + symbol_record_info *symbols; + symbols = sym_tab->long_list (count, 1, type, scope); + if (symbols != (symbol_record_info *) NULL && count > 0) + { + output_buf << "\n" << header << "\n\n" + << "prot type rows cols name\n" + << "==== ==== ==== ==== ====\n"; + + print_long_listing (output_buf, symbols); + status = 1; + } + delete [] symbols; + } + else + { + char **symbols = sym_tab->list (count, 1, type, scope); + if (symbols != (char **) NULL && count > 0) + { + output_buf << "\n" << header << "\n\n"; + list_in_columns (output_buf, symbols); + status = 1; + } + delete [] symbols; + } + return status; +} + tree_constant builtin_who (int argc, char **argv) { tree_constant retval; - int show_global = 0; - int show_local = 1; - int show_top = 0; - int show_fcns = 0; + + int show_builtins = 0; + int show_functions = (curr_sym_tab == top_level_sym_tab); + int show_variables = 1; + int show_verbose = 0; if (argc > 1) - show_local = 0; + { + show_functions = 0; + show_variables = 0; + } for (int i = 1; i < argc; i++) { argv++; - if (strcmp (*argv, "-all") == 0) + if (strcmp (*argv, "-all") == 0 || strcmp (*argv, "-a") == 0) { - show_global++; - show_local++; - show_top++; - show_fcns++; + show_builtins++; + show_functions++; + show_variables++; } - else if (strcmp (*argv, "-global") == 0) - show_global++; - else if (strcmp (*argv, "-local") == 0) - show_local++; - else if (strcmp (*argv, "-top") == 0) - show_top++; - else if (strcmp (*argv, "-fcn") == 0 - || strcmp (*argv, "-fcns") == 0 - || strcmp (*argv, "-functions") == 0) - show_fcns++; + else if (strcmp (*argv, "-builtins") == 0 + || strcmp (*argv, "-b") == 0) + show_builtins++; + 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) + show_variables++; else - { - warning ("who: unrecognized option `%s'", *argv); - if (argc == 2) - show_local = 1; - } + warning ("who: unrecognized option `%s'", *argv); + } + +// If the user specified -l and nothing else, show variables. If +// evaluating this at the top level, also show functions. + + if (show_verbose && ! (show_builtins || show_functions || show_variables)) + { + show_functions = (curr_sym_tab == top_level_sym_tab); + show_variables = 1; } ostrstream output_buf; int pad_after = 0; - if (show_global) + + if (show_builtins) { - int count = 0; - char **symbols = global_sym_tab->sorted_var_list (count); - if (symbols != (char **) NULL && count > 0) - { - output_buf << "\n*** global symbols:\n\n"; - list_in_columns (output_buf, symbols); - delete [] symbols; - pad_after++; - } - } + pad_after += maybe_list ("*** built-in variables:", + output_buf, show_verbose, global_sym_tab, + symbol_def::BUILTIN_VARIABLE, + SYMTAB_ALL_SCOPES); - if (show_top) - { - int count = 0; - char **symbols = top_level_sym_tab->sorted_var_list (count); - if (symbols != (char **) NULL && count > 0) - { - output_buf << "\n*** top level symbols:\n\n"; - list_in_columns (output_buf, symbols); - delete [] symbols; - pad_after++; - } + pad_after += maybe_list ("*** built-in functions:", + output_buf, show_verbose, global_sym_tab, + symbol_def::BUILTIN_FUNCTION, + SYMTAB_ALL_SCOPES); } - if (show_local) + if (show_functions) { - if (show_top && curr_sym_tab == top_level_sym_tab) - output_buf << - "\ncurrent (local) symbol table == top level symbol table\n"; - else - { - int count = 0; - char **symbols = curr_sym_tab->sorted_var_list (count); - if (symbols != (char **) NULL && count > 0) - { - output_buf << "\n*** local symbols:\n\n"; - list_in_columns (output_buf, symbols); - delete [] symbols; - pad_after++; - } - } + pad_after += maybe_list ("*** currently compiled functions:", + output_buf, show_verbose, global_sym_tab, + symbol_def::USER_FUNCTION, + SYMTAB_ALL_SCOPES); } - if (show_fcns) + if (show_variables) { - int count = 0; - char **symbols = global_sym_tab->sorted_fcn_list (count); - if (symbols != (char **) NULL && count > 0) - { - output_buf << "\n*** functions builtin or currently compiled:\n\n"; - list_in_columns (output_buf, symbols); - delete [] symbols; - pad_after++; - } + pad_after += maybe_list ("*** local user variables:", + output_buf, show_verbose, curr_sym_tab, + symbol_def::USER_VARIABLE, + SYMTAB_LOCAL_SCOPE); + + pad_after += maybe_list ("*** globally visible user variables:", + output_buf, show_verbose, curr_sym_tab, + symbol_def::USER_VARIABLE, + SYMTAB_GLOBAL_SCOPE); } if (pad_after)
--- a/src/toplev.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/toplev.h Sat Nov 06 10:14:11 1993 +0000 @@ -28,7 +28,14 @@ class tree; -extern volatile void clean_up_and_exit (int); +// Tell g++ that clean_up_and_exit doesn't return; + +#ifdef __GNUG__ +typedef void v_fcn_i (int); +volatile v_fcn_i clean_up_and_exit; +#endif + +extern void clean_up_and_exit (int); extern void parse_and_execute (char*, int); extern void parse_and_execute (FILE*, int); @@ -56,6 +63,9 @@ // Name of the info file specified on command line. extern char *info_file; +// Name of the editor to be invoked by the edit_history command. +extern char *editor; + // If nonzero, don't do fancy line editing. extern int no_line_editing;
--- a/src/tree.h.old Wed Nov 03 21:38:05 1993 +0000 +++ b/src/tree.h.old Sat Nov 06 10:14:11 1993 +0000 @@ -84,6 +84,7 @@ class tree_word_list; class tree_command; class tree_command_list; +class tree_global_command; class tree_while_command; class tree_for_command; class tree_if_command; @@ -133,10 +134,16 @@ tree_builtin : public tree { public: - tree_builtin (void); - tree_builtin (int i_max, int o_max, Mapper_fcn& m_fcn, symbol_record *s); - tree_builtin (int i_max, int o_max, Text_fcn t_fcn, symbol_record *s); - tree_builtin (int i_max, int o_max, General_fcn t_fcn, symbol_record *s); + tree_builtin (const char *nm = (char *) NULL); + + tree_builtin (int i_max, int o_max, Mapper_fcn& m_fcn, + const char *nm = (char *) NULL); + + tree_builtin (int i_max, int o_max, Text_fcn t_fcn, + const char *nm = (char *) NULL); + + tree_builtin (int i_max, int o_max, General_fcn t_fcn, + const char *nm = (char *) NULL); ~tree_builtin (void); @@ -151,7 +158,6 @@ tree_constant *eval (const tree_constant *args, int n_in, int n_out, int print); - tree *def (void); char *name (void); int max_expected_args (void); @@ -162,9 +168,7 @@ Mapper_fcn mapper_fcn; Text_fcn text_fcn; General_fcn general_fcn; - symbol_record *sym; // Is this really needed? It points back - // to the symbol record that contains this - // builtin function... + char *my_name; }; /* @@ -183,9 +187,8 @@ int is_identifier (void) const; - tree *def (void); char *name (void); - symbol_record *symrec (void); + void rename (const char *n); tree_identifier *define (tree_constant *t); tree_identifier *define (tree_function *t); @@ -205,6 +208,8 @@ void mark_as_formal_parameter (void); + void mark_for_possible_ans_assign (void); + tree_constant eval (int print); tree_constant *eval (int print, int nargout); @@ -218,6 +223,7 @@ private: symbol_record *sym; + int maybe_do_ans_assign; }; /* @@ -242,6 +248,9 @@ char *m_file_name (void); time_t time_parsed (void); + void mark_as_system_m_file (void); + int is_system_m_file (void) const; + void stash_function_name (char *s); char *function_name (void); @@ -267,6 +276,7 @@ char *file_name; char *fcn_name; time_t t_parsed; + int system_m_file; }; /* @@ -303,6 +313,8 @@ void eval_error (void); + int is_prefix_expression (void) const; + private: tree_identifier *id; }; @@ -482,6 +494,8 @@ tree_argument_list *arg_list (void); + void mark_for_possible_ans_assign (void); + tree_constant eval (int print); tree_constant *eval (int print, int nargout); @@ -644,6 +658,33 @@ }; /* + * Global. + */ +class +tree_global_command : public tree_command +{ + public: + tree_global_command (int l = -1, int c = -1); + tree_global_command (symbol_record *s, int l = -1, int c = -1); + tree_global_command (symbol_record *s, tree *e, int l = -1, int c = -1); + + ~tree_global_command (void); + + tree_global_command *chain (symbol_record *s, int l = -1, int c = -1); + tree_global_command *chain (symbol_record *s, tree *e, int l = -1, int c = -1); + tree_global_command *reverse (void); + + tree_constant eval (int print); + + void eval_error (void); + + private: + symbol_record *sr; // Symbol record from local symbol table. + tree *rhs; // RHS of assignment. + tree_global_command *next; // Next global command. +}; + +/* * While. */ class
--- a/src/user-prefs.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/user-prefs.cc Sat Nov 06 10:14:11 1993 +0000 @@ -48,7 +48,7 @@ static int check_str_pref (char *var) { - char *val = octave_string_variable (var); + char *val = builtin_string_variable (var); int pref = -1; if (val != (char *) NULL) { @@ -237,6 +237,30 @@ } /* + * Should Octave always check to see if M-files have changed since + * they were last compiled? + */ +int +ignore_function_time_stamp (void) +{ + int pref = 0; + + char *val = builtin_string_variable ("ignore_function_time_stamp"); + + if (val != (char *) NULL) + { + if (strncmp (val, "all", 3) == 0) + pref = 2; + if (strncmp (val, "system", 6) == 0) + pref = 1; + } + + user_pref.ignore_function_time_stamp = pref; + + return 0; +} + +/* * Should should big matrices be split into smaller slices for output? */ int @@ -301,7 +325,7 @@ warn_assign_as_truth_value (void) { user_pref.warn_assign_as_truth_value = - check_str_pref ("user_pref.warn_assign_as_truth_value"); + check_str_pref ("warn_assign_as_truth_value"); return 0; } @@ -326,7 +350,7 @@ static int kludge = 0; double val; - if (octave_real_scalar_variable ("output_max_field_width", val) == 0) + if (builtin_real_scalar_variable ("output_max_field_width", val) == 0) { int ival = NINT (val); if (ival > 0 && (double) ival == val) @@ -355,7 +379,7 @@ static int kludge = 0; double val; - if (octave_real_scalar_variable ("output_precision", val) == 0) + if (builtin_real_scalar_variable ("output_precision", val) == 0) { int ival = NINT (val); if (ival >= 0 && (double) ival == val) @@ -381,7 +405,7 @@ { int status = 0; - char *s = octave_string_variable ("LOADPATH"); + char *s = builtin_string_variable ("LOADPATH"); if (s != (char *) NULL) { delete [] user_pref.loadpath; @@ -401,7 +425,7 @@ { int status = 0; - char *s = octave_string_variable ("INFO_FILE"); + char *s = builtin_string_variable ("INFO_FILE"); if (s != (char *) NULL) { delete [] user_pref.info_file; @@ -417,11 +441,31 @@ } int +sv_editor (void) +{ + int status = 0; + + char *s = builtin_string_variable ("EDITOR"); + if (s != (char *) NULL) + { + delete [] user_pref.editor; + user_pref.editor = s; + } + else + { + warning ("invalid value specified for EDITOR"); + status = -1; + } + + return status; +} + +int sv_ps1 (void) { int status = 0; - char *s = octave_string_variable ("PS1"); + char *s = builtin_string_variable ("PS1"); if (s != (char *) NULL) { delete [] user_pref.ps1; @@ -441,7 +485,7 @@ { int status = 0; - char *s = octave_string_variable ("PS2"); + char *s = builtin_string_variable ("PS2"); if (s != (char *) NULL) { delete [] user_pref.ps2; @@ -461,7 +505,7 @@ { int status = 0; - char *s = octave_string_variable ("PWD"); + char *s = builtin_string_variable ("PWD"); if (s != (char *) NULL) { delete [] user_pref.pwd; @@ -481,7 +525,7 @@ { int status = 0; - char *s = octave_string_variable ("gnuplot_binary"); + char *s = builtin_string_variable ("gnuplot_binary"); if (s != (char *) NULL) { delete [] user_pref.gnuplot_binary; @@ -501,7 +545,7 @@ { int status = 0; - char *s = octave_string_variable ("PAGER"); + char *s = builtin_string_variable ("PAGER"); if (s != (char *) NULL) { delete [] user_pref.pager_binary;
--- a/src/user-prefs.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/user-prefs.h Sat Nov 06 10:14:11 1993 +0000 @@ -42,6 +42,7 @@ int resize_on_range_error; int return_last_computed_value; int silent_functions; + int ignore_function_time_stamp; int split_long_rows; int treat_neg_dim_as_zero; int warn_comma_in_global_decl; @@ -53,6 +54,7 @@ char *loadpath; char *info_file; + char *editor; char *ps1; char *ps2; char *pwd; @@ -74,6 +76,7 @@ extern int resize_on_range_error (void); extern int return_last_computed_value (void); extern int silent_functions (void); +extern int ignore_function_time_stamp (void); extern int split_long_rows (void); extern int treat_neg_dim_as_zero (void); extern int warn_comma_in_global_decl (void); @@ -86,6 +89,7 @@ extern int sv_loadpath (void); extern int sv_info_file (void); +extern int sv_editor (void); extern int sv_pager_binary (void); extern int sv_ps1 (void); extern int sv_ps2 (void);
--- a/src/utils.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/utils.cc Sat Nov 06 10:14:11 1993 +0000 @@ -386,7 +386,7 @@ return path; } -static char * +char * octave_home (void) { static char *home = (char *) NULL; @@ -399,7 +399,7 @@ return home; } -static char * +char * octave_lib_dir (void) { static char *ol = (char *) NULL; @@ -410,7 +410,7 @@ return ol; } -static char * +char * octave_info_dir (void) { static char *oi = (char *) NULL; @@ -453,6 +453,19 @@ } char * +default_editor (void) +{ + static char *editor_string = (char *) NULL; + delete [] editor_string; + char *env_editor = getenv ("EDITOR"); + if (env_editor == (char *) NULL || *env_editor == '\0') + editor_string = strsave ("vi"); + else + editor_string = strsave (env_editor); + return editor_string; +} + +char * get_site_defaults (void) { static char *sd = (char *) NULL;
--- a/src/utils.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/utils.h Sat Nov 06 10:14:11 1993 +0000 @@ -48,8 +48,12 @@ extern void raw_mode (int); extern int kbhit (void); extern char **pathstring_to_vector (char *); +extern char *octave_home (void); +extern char *octave_lib_dir (void); +extern char *octave_info_dir (void); extern char *default_path (void); extern char *default_info_file (void); +extern char *default_editor (void); extern char *get_site_defaults (void); extern char *default_pager (void); extern char *file_in_path (const char *, const char *);
--- a/src/variables.cc Wed Nov 03 21:38:05 1993 +0000 +++ b/src/variables.cc Sat Nov 06 10:14:11 1993 +0000 @@ -35,7 +35,11 @@ #include "statdefs.h" #include "tree-const.h" #include "variables.h" +#include "user-prefs.h" #include "symtab.h" +#include "builtins.h" +#include "g-builtins.h" +#include "t-builtins.h" #include "error.h" #include "utils.h" #include "tree.h" @@ -50,6 +54,16 @@ // Symbol table for global symbols. symbol_table *global_sym_tab; +void +initialize_symbol_tables (void) +{ + global_sym_tab = new symbol_table (); + + top_level_sym_tab = new symbol_table (); + + curr_sym_tab = top_level_sym_tab; +} + /* * Is there a corresponding M-file that is newer than the symbol * definition? @@ -57,141 +71,218 @@ int symbol_out_of_date (symbol_record *sr) { - int status = 0; + int ignore = user_pref.ignore_function_time_stamp; + + if (ignore == 2) + return 0; + if (sr != (symbol_record *) NULL) { tree *ans = sr->def (); if (ans != NULL_TREE) { char *mf = ans->m_file_name (); - if (mf != (char *) NULL) + if (! (mf == (char *) NULL + || (ignore && ans->is_system_m_file ()))) { time_t tp = ans->time_parsed (); - status = is_newer (mf, tp); + char *fname = m_file_in_path (mf); + int status = is_newer (fname, tp); + delete [] fname; + if (status > 0) + return 1; } } } - return status; + return 0; } -/* - * Force a symbol into the global symbol table. - */ -symbol_record * -force_global (char *name) +void +document_symbol (const char *name, const char *help) { - symbol_record *retval = (symbol_record *) NULL; - - if (valid_identifier (name)) + if (is_builtin_variable (name)) { - symbol_record *sr; - sr = curr_sym_tab->lookup (name, 0, 0); - if (sr == (symbol_record *) NULL) + error ("sorry, can't redefine help for builtin variables"); + } + else + { + symbol_record *sym_rec = curr_sym_tab->lookup (name, 0); + if (sym_rec == (symbol_record *) NULL) { - retval = global_sym_tab->lookup (name, 1, 0); - retval->mark_as_forced_global (); - } - else if (sr->is_formal_parameter ()) - { - error ("formal parameter `%s' can't be made global", name); + error ("document: no such symbol `%s'", name); } else { - retval = global_sym_tab->lookup (name, 1, 0); - retval->mark_as_forced_global (); - retval->alias (sr, 1); - 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); + sym_rec->document (help); } } +} - if (sr != (symbol_record *) NULL) - { - sr->define (val); - return 0; - } - else - return 1; +void +install_builtin_mapper_function (builtin_mapper_functions *mf) +{ + symbol_record *sym_rec = global_sym_tab->lookup (mf->name, 1); + sym_rec->unprotect (); + + Mapper_fcn mfcn; + mfcn.neg_arg_complex = mf->neg_arg_complex; + mfcn.d_d_mapper = mf->d_d_mapper; + mfcn.d_c_mapper = mf->d_c_mapper; + mfcn.c_c_mapper = mf->c_c_mapper; + + tree_builtin *def = new tree_builtin (mf->nargin_max, + mf->nargout_max, mfcn, + mf->name); + + sym_rec->define (def); + + sym_rec->document (mf->help_string); + sym_rec->make_eternal (); + sym_rec->protect (); +} + +void +install_builtin_text_function (builtin_text_functions *tf) +{ + symbol_record *sym_rec = global_sym_tab->lookup (tf->name, 1); + sym_rec->unprotect (); + + tree_builtin *def = new tree_builtin (tf->nargin_max, 1, + tf->text_fcn, tf->name); + + sym_rec->define (def); + + sym_rec->document (tf->help_string); + sym_rec->make_eternal (); + sym_rec->protect (); + } -int -bind_protected_variable (char *varname, tree_constant *val) +void +install_builtin_general_function (builtin_general_functions *gf) +{ + symbol_record *sym_rec = global_sym_tab->lookup (gf->name, 1); + sym_rec->unprotect (); + + tree_builtin *def = new tree_builtin (gf->nargin_max, + gf->nargout_max, + gf->general_fcn, gf->name); + + sym_rec->define (def); + + sym_rec->document (gf->help_string); + sym_rec->make_eternal (); + sym_rec->protect (); +} + +void +install_builtin_variable (builtin_string_variables *sv) { -// 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. + tree_constant *val = new tree_constant (sv->value); + + bind_builtin_variable (sv->name, val, 0, 1, sv->sv_function, + sv->help_string); +} + +void +install_builtin_variable_as_function (const char *name, tree_constant *val, + int protect = 0, int eternal = 0) +{ + symbol_record *sym_rec = global_sym_tab->lookup (name, 1); + sym_rec->unprotect (); + + char *tmp_help = sym_rec->help (); + sym_rec->define_as_fcn (val); + + sym_rec->document (tmp_help); + + if (protect) + sym_rec->protect (); + + if (eternal) + sym_rec->make_eternal (); +} + +void +bind_nargin_and_nargout (symbol_table *sym_tab, int nargin, int nargout) +{ + tree_constant *tmp; 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; + sr = sym_tab->lookup ("nargin", 1, 0); + sr->unprotect (); + tmp = new tree_constant (nargin-1); + sr->define (tmp); + sr->protect (); + + sr = sym_tab->lookup ("nargout", 1, 0); + sr->unprotect (); + tmp = new tree_constant (nargout); + sr->define (tmp); + sr->protect (); } /* - * 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. + * Give a global variable a definition. This will insert the symbol + * in the global table if necessary. + */ +void +bind_builtin_variable (const char *varname, tree_constant *val, + int protect = 0, int eternal = 0, + sv_Function sv_fcn = (sv_Function) 0, + const char *help = (char *) 0) +{ + symbol_record *sr = global_sym_tab->lookup (varname, 1, 0); + +// It is a programming error for a builtin symbol to be missing. +// Besides, we just inserted it, so it must be there. + + assert (sr != (symbol_record *) NULL); + + sr->unprotect (); + +// Must do this before define, since define will call the special +// variable function only if it knows about it, and it needs to, so +// that user prefs can be properly initialized. + + if (sv_fcn) + sr->set_sv_function (sv_fcn); + + sr->define_builtin_var (val); + + if (protect) + sr->protect (); + + if (eternal) + sr->make_eternal (); + + if (help) + sr->document (help); +} + +/* + * Look for the given name in the global symbol table. If it refers + * to a string, return a new copy. If not, return NULL. */ char * -octave_string_variable (char *name) +builtin_string_variable (const char *name) { + symbol_record *sr = global_sym_tab->lookup (name, 0, 0); + +// It is a prorgramming error to look for builtins that aren't. + + assert (sr != (symbol_record *) NULL); + 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 (error_state) - return retval; - else if (val.is_string_type ()) + + if (! error_state && val.is_string_type ()) { char *s = val.string_value (); if (s != (char *) NULL) @@ -203,30 +294,28 @@ } /* - * 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. + * Look for the given name in the global symbol table. If 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) +builtin_real_scalar_variable (const 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; - } + symbol_record *sr = global_sym_tab->lookup (name, 0, 0); + +// It is a prorgramming error to look for builtins that aren't. + + assert (sr != (symbol_record *) NULL); tree *defn = sr->def (); + if (defn != NULL_TREE) { tree_constant val = defn->eval (0); - if (error_state) - return status; - else if (val.const_type () == tree_constant_rep::scalar_constant) + + if (! error_state + && val.const_type () == tree_constant_rep::scalar_constant) { d = val.double_value (); status = 0; @@ -237,6 +326,120 @@ } /* + * Make the definition of the symbol record sr be the same as the + * definition of the global variable of the same name, creating it if + * it doesn't already exist. + */ +void +link_to_global_variable (symbol_record *sr) +{ + if (sr->is_linked_to_global ()) + return; + + symbol_record *gsr = global_sym_tab->lookup (sr->name (), 1, 0); + + if (sr->is_formal_parameter ()) + { + error ("can't make function parameter `%s' global", sr->name ()); + return; + } + +// There must be a better way to do this. XXX FIXME XXX + + if (sr->is_variable ()) + { +// Would be nice not to have this cast. XXX FIXME XXX + tree_constant *tmp = (tree_constant *) sr->def (); + tmp = new tree_constant (*tmp); + gsr->define (tmp); + } + else + { + sr->clear (); + } + +// If the global symbol is currently defined as a function, we need to +// hide it with a variable. + + if (gsr->is_function ()) + gsr->define (NULL_TREE_CONST); + + sr->alias (gsr, 1); + sr->mark_as_linked_to_global (); +} + +/* + * Make the definition of the symbol record sr be the same as the + * definition of the builtin variable of the same name. + */ +void +link_to_builtin_variable (symbol_record *sr) +{ + symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0); + + if (tmp_sym != (symbol_record *) NULL) + { + if (tmp_sym->is_builtin_variable ()) + { + sr->alias (tmp_sym); + } + } +} + +/* + * Make the definition of the symbol record sr be the same as the + * definition of the builtin variable or function, or user function of + * the same name, provided that the name has not been used as a formal + * parameter. + */ +void +link_to_builtin_or_function (symbol_record *sr) +{ + symbol_record *tmp_sym = global_sym_tab->lookup (sr->name (), 0, 0); + + if (tmp_sym != (symbol_record *) NULL) + { + if ((tmp_sym->is_builtin_variable () || tmp_sym->is_function ()) + && ! tmp_sym->is_formal_parameter ()) + { + sr->alias (tmp_sym); + } + } +} + +/* + * Force a link to a function in the current symbol table. This is + * used just after defining a function to avoid different behavior + * depending on whether or not the function has been evaluated after + * being defined. + * + * Return without doing anything if there isn't a function with the + * given name defined in the global symbol table. + */ +void +force_link_to_function (const char *id_name) +{ + symbol_record *gsr = global_sym_tab->lookup (id_name, 1, 0); + if (gsr->is_function ()) + { + curr_sym_tab->clear (id_name); + symbol_record *csr = curr_sym_tab->lookup (id_name, 1, 0); + csr->alias (gsr); + } +} + +/* + * Return 1 if the argument names a globally visible variable. + * Otherwise, return 0. + */ +int +is_globally_visible (const char *name) +{ + symbol_record *sr = curr_sym_tab->lookup (name, 0, 0); + return (sr != (symbol_record *) NULL && sr->is_linked_to_global ()); +} + +/* * Extract a keyword and its value from a file. Input should look * something like: * @@ -396,12 +599,21 @@ if (stat (name, &buf) == 0 && S_ISREG (buf.st_mode)) return 2; } - } return 0; } /* + * Is this variable a builtin? + */ +int +is_builtin_variable (const char *name) +{ + symbol_record *sr = global_sym_tab->lookup (name, 0, 0); + return (sr != (symbol_record *) NULL && sr->is_builtin_variable ()); +} + +/* * Is this tree_constant a valid function? */ tree * @@ -462,6 +674,8 @@ return 1; } +// It's not likely that this does the right thing now. XXX FIXME XXX + char ** make_name_list (void) {
--- a/src/variables.h Wed Nov 03 21:38:05 1993 +0000 +++ b/src/variables.h Sat Nov 06 10:14:11 1993 +0000 @@ -34,17 +34,63 @@ class tree; class tree_constant; +struct builtin_mapper_functions; +struct builtin_text_functions; +struct builtin_general_functions; +struct builtin_string_variables; + +#ifndef SV_FUNCTION_TYPEDEFS +#define SV_FUNCTION_TYPEDEFS 1 + +typedef int (*sv_Function)(void); + +#endif + +extern void initialize_symbol_tables (void); + extern int symbol_out_of_date (symbol_record *sr); -extern symbol_record *force_global (char *name); -extern int bind_variable (char *, tree_constant *); -extern int bind_protected_variable (char *, tree_constant *); -extern char *octave_string_variable (char *); -extern int octave_real_scalar_variable (char *, double&); + +extern void document_symbol (const char *name, const char *help); + +extern void install_builtin_mapper_function (builtin_mapper_functions *mf); + +extern void install_builtin_text_function (builtin_text_functions *tf); + +extern void install_builtin_general_function (builtin_general_functions *gf); + +extern void install_builtin_variable (builtin_string_variables *sv); + +extern void install_builtin_variable_as_function (const char *name, + tree_constant *val, + int protect = 0, + int eternal = 0); + +extern void bind_nargin_and_nargout (symbol_table *sym_tab, + int nargin, int nargout); + +extern void bind_builtin_variable (const char *, tree_constant *, + int protect = 0, int eternal = 0, + sv_Function f = (sv_Function) 0, + const char *help = (char *) 0); + +extern char *builtin_string_variable (const char *); +extern int builtin_real_scalar_variable (const char *, double&); + +extern void link_to_global_variable (symbol_record *sr); +extern void link_to_builtin_variable (symbol_record *sr); +extern void link_to_builtin_or_function (symbol_record *sr); + +extern void force_link_to_function (const char *s); + +extern int is_globally_visible (const char *nm); + extern int extract_keyword (istream&, char *, char *); extern int extract_keyword (istream&, char *, int&); + extern void skip_comments (istream&); extern int valid_identifier (char *); extern int identifier_exists (char *); +extern int is_builtin_variable (const char *name); extern tree *is_valid_function (tree_constant&, char *, int warn = 0); extern int takes_correct_nargs (tree *, int, char *, int warn = 0); extern char **make_name_list (void);