changeset 3021:18d64612e67a

[project @ 1997-06-03 22:18:56 by jwe]
author jwe
date Tue, 03 Jun 1997 22:21:29 +0000
parents f491f232cb09
children 0e458bbb1859
files src/ChangeLog src/parse.h src/parse.y
diffstat 3 files changed, 795 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,65 @@
+Tue Jun  3 16:47:34 1997  John W. Eaton  <jwe@bevo.che.wisc.edu>
+
+	* parse.y (parse_and_execute): Move here from toplev.cc
+	(default_eval_print_flag): Likewise.
+	(safe_fclose): Likewise.
+	(eval_string): Likewise.
+	(Fsource): Likewise.
+	(Ffeval): Likewise.
+	(feval): Likewise.
+	(Feval): Likewise.
+	(symbols_of_parse): Define default_eval_print_flag here instead of
+	in varaibles.cc.
+	(looks_like_octave_copyright): Move here from variables.cc
+	(gobble_leading_whitespace): Likeiwse.
+	(is_function_file): Likewise.
+	(restore_input_stream): Likewise.
+	(parse_fcn_file): Likewise.
+	(load_fcn_from_file): Likewise.
+	(get_help_from_file): Likewise.
+
+	* toplev.cc (syms_of_toplev): Define argv, program_name, and
+	program_invocation_name here instead of in variables.cc.
+
+	* parse.h (line_editing): Move here from toplev.h.  Now bool, not int.
+	(reading_startup_message_printed) Likewise.
+	(input_from_startup_file): Likewise.
+	(input_from_command_line_file): Likewise.
+
+	* load-save.cc: Use bool instead of int where appropriate.
+
+	* input.h (enum echo_state): Move here from variables.h.
+	(Vecho_executing_commands): Likewise.  Now bool, not int.
+	* input.cc (echo_executing_commands): Move here from variables.cc.
+	(symbols_of_input): Define echo_executing_commands here instead of
+	in variables.cc.
+
+	* octave.cc (program_invocation_name): Don't define.
+	(intern_argv): Don't set program_invocation_name here.
+	(main): Call octave_env::set_program_name here, not in intern_argv.
+
+	* toplev.cc (quitting_gracefully): Move here from octave.h and
+	make static bool instead of extern int.
+
+	* error.cc (bind_global_error_variable, clear_global_error_variable):
+	Move here from variables.cc.
+	(symbols_of_error): Define error_text here instead of in variables.cc.
+
+	* pager.cc (write_to_diary_file): Now bool, not int.
+	(really_flush_to_pager): Likewise.
+ 	(flushing_to_pager): Likewise.
+	* sighandlers.h (can_interrupt): Likewise.
+	* error.h (buffer_error_messages): Likewise.
+	* oct-hist.h (input_from_tmp_history_file, Vsaving_history): Likewise.
+	* input.h (forced_interactive): Likewise.
+	(get_input_from_eval_string): Likeiwse.
+	(reading_script_file): Likeiwse.
+	(reading_fcn_file): Likeiwse.
+	(interactive): Likewise.
+
+	* unwind-prot.cc (saved_variable::saved_variable (bool *, bool)):
+	Set type_tag to boolean, not int. 
+
 Mon Jun  2 00:40:10 1997  John W. Eaton  <jwe@bevo.che.wisc.edu>
 
 	* variables.h (Octave_builtin_fcn): Delete typedef.
--- a/src/parse.h
+++ b/src/parse.h
@@ -23,6 +23,8 @@
 #if !defined (octave_parse_h)
 #define octave_parse_h 1
 
+#include <cstdio>
+
 #include <string>
 
 #include "SLStack.h"
@@ -34,7 +36,10 @@
 class tree;
 class tree_matrix;
 class tree_identifier;
+class symbol_record;
 class symbol_table;
+class octave_value;
+class octave_value_list;
 
 // Temporary symbol table pointer used to cope with bogus function syntax.
 extern symbol_table *tmp_local_sym_tab;
@@ -51,6 +56,37 @@
 // Buffer for help text snagged from function files.
 extern string help_buf;
 
+// TRUE means we are using readline.
+extern bool line_editing;
+
+// TRUE means we printed messages about reading startup files.
+extern bool reading_startup_message_printed;
+
+// TRUE means input is coming from startup file.
+extern bool input_from_startup_file;
+
+// TRUE means that input is coming from a file that was named on
+// the command line.
+extern bool input_from_command_line_file;
+
+extern void
+parse_and_execute (FILE *f);
+
+extern void
+parse_and_execute (const string& s, bool verbose = false,
+		   const char *warn_for = 0);
+
+extern string get_help_from_file (const string& f);
+
+extern bool
+load_fcn_from_file (symbol_record *sym_rec, bool exec_script);
+
+extern octave_value_list
+feval (const octave_value_list& args, int nargout);
+
+extern octave_value
+eval_string (const string&, bool silent, int& parse_status);
+
 #endif
 
 /*
--- a/src/parse.y
+++ b/src/parse.y
@@ -38,8 +38,13 @@
 #include <strstream.h>
 
 #include "Matrix.h"
+#include "cmd-edit.h"
+#include "cmd-hist.h"
+#include "file-ops.h"
+#include "file-stat.h"
 
 #include "defun.h"
+#include "dynamic-ld.h"
 #include "error.h"
 #include "input.h"
 #include "lex.h"
@@ -51,9 +56,13 @@
 #include "pt-all.h"
 #include "symtab.h"
 #include "token.h"
+#include "unwind-prot.h"
 #include "utils.h"
 #include "variables.h"
 
+// TRUE means we print 
+static bool Vdefault_eval_print_flag = true;
+
 // If TRUE, generate a warning for the assignment in things like
 //
 //   octave> if (a = 2 < n)
@@ -88,6 +97,20 @@
 // Buffer for help text snagged from function files.
 string help_buf;
 
+// TRUE means we are using readline.
+// (--no-line-editing)
+bool line_editing = true;
+
+// TRUE means we printed messages about reading startup files.
+bool reading_startup_message_printed = false;
+
+// TRUE means input is coming from startup file.
+bool input_from_startup_file = false;
+
+// TRUE means that input is coming from a file that was named on
+// the command line.
+bool input_from_command_line_file = true;
+
 // Forward declarations for some functions defined at the bottom of
 // the file.
 
@@ -2374,6 +2397,676 @@
     }
 }
 
+void
+parse_and_execute (FILE *f)
+{
+  unwind_protect::begin_frame ("parse_and_execute");
+  
+  YY_BUFFER_STATE old_buf = current_buffer ();
+  YY_BUFFER_STATE new_buf = create_buffer (f);
+
+  unwind_protect::add (restore_input_buffer, old_buf);
+  unwind_protect::add (delete_input_buffer, new_buf);
+
+  switch_to_buffer (new_buf);
+
+  unwind_protect_bool (line_editing);
+  unwind_protect_bool (input_from_command_line_file);
+
+  line_editing = false;
+  input_from_command_line_file = false;
+
+  unwind_protect_ptr (curr_sym_tab);
+
+  int retval;
+  do
+    {
+      reset_parser ();
+
+      retval = yyparse ();
+
+      if (retval == 0 && global_command)
+	{
+	  global_command->eval ();
+
+	  delete global_command;
+
+	  global_command = 0;
+
+	  bool quit = (tree_return_command::returning
+		       || tree_break_command::breaking);
+
+	  if (tree_return_command::returning)
+	    tree_return_command::returning = 0;
+
+	  if (tree_break_command::breaking)
+	    tree_break_command::breaking--;
+
+	  if (error_state)
+	    {
+	      error ("near line %d of file `%s'", input_line_number,
+		     curr_fcn_file_full_name.c_str ());
+
+	      break;
+	    }
+
+	  if (quit)
+	    break;
+	}
+    }
+  while (retval == 0);
+
+  unwind_protect::run_frame ("parse_and_execute");
+}
+
+static void
+safe_fclose (void *f)
+{
+  if (f)
+    fclose (static_cast<FILE *> (f));
+}
+
+void
+parse_and_execute (const string& s, bool verbose, const char *warn_for)
+{
+  unwind_protect::begin_frame ("parse_and_execute_2");
+
+  unwind_protect_bool (reading_script_file);
+  unwind_protect_str (curr_fcn_file_full_name);
+
+  reading_script_file = true;
+  curr_fcn_file_full_name = s;
+
+  FILE *f = get_input_from_file (s, 0);
+
+  if (f)
+    {
+      unwind_protect::add (safe_fclose, f);
+
+      unwind_protect_int (input_line_number);
+      unwind_protect_int (current_input_column);
+
+      input_line_number = 0;
+      current_input_column = 1;
+
+      if (verbose)
+	{
+	  cout << "reading commands from " << s << " ... ";
+	  reading_startup_message_printed = true;
+	  cout.flush ();
+	}
+
+      parse_and_execute (f);
+
+      if (verbose)
+	cout << "done." << endl;
+    }
+  else if (warn_for)
+    error ("%s: unable to open file `%s'", warn_for, s.c_str ());
+
+  unwind_protect::run_frame ("parse_and_execute_2");
+}
+
+static bool
+looks_like_octave_copyright (const string& s)
+{
+  bool retval = false;
+
+  string t = s.substr (0, 15);
+
+  if (t == " Copyright (C) ")
+    {
+      size_t pos = s.find ('\n');
+
+      if (pos != NPOS)
+	{
+	  pos = s.find ('\n', pos + 1);
+
+	  if (pos != NPOS)
+	    {
+	      pos++;
+
+	      t = s.substr (pos, 29);
+
+	      if (t == " This file is part of Octave."
+		  || t == " This program is free softwar")
+		retval = true;
+	    }
+	}
+    }
+
+  return retval;
+}
+
+// Eat whitespace and comments from FFILE, returning the text of the
+// comments read if it doesn't look like a copyright notice.  If
+// IN_PARTS, consider each block of comments separately; otherwise,
+// grab them all at once.  If UPDATE_POS is TRUE, line and column
+// number information is updated.
+
+// XXX FIXME XXX -- grab_help_text() in lex.l duplicates some of this
+// code!
+
+static string
+gobble_leading_white_space (FILE *ffile, bool in_parts, bool update_pos)
+{
+  string help_txt;
+
+  bool first_comments_seen = false;
+  bool begin_comment = false;
+  bool have_help_text = false;
+  bool in_comment = false;
+  int c;
+
+  while ((c = getc (ffile)) != EOF)
+    {
+      if (update_pos)
+	current_input_column++;
+
+      if (begin_comment)
+	{
+	  if (c == '%' || c == '#')
+	    continue;
+	  else
+	    begin_comment = false;
+	}
+
+      if (in_comment)
+	{
+	  if (! have_help_text)
+	    {
+	      first_comments_seen = true;
+	      help_txt += (char) c;
+	    }
+
+	  if (c == '\n')
+	    {
+	      if (update_pos)
+		{
+		  input_line_number++;
+		  current_input_column = 0;
+		}
+	      in_comment = false;
+
+	      if (in_parts)
+		{
+		  if ((c = getc (ffile)) != EOF)
+		    {
+		      if (update_pos)
+			current_input_column--;
+		      ungetc (c, ffile);
+		      if (c == '\n')
+			break;
+		    }
+		  else
+		    break;
+		}
+	    }
+	}
+      else
+	{
+	  switch (c)
+	    {
+	    case ' ':
+	    case '\t':
+	      if (first_comments_seen)
+		have_help_text = true;
+	      break;
+
+	    case '\n':
+	      if (first_comments_seen)
+		have_help_text = true;
+	      if (update_pos)
+		{
+		  input_line_number++;
+		  current_input_column = 0;
+		}
+	      continue;
+
+	    case '%':
+	    case '#':
+	      begin_comment = true;
+	      in_comment = true;
+	      break;
+
+	    default:
+	      if (update_pos)
+		current_input_column--;
+	      ungetc (c, ffile);
+	      goto done;
+	    }
+	}
+    }
+
+ done:
+
+  if (! help_txt.empty ())
+    {
+      if (looks_like_octave_copyright (help_txt)) 
+	help_txt.resize (0);
+
+      if (in_parts && help_txt.empty ())
+	help_txt = gobble_leading_white_space (ffile, in_parts, update_pos);
+    }
+
+  return help_txt;
+}
+
+string
+get_help_from_file (const string& path)
+{
+  string retval;
+
+  if (! path.empty ())
+    {
+      FILE *fptr = fopen (path.c_str (), "r");
+
+      if (fptr)
+	{
+	  unwind_protect::add (safe_fclose, (void *) fptr);
+
+	  retval = gobble_leading_white_space (fptr, true, true);
+
+	  unwind_protect::run ();
+	}
+    }
+
+  return retval;
+}
+
+static int
+is_function_file (FILE *ffile)
+{
+  int status = 0;
+
+  long pos = ftell (ffile);
+
+  gobble_leading_white_space (ffile, false, false);
+
+  char buf [10];
+  fgets (buf, 10, ffile);
+  int len = strlen (buf);
+  if (len > 8 && strncmp (buf, "function", 8) == 0
+      && ! (isalnum (buf[8]) || buf[8] == '_'))
+    status = 1;
+
+  fseek (ffile, pos, SEEK_SET);
+
+  return status;
+}
+
+static void
+restore_command_history (void *)
+{
+  command_history::ignore_entries (! Vsaving_history);
+}
+
+static void
+restore_input_stream (void *f)
+{
+  command_editor::set_input_stream (static_cast<FILE *> (f));
+}
+
+static bool
+parse_fcn_file (bool exec_script, const string& ff)
+{
+  unwind_protect::begin_frame ("parse_fcn_file");
+
+  int script_file_executed = false;
+
+  // Open function file and parse.
+
+  bool old_reading_fcn_file_state = reading_fcn_file;
+
+  FILE *in_stream = command_editor::get_input_stream ();
+
+  unwind_protect::add (restore_input_stream, in_stream);
+
+  unwind_protect_ptr (ff_instream);
+
+  unwind_protect_int (input_line_number);
+  unwind_protect_int (current_input_column);
+  unwind_protect_bool (reading_fcn_file);
+  unwind_protect_bool (line_editing);
+
+  input_line_number = 0;
+  current_input_column = 1;
+  reading_fcn_file = true;
+  line_editing = false;
+
+  FILE *ffile = get_input_from_file (ff, 0);
+
+  unwind_protect::add (safe_fclose, ffile);
+
+  if (ffile)
+    {
+      // Check to see if this file defines a function or is just a
+      // list of commands.
+
+      if (is_function_file (ffile))
+	{
+	  // XXX FIXME XXX -- we shouldn't need both the
+	  // command_history object and the
+	  // Vsaving_history variable...
+	  command_history::ignore_entries ();
+
+	  unwind_protect::add (restore_command_history, 0);
+
+	  unwind_protect_int (Vecho_executing_commands);
+	  unwind_protect_bool (Vsaving_history);
+	  unwind_protect_bool (reading_fcn_file);
+	  unwind_protect_bool (input_from_command_line_file);
+
+	  Vecho_executing_commands = ECHO_OFF;
+	  Vsaving_history = false;
+	  reading_fcn_file = true;
+	  input_from_command_line_file = false;
+
+	  YY_BUFFER_STATE old_buf = current_buffer ();
+	  YY_BUFFER_STATE new_buf = create_buffer (ffile);
+
+	  unwind_protect::add (restore_input_buffer, (void *) old_buf);
+	  unwind_protect::add (delete_input_buffer, (void *) new_buf);
+
+	  switch_to_buffer (new_buf);
+
+	  unwind_protect_ptr (curr_sym_tab);
+
+	  reset_parser ();
+
+	  help_buf = gobble_leading_white_space (ffile, true, true);
+
+	  // XXX FIXME XXX -- this should not be necessary.
+	  gobble_leading_white_space (ffile, false, true);
+
+	  int status = yyparse ();
+
+	  if (status != 0)
+	    {
+	      error ("parse error while reading function file %s",
+		     ff.c_str ());
+	      global_sym_tab->clear (curr_fcn_file_name);
+	    }
+	}
+      else if (exec_script)
+	{
+	  // The value of `reading_fcn_file' will be restored to the
+	  // proper value when we unwind from this frame.
+	  reading_fcn_file = old_reading_fcn_file_state;
+
+	  // XXX FIXME XXX -- we shouldn't need both the
+	  // command_history object and the
+	  // Vsaving_history variable...
+	  command_history::ignore_entries ();
+
+	  unwind_protect::add (restore_command_history, 0);
+
+	  unwind_protect_bool (Vsaving_history);
+	  unwind_protect_bool (reading_script_file);
+
+	  Vsaving_history = false;
+	  reading_script_file = true;
+
+	  parse_and_execute (ffile);
+
+	  script_file_executed = true;
+	}
+    }
+
+  unwind_protect::run_frame ("parse_fcn_file");
+
+  return script_file_executed;
+}
+
+bool
+load_fcn_from_file (symbol_record *sym_rec, bool exec_script)
+{
+  bool script_file_executed = false;
+
+  string nm = sym_rec->name ();
+
+  if (octave_dynamic_loader::load_fcn_from_dot_oct_file (nm))
+    {
+      force_link_to_function (nm);
+    }
+  else
+    {
+      string ff = fcn_file_in_path (nm);
+
+      // These are needed by yyparse.
+
+      unwind_protect::begin_frame ("load_fcn_from_file");
+
+      unwind_protect_str (curr_fcn_file_name);
+      unwind_protect_str (curr_fcn_file_full_name);
+
+      curr_fcn_file_name = nm;
+      curr_fcn_file_full_name = ff;
+
+      if (ff.length () > 0)
+	script_file_executed = parse_fcn_file (exec_script, ff);
+
+      if (! (error_state || script_file_executed))
+	force_link_to_function (nm);
+
+      unwind_protect::run_frame ("load_fcn_from_file");
+    }
+
+  return script_file_executed;
+}
+
+DEFUN (source, args, ,
+  "source (FILE)\n\
+\n\
+Parse and execute the contents of FILE.  Like executing commands in a\n\
+script file but without requiring the file to be named `FILE.m'.")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin == 1)
+    {
+      string file = args(0).string_value ();
+
+      if (! error_state)
+	{
+	  file = file_ops::tilde_expand (file);
+
+	  parse_and_execute (file, false, "source");
+
+	  if (error_state)
+	    error ("source: error sourcing file `%s'", file.c_str ());
+	}
+      else
+	error ("source: expecting file name as argument");
+    }
+  else
+    print_usage ("source");
+
+  return retval;
+}
+
+octave_value_list
+feval (const octave_value_list& args, int nargout)
+{
+  octave_value_list retval;
+
+  octave_function *fcn = is_valid_function (args(0), "feval", 1);
+
+  if (fcn)
+    {
+      string_vector arg_names = args.name_tags ();
+
+      int tmp_nargin = args.length () - 1;
+
+      octave_value_list tmp_args (tmp_nargin, octave_value ());
+
+      string_vector tmp_arg_names (tmp_nargin);
+
+      for (int i = 0; i < tmp_nargin; i++)
+	{
+	  tmp_args(i) = args(i+1);
+	  tmp_arg_names(i) = arg_names(i+1);
+	}
+
+      tmp_args.stash_name_tags (tmp_arg_names);
+
+      retval = fcn->do_index_op (nargout, tmp_args);
+    }
+
+  return retval;
+}
+
+DEFUN (feval, args, nargout,
+  "feval (NAME, ARGS, ...)\n\
+\n\
+evaluate NAME as a function, passing ARGS as its arguments")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin > 0)
+    retval = feval (args, nargout);
+  else
+    print_usage ("feval");
+
+  return retval;
+}
+
+static octave_value_list
+eval_string (const string& s, bool silent, int& parse_status, int nargout)
+{
+  unwind_protect::begin_frame ("eval_string");
+
+  unwind_protect_bool (get_input_from_eval_string);
+  unwind_protect_bool (input_from_command_line_file);
+  unwind_protect_ptr (global_command);
+  unwind_protect_str (current_eval_string);
+
+  get_input_from_eval_string = true;
+  input_from_command_line_file = false;
+  current_eval_string = s;
+
+  YY_BUFFER_STATE old_buf = current_buffer ();
+  YY_BUFFER_STATE new_buf = create_buffer (0);
+
+  unwind_protect::add (restore_input_buffer, old_buf);
+  unwind_protect::add (delete_input_buffer, new_buf);
+
+  switch_to_buffer (new_buf);
+
+  unwind_protect_ptr (curr_sym_tab);
+
+  reset_parser ();
+
+  parse_status = yyparse ();
+
+  // Important to reset the idea of where input is coming from before
+  // trying to eval the command we just parsed -- it might contain the
+  // name of an function file that still needs to be parsed!
+
+  tree_statement_list *command = global_command;
+
+  unwind_protect::run_frame ("eval_string");
+
+  octave_value_list retval;
+
+  if (parse_status == 0 && command)
+    {
+      retval = command->eval (silent, nargout);
+      delete command;
+    }
+
+  return retval;
+}
+
+octave_value
+eval_string (const string& s, bool silent, int& parse_status)
+{
+  octave_value retval;
+
+  octave_value_list tmp = eval_string (s, silent, parse_status, 1);
+
+  if (! tmp.empty ())
+    retval = tmp(0);
+
+  return retval;
+}
+
+static octave_value_list
+eval_string (const octave_value& arg, bool silent, int& parse_status,
+	     int nargout)
+{
+  string s = arg.string_value ();
+
+  if (error_state)
+    {
+      error ("eval: expecting string argument");
+      return -1.0;
+    }
+
+  return eval_string (s, silent, parse_status, nargout);
+}
+
+DEFUN (eval, args, nargout,
+  "eval (TRY, CATCH)\n\
+\n\
+Evaluate the string TRY as octave code.  If that fails, evaluate the\n\
+string CATCH.")
+{
+  octave_value_list retval;
+
+  int nargin = args.length ();
+
+  if (nargin > 0)
+    {
+      unwind_protect::begin_frame ("Feval");
+
+      if (nargin > 1)
+	{
+	  unwind_protect_bool (buffer_error_messages);
+	  buffer_error_messages = true;
+	}
+
+      int parse_status = 0;
+
+      retval = eval_string (args(0), ! Vdefault_eval_print_flag,
+			    parse_status, nargout);
+
+      if (nargin > 1 && (parse_status != 0 || error_state))
+	{
+	  error_state = 0;
+
+	  // Set up for letting the user print any messages from
+	  // errors that occurred in the first part of this eval().
+
+	  buffer_error_messages = false;
+	  bind_global_error_variable ();
+	  unwind_protect::add (clear_global_error_variable, 0);
+
+	  eval_string (args(1), 0, parse_status, nargout);
+
+	  retval = octave_value_list ();
+	}
+
+      unwind_protect::run_frame ("Feval");
+    }
+  else
+    print_usage ("eval");
+
+  return retval;
+}
+
+static int
+default_eval_print_flag (void)
+{
+  Vdefault_eval_print_flag = check_preference ("default_eval_print_flag");
+
+  return 0;
+}
+
 static int
 warn_assign_as_truth_value (void)
 {
@@ -2411,6 +3104,10 @@
 void
 symbols_of_parse (void)
 {
+  DEFVAR (default_eval_print_flag, 1.0, 0, default_eval_print_flag,
+    "If the value of this variable is nonzero, Octave will print the\n\
+results of commands executed by eval() that do not end with semicolons.");
+
   DEFVAR (warn_assign_as_truth_value, 1.0, 0, warn_assign_as_truth_value,
     "produce warning for assignments used as truth values");