Mercurial > octave
changeset 529:7ea224e713cd
[project @ 1994-07-20 18:54:27 by jwe]
| author | jwe |
|---|---|
| date | Wed, 20 Jul 1994 19:19:08 +0000 |
| parents | e1e6e33e26f8 |
| children | c3268005bf98 |
| files | src/Makefile.in src/builtins.h src/file-io.cc src/help.cc src/input.cc src/mappers.cc src/mappers.h src/oct-hist.cc src/octave.cc src/pager.cc src/pr-output.cc src/pt-base.h src/pt-cmd.cc src/pt-cmd.h src/pt-const.cc src/pt-const.h src/pt-exp-base.cc src/pt-exp-base.h src/sighandlers.cc src/sysdep.cc src/sysdep.h src/tc-rep.cc src/tc-rep.h src/token.cc src/unwind-prot.cc src/unwind-prot.h src/user-prefs.cc src/variables.cc src/variables.h |
| diffstat | 29 files changed, 3928 insertions(+), 2282 deletions(-) [+] |
line wrap: on
line diff
--- a/src/Makefile.in Wed Jul 20 18:53:50 1994 +0000 +++ b/src/Makefile.in Wed Jul 20 19:19:08 1994 +0000 @@ -22,7 +22,7 @@ %.cc : %.y $(YACC) $(YFLAGS) $< - mv y.tab.c $(@F) + @$(top_srcdir)/move-if-change y.tab.c $(@F) # Likewise for .c from .l. @@ -31,69 +31,100 @@ %.cc : %.l $(LEX) $(LFLAGS) $< > $(@F) -INCLUDES = arith-ops.h builtins.h dynamic-ld.h defaults.h.in \ - defaults.h error.h f-balance.h f-chol.h f-colloc.h f-dassl.h \ - f-det.h f-eig.h f-expm.h f-fft.h f-fsolve.h f-fsqp.h f-givens.h \ - f-hess.h f-ifft.h f-inv.h f-lpsolve.h f-lsode.h f-lu.h \ - f-npsol.h f-qpsol.h f-qr.h f-quad.h f-qzval.h f-rand.h \ - f-schur.h f-svd.h f-syl.h file-io.h fnmatch.h g-builtins.h \ - getopt.h gripes.h help.h idx-vector.h input.h lex.h mappers.h \ - missing-math.h octave.h octave-hist.h oct-obj.h pager.h parse.h \ - pr-output.h procstream.h sighandlers.h statdefs.h symtab.h \ - sysdep.h t-builtins.h token.h tree.h tree-cmd.h tree-const.h \ - tree-expr.h tree-plot.h tc-rep.h unwind-prot.h user-prefs.h \ - utils.h variables.h version.h xdiv.h xpow.h SLStack.h Stack.h +%.def : %.cc + @echo making $@ from $< + @$(CXXCPP) -c $(CPPFLAGS) $(ALL_CXXFLAGS) -DMAKE_BUILTINS $< \ + | $(srcdir)/mkdefs > $@.tmp + @mv $@.tmp $@ + +DLD_SRC = f-balance.cc f-chol.cc f-colloc.cc f-dassl.cc f-det.cc \ + f-eig.cc f-expm.cc f-fft.cc f-find.cc \ + f-fsolve.cc f-fsqp.cc f-givens.cc f-hess.cc f-ifft.cc \ + f-inv.cc f-log.cc f-lpsolve.cc f-lsode.cc f-lu.cc \ + f-minmax.cc f-npsol.cc f-qpsol.cc f-qr.cc f-quad.cc f-qzval.cc \ + f-rand.cc f-schur.cc f-sort.cc f-svd.cc f-syl.cc + + +DLD_OBJ = f-balance.o f-chol.o f-colloc.o f-dassl.o f-det.o f-eig.o \ + f-expm.o f-fft.o f-find.o f-fsolve.o \ + f-fsqp.o f-givens.o f-hess.o f-ifft.o f-inv.o \ + f-log.o f-lpsolve.o f-lsode.o f-lu.o f-minmax.o f-npsol.o \ + f-qpsol.o f-qr.o f-quad.o f-qzval.o f-rand.o f-schur.o \ + f-sort.o f-svd.o f-syl.o -SOURCES = arith-ops.cc builtins.cc dynamic-ld.cc error.cc f-chol.cc \ - f-colloc.cc f-balance.cc f-dassl.cc f-det.cc f-eig.cc \ - f-expm.cc f-fft.cc f-fsolve.cc f-fsqp.cc f-givens.cc \ - f-hess.cc f-ifft.cc f-inv.cc f-lpsolve.cc f-lsode.cc f-lu.cc \ - f-npsol.cc f-qpsol.cc f-qr.cc f-quad.cc f-qzval.cc f-rand.cc \ - f-schur.cc f-svd.cc f-syl.cc file-io.cc fnmatch.c \ - g-builtins.cc getopt.c getopt1.c gripes.cc help.cc \ - idx-vector.cc input.cc lex.l mappers.cc octave.cc \ - octave-hist.cc pager.cc parse.y pr-output.cc procstream.cc \ - sighandlers.cc strcasecmp.c strncase.c symtab.cc sysdep.cc \ - t-builtins.cc token.cc tree-cmd.cc tree-const.cc tree-expr.cc \ - tree-plot.cc tc-rep.cc unwind-prot.cc user-prefs.cc utils.cc \ - variables.cc xdiv.cc xpow.cc SLStack.cc +INCLUDES = arith-ops.h builtins.h defaults.h.in defun.h defun-dld.h \ + defun-int.h dirfns.h dynamic-ld.h error.h file-io.h fnmatch.h \ + getopt.h gripes.h help.h idx-vector.h input.h lex.h mappers.h \ + missing-math.h octave.h octave-hist.h \ + oct-obj.h pager.h parse.h pr-output.h procstream.h \ + sighandlers.h statdefs.h symtab.h sysdep.h token.h tree.h \ + tree-base.h tree-cmd.h tree-const.h tree-expr.h tree-plot.h \ + tc-rep.h unwind-prot.h user-prefs.h utils.h variables.h \ + version.h xdiv.h xpow.h SLStack.h Stack.h -DEP_SOURCES_2 = $(patsubst %.l, %.cc, $(SOURCES)) +SOURCES = arith-ops.cc data.cc dirfns.cc dynamic-ld.cc \ + error.cc file-io.cc fnmatch.c getopt.c getopt1.c gripes.cc \ + help.cc idx-vector.cc input.cc lex.l mappers.cc octave.cc \ + oct-obj.cc octave-hist.cc pager.cc parse.y pr-output.cc \ + procstream.cc sighandlers.cc strcasecmp.c strncase.c symtab.cc \ + sysdep.cc tc-rep.cc timefns.cc token.cc tree-cmd.cc \ + tree-const.cc tree-expr.cc tree-plot.cc unwind-prot.cc \ + user-prefs.cc utils.cc variables.cc xdiv.cc xpow.cc SLStack.cc \ + $(DLD_SRC) + +# Ugh. + +DEP_SOURCES_2 = $(patsubst %.l, %.cc, $(SOURCES)) builtins.cc DEP_SOURCES_1 = $(patsubst %.y, %.cc, $(DEP_SOURCES_2)) DEP_SOURCES = $(patsubst %.c, %.d, $(DEP_SOURCES_1)) MAKEDEPS = $(patsubst %.cc, %.d, $(DEP_SOURCES)) -DLD_OBJECTS = f-balance.o f-chol.o f-colloc.o f-dassl.o f-det.o \ - f-eig.o f-expm.o f-fft.o f-fsolve.o f-fsqp.o f-givens.o \ - f-hess.o f-ifft.o f-inv.o f-lpsolve.o f-lsode.o f-lu.o \ - f-npsol.o f-qpsol.o f-qr.o f-quad.o f-qzval.o f-rand.o \ - f-schur.o f-svd.o f-syl.o +DEF_FILES_4 = $(addprefix $(srcdir)/, $(SOURCES)) +DEF_FILES_3 = $(notdir $(shell grep -l "^DEFUN" $(DEF_FILES_4))) +DEF_FILES_2 = $(patsubst %.y, %.def, $(DEF_FILES_3)) +DEF_FILES_1 = $(patsubst %.l, %.def, $(DEF_FILES_2)) +DEF_FILES = $(patsubst %.cc, %.def, $(DEF_FILES_1)) + +# XXX FIXME XXX -- Should these be generated automatically from the +# list of source files? -OBJECTS = arith-ops.o builtins.o error.o file-io.o fnmatch.o \ - g-builtins.o getopt.o getopt1.o gripes.o help.o idx-vector.o \ - input.o lex.o mappers.o octave.o octave-hist.o pager.o \ - parse.o pr-output.o procstream.o sighandlers.o strcasecmp.o \ - strncase.o symtab.o sysdep.o t-builtins.o token.o tree-cmd.o \ - tree-const.o tree-expr.o tree-plot.o tc-rep.o unwind-prot.o \ - user-prefs.o utils.o variables.o xdiv.o xpow.o SLStack.o \ +OBJECTS = arith-ops.o builtins.o data.o dirfns.o error.o \ + file-io.o fnmatch.o getopt.o getopt1.o gripes.o help.o \ + idx-vector.o input.o lex.o mappers.o octave.o octave-hist.o \ + oct-obj.o pager.o parse.o pr-output.o procstream.o sighandlers.o \ + strcasecmp.o strncase.o symtab.o sysdep.o tc-rep.o timefns.o \ + token.o tree-cmd.o tree-const.o tree-expr.o tree-plot.o \ + unwind-prot.o user-prefs.o utils.o variables.o xdiv.o xpow.o \ + SLStack.o \ @DYNAMIC_LD_OBJ@ -OCTAVE_LIBS = ../liboctave.a ../libcruft.a ../libinfo.a \ +OCTAVE_LIBS = @LIBOCTDLD@ ../liboctave.a ../libcruft.a ../libinfo.a \ ../libreadline.a @LIBDLD@ -DISTFILES = Makefile.in move-if-change parse.cc lex.cc y.tab.h \ - $(INCLUDES) $(SOURCES) +DISTFILES = Makefile.in mkdefs mkbuiltins \ + parse.cc lex.cc y.tab.h $(INCLUDES) $(SOURCES) all: defaults.h octave .PHONY: all -octave: $(DLD_OBJECTS) $(OBJECTS) $(OCTAVE_LIBS) $(LIBOBJS) +octave: $(OBJECTS) $(DLD_OBJ) $(LIBOBJS) $(OCTAVE_LIBS) ../liboctdld.a $(CXX) $(CPPFLAGS) $(ALL_CXXFLAGS) $(ALL_LDFLAGS) -o octave \ - $(OBJECTS) @DLD_OBJECTS@ \ + $(OBJECTS) \ $(OCTAVE_LIBS) \ $(LIBOBJS) \ $(FLIBS) $(LEXLIB) -ltermcap -lm -lg++ +../liboctdld.a: $(DLD_OBJ) + $(AR) $(ARFLAGS) ../liboctdld.a $(DLD_OBJ) + $(RANLIB) ../liboctdld.a + +builtins.cc: $(DEF_FILES) mkbuiltins + @echo making $@ from $(DEF_FILES) + @$(srcdir)/mkbuiltins $(DEF_FILES) > $@.tmp + @$(top_srcdir)/move-if-change $@.tmp $@ + +$(DEF_FILES): mkdefs + check: all .PHONY: check @@ -115,7 +146,7 @@ etags $(SOURCES) clean: - rm -f *.a *.o + rm -f *.a *.o *.def builtins.cc .PHONY: clean mostlyclean: @@ -142,13 +173,13 @@ # Special rules -- these files need special things to be defined. -defaults.h: ../Makeconf Makefile defaults.h.in - @echo "Making defaults.h from defaults.h.in..." - @(sed < $(srcdir)/defaults.h.in > defaults.h.tmp \ +defaults.h: defaults.h.in ../Makeconf Makefile + @echo "making defaults.h from defaults.h.in" + @(sed < $< > $@.tmp \ -e 's;%DEFAULT_PAGER%;\"${DEFAULT_PAGER}\";' \ -e 's;%OCTAVE_HOME%;\"${OCTAVE_HOME}\";' \ -e 's;%OCTAVE_LIB_DIR%;\"${OCTAVE_LIB_DIR}\";' \ -e 's;%OCTAVE_INFO_DIR%;\"${OCTAVE_INFO_DIR}\";') - @$(srcdir)/move-if-change defaults.h.tmp defaults.h + @$(top_srcdir)/move-if-change $@.tmp $@ include $(MAKEDEPS)
--- a/src/builtins.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/builtins.h Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// Builtin function support. -*- C++ -*- +// builtins.h -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -24,69 +24,7 @@ #if !defined (octave_builtins_h) #define octave_builtins_h 1 -class ostrstream; -class Complex; -struct help_list; - -typedef double (*d_d_Mapper)(double); -typedef double (*d_c_Mapper)(const Complex&); -typedef Complex (*c_c_Mapper)(const Complex&); - -// If can_return_complex_for_real_arg is 1, lower_limit and -// upper_limit specify the range of values for which a real arg -// returns a real value. Outside that range, we have to convert args -// to complex, and call the complex valued function. -// -// If can_return_complex_for_real_arg is 0, lower_limit and -// upper_limit are ignored. - -struct Mapper_fcn -{ - int can_return_complex_for_real_arg; - double lower_limit; - double upper_limit; - d_d_Mapper d_d_mapper; - d_c_Mapper d_c_mapper; - c_c_Mapper c_c_mapper; -}; - -struct builtin_mapper_functions -{ - char *name; - int can_return_complex_for_real_arg; - double lower_limit; - double upper_limit; - d_d_Mapper d_d_mapper; - d_c_Mapper d_c_mapper; - c_c_Mapper c_c_mapper; - char *help_string; -}; - -typedef int (*sv_Function)(void); - -struct builtin_string_variables -{ - char *name; - char *value; - sv_Function sv_function; - char *help_string; -}; - extern void install_builtins (void); -extern int is_text_function_name (const char *s); - -extern help_list *builtin_mapper_functions_help (void); -extern help_list *builtin_general_functions_help (void); -extern help_list *builtin_text_functions_help (void); -extern help_list *builtin_variables_help (void); - -extern int help_from_list (ostrstream& output_buf, - const help_list *list, const char *string, - int usage); - -extern void additional_help_message (ostrstream& output_buf); - -extern void print_usage (const char *s, int just_usage = 0); #endif
--- a/src/file-io.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/file-io.cc Wed Jul 20 19:19:08 1994 +0000 @@ -46,8 +46,10 @@ #include "error.h" #include "utils.h" #include "pager.h" +#include "defun.h" #include "sysdep.h" #include "mappers.h" +#include "variables.h" // keeps a count of how many files are open and in the file list static int file_count = 0; @@ -84,9 +86,9 @@ file_info::file_info (void) { file_number = -1; - file_name = (char *) NULL; - file_fptr = (FILE *) NULL; - file_mode = (char *) NULL; + file_name = 0; + file_fptr = 0; + file_mode = 0; } file_info::file_info (int n, const char *nm, FILE *t, const char *md) @@ -209,7 +211,7 @@ else error ("inapproriate file specifier"); - return (Pix) NULL; + return 0; } static Pix @@ -219,7 +221,7 @@ char *file_name = arg.string_value (); FILE *file_ptr = fopen (file_name, mode); - if (file_ptr != (FILE *) NULL) + if (file_ptr) { file_info file (++file_count, file_name, file_ptr, mode); file_list.append (file); @@ -238,7 +240,7 @@ error ("%s: unable to open file `%s'", warn_for, file_name); - return (Pix) NULL; + return 0; } static Pix @@ -247,7 +249,7 @@ { Pix p = return_valid_file (arg); - if (p == (Pix) NULL) + if (! p) { if (arg.is_string_type ()) { @@ -275,6 +277,21 @@ return p; } +DEFUN ("fclose", Ffclose, Sfclose, 2, 1, + "fclose (FILENAME or FILENUM): close a file") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("fclose"); + else + retval = fclose_internal (args); + + return retval; +} + Octave_object fclose_internal (const Octave_object& args) { @@ -282,7 +299,7 @@ Pix p = return_valid_file (args(1)); - if (p == (Pix) NULL) + if (! p) return retval; file_info file = file_list (p); @@ -309,6 +326,21 @@ return retval; } +DEFUN ("fflush", Ffflush, Sfflush, 2, 1, + "fflush (FILENAME or FILENUM): flush buffered data to output file") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("fflush"); + else + retval = fflush_internal (args); + + return retval; +} + Octave_object fflush_internal (const Octave_object& args) { @@ -316,7 +348,7 @@ Pix p = return_valid_file (args(1)); - if (p == (Pix) NULL) + if (! p) return retval; file_info file = file_list (p); @@ -349,7 +381,7 @@ static int valid_mode (const char *mode) { - if (mode != (char *) NULL) + if (mode) { char m = mode[0]; if (m == 'r' || m == 'w' || m == 'a') @@ -361,6 +393,23 @@ return 0; } +DEFUN ("fgets", Ffgets, Sfgets, 3, 2, + "[STRING, LENGTH] = fgets (FILENAME or FILENUM, LENGTH)\n\ +\n\ +read a string from a file") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 3) + print_usage ("fgets"); + else + retval = fgets_internal (args, nargout); + + return retval; +} + Octave_object fgets_internal (const Octave_object& args, int nargout) { @@ -368,7 +417,7 @@ Pix p = file_io_get_file (args(1), "r", "fgets"); - if (p == (Pix) NULL) + if (! p) return retval; int length = 0; @@ -387,7 +436,7 @@ char string[length+1]; char *success = fgets (string, length+1, file.fptr ()); - if (success == (char *) NULL) + if (! success) { retval.resize (1); retval(0) = tree_constant (-1.0); @@ -407,6 +456,31 @@ return retval; } +DEFUN ("fopen", Ffopen, Sfopen, 3, 1, + "FILENUM = fopen (FILENAME, MODE): open a file\n\ +\n\ + Valid values for mode include:\n\ +\n\ + r : open text file for reading\n\ + w : open text file for writing; discard previous contents if any\n\ + a : append; open or create text file for writing at end of file\n\ + r+ : open text file for update (i.e., reading and writing)\n\ + w+ : create text file for update; discard previous contents if any\n\ + a+ : append; open or create text file for update, writing at end\n\n\ + Update mode permits reading from and writing to the same file.") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 3) + print_usage ("fopen"); + else + retval = fopen_internal (args); + + return retval; +} + Octave_object fopen_internal (const Octave_object& args) { @@ -421,7 +495,7 @@ p = return_valid_file (args(1)); - if (p != (Pix) NULL) + if (p) { file_info file = file_list (p); @@ -455,7 +529,7 @@ FILE *file_ptr = fopen (name, mode); - if (file_ptr == (FILE *) NULL) + if (! file_ptr) { error ("fopen: unable to open file `%s'", name); return retval; @@ -472,6 +546,21 @@ return retval; } +DEFUN ("freport", Ffreport, Sfreport, 1, 1, + "freport (): list open files and their status") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin > 1) + warning ("freport: ignoring extra arguments"); + + retval = freport_internal (); + + return retval; +} + Octave_object freport_internal (void) { @@ -495,6 +584,21 @@ return retval; } +DEFUN ("frewind", Ffrewind, Sfrewind, 2, 1, + "frewind (FILENAME or FILENUM): set file position at beginning of file") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("frewind"); + else + retval = frewind_internal (args); + + return retval; +} + Octave_object frewind_internal (const Octave_object& args) { @@ -502,7 +606,7 @@ Pix p = file_io_get_file (args(1), "a+", "frewind"); - if (p != (Pix) NULL) + if (p) { file_info file = file_list (p); rewind (file.fptr ()); @@ -511,6 +615,23 @@ return retval; } +DEFUN ("fseek", Ffseek, Sfseek, 4, 1, + "fseek (FILENAME or FILENUM, OFFSET [, ORIGIN])\n\ +\n\ +set file position for reading or writing") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 3 && nargin != 4) + print_usage ("fseek"); + else + retval = fseek_internal (args); + + return retval; +} + Octave_object fseek_internal (const Octave_object& args) { @@ -520,7 +641,7 @@ Pix p = file_io_get_file (args(1), "a+", "fseek"); - if (p == (Pix) NULL) + if (! p) return retval; long origin = SEEK_SET; @@ -567,6 +688,24 @@ return retval; } +/* + * Tell current position of file. + */ +DEFUN ("ftell", Fftell, Sftell, 2, 1, + "POSITION = ftell (FILENAME or FILENUM): returns the current file position") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("ftell"); + else + retval = ftell_internal (args); + + return retval; +} + Octave_object ftell_internal (const Octave_object& args) { @@ -574,7 +713,7 @@ Pix p = file_io_get_file (args(1), "a+", "ftell"); - if (p != (Pix) NULL) + if (p) { file_info file = file_list (p); long offset = ftell (file.fptr ()); @@ -807,6 +946,60 @@ } +/* + * Formatted printing to a file. + */ +DEFUN ("fprintf", Ffprintf, Sfprintf, -1, 1, + "fprintf (FILENAME or FILENUM, FORMAT, ...)") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin < 3) + print_usage ("fprintf"); + else + retval = do_printf ("fprintf", args, nargout); + + return retval; +} + +/* + * Formatted printing. + */ +DEFUN ("printf", Fprintf, Sprintf, -1, 1, + "printf (FORMAT, ...)") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin < 2) + print_usage ("printf"); + else + retval = do_printf ("printf", args, nargout); + + return retval; +} + +/* + * Formatted printing to a string. + */ +DEFUN ("sprintf", Fsprintf, Ssprintf, -1, 1, + "s = sprintf (FORMAT, ...)") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin < 2) + print_usage ("sprintf"); + else + retval = do_printf ("sprintf", args, nargout); + + return retval; +} + Octave_object do_printf (const char *type, const Octave_object& args, int nargout) { @@ -830,7 +1023,7 @@ Pix p = file_io_get_file (args(1), "a+", type); - if (p == (Pix) NULL) + if (! p) return retval; file = file_list (p); @@ -1070,14 +1263,68 @@ return -1; } +/* + * Formatted reading from a file. + */ +DEFUN ("fscanf", Ffscanf, Sfscanf, 3, -1, + "[A, B, C, ...] = fscanf (FILENAME or FILENUM, FORMAT)") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2 && nargin != 3) + print_usage ("fscanf"); + else + retval = do_scanf ("fscanf", args, nargout); + + return retval; +} + +/* + * Formatted reading. + */ +DEFUN ("scanf", Fscanf, Sscanf, 2, -1, + "[A, B, C, ...] = scanf (FORMAT)") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("scanf"); + else + retval = do_scanf ("scanf", args, nargout); + + return retval; +} + +/* + * Formatted reading from a string. + */ +DEFUN ("sscanf", Fsscanf, Ssscanf, 3, -1, + "[A, B, C, ...] = sscanf (STRING, FORMAT)") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 3) + print_usage ("sscanf"); + else + retval = do_scanf ("sscanf", args, nargout); + + return retval; +} + Octave_object do_scanf (const char *type, const Octave_object& args, int nargout) { Octave_object retval; - char *scanf_fmt = (char *) NULL; - char *tmp_file = (char *) NULL; + char *scanf_fmt = 0; + char *tmp_file = 0; int tmp_file_open = 0; - FILE *fptr = (FILE *) NULL; + FILE *fptr = 0; file_info file; fmt_arg_count = 0; @@ -1099,7 +1346,7 @@ { Pix p = file_io_get_file (args(1), "r", type); - if (p == (Pix) NULL) + if (! p) return retval; file = file_list (p); @@ -1113,7 +1360,7 @@ fptr = file.fptr (); } - if ((fptr == (FILE *) NULL && args(1).is_string_type ()) + if ((! fptr && args(1).is_string_type ()) || (doing_fscanf && file.number () == 0)) { char *string; @@ -1131,10 +1378,10 @@ else string = args(1).string_value (); - tmp_file = tmpnam ((char *) NULL); + tmp_file = tmpnam (0); fptr = fopen (tmp_file, "w+"); - if (fptr == (FILE *) NULL) + if (! fptr) { error ("%s: error opening temporary file", type); return retval; @@ -1142,7 +1389,7 @@ tmp_file_open = 1; unlink (tmp_file); - if (string == (char *) NULL) + if (! string) panic_impossible (); int success = fputs (string, fptr); @@ -1249,6 +1496,33 @@ return len / size; } +DEFUN ("fread", Ffread, Sfread, 4, 2, + "[DATA, COUNT] = fread (FILENUM, SIZE, PRECISION)\n\ +\n\ + Reads data in binary form of type PRECISION from a file.\n\ +\n\ + FILENUM : file number from fopen\n\ + SIZE : size specification for the Data matrix\n\ + PRECISION : type of data to read, valid types are\n\ +\n\ + 'char', 'schar', 'short', 'int', 'long', 'float'\n\ + 'double', 'uchar', 'ushort', 'uint', 'ulong'\n\ +\n\ + DATA : matrix in which the data is stored\n\ + COUNT : number of elements read") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin < 2 || nargin > 4) + print_usage ("fread"); + else + retval = fread_internal (args, nargout); + + return retval; +} + /* * Read binary data from a file. * @@ -1281,7 +1555,7 @@ Pix p = file_io_get_file (args(1), "r", "fread"); - if (p == (Pix) NULL) + if (! p) return retval; // Get type and number of bytes per element to read. @@ -1392,6 +1666,32 @@ return retval; } +DEFUN ("fwrite", Ffwrite, Sfwrite, 4, 1, + "COUNT = fwrite (FILENUM, DATA, PRECISION)\n\ +\n\ + Writes data to a file in binary form of size PRECISION\n\ +\n\ + FILENUM : file number from fopen\n\ + DATA : matrix of elements to be written\n\ + PRECISION : type of data to read, valid types are\n\ +\n\ + 'char', 'schar', 'short', 'int', 'long', 'float'\n\ + 'double', 'uchar', 'ushort', 'uint', 'ulong'\n\ +\n\ + COUNT : number of elements written") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin < 3 || nargin > 4) + print_usage ("fwrite"); + else + retval = fwrite_internal (args, nargout); + + return retval; +} + /* * Write binary data to a file. * @@ -1417,7 +1717,7 @@ Pix p = file_io_get_file (args(1), "a+", "fwrite"); - if (p == (Pix) NULL) + if (! p) return retval; // Get type and number of bytes per element to read. @@ -1445,6 +1745,24 @@ return retval; } +DEFUN ("feof", Ffeof, Sfeof, 2, 1, + "ERROR = feof (FILENAME or FILENUM)\n\ +\n\ + Returns a non zero value for an end of file condition for the\n\ + file specified by FILENAME or FILENUM from fopen") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("feof"); + else + retval = feof_internal (args, nargout); + + return retval; +} + /* * Check for an EOF condition on a file opened by fopen. * @@ -1461,13 +1779,31 @@ // Get file info. Pix p = return_valid_file (args(1)); - if (p == (Pix) NULL) + if (! p) return retval; file_info file = file_list (p); retval.resize (1); - retval(0) = tree_constant (feof (file.fptr ())); + retval(0) = (double) feof (file.fptr ()); + + return retval; +} + +DEFUN ("ferror", Fferror, Sferror, 2, 1, + "ERROR = ferror (FILENAME or FILENUM)\n\ +\n\ + Returns a non zero value for an error condition on the\n\ + file specified by FILENAME or FILENUM from fopen") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2) + print_usage ("ferror"); + else + retval = ferror_internal (args, nargout); return retval; } @@ -1489,7 +1825,7 @@ // Get file info. Pix p = return_valid_file (args(1)); - if (p == (Pix) NULL) + if (! p) return retval; file_info file = file_list (p);
--- a/src/help.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/help.cc Wed Jul 20 19:19:08 1994 +0000 @@ -25,11 +25,42 @@ #include "config.h" #endif +#include <signal.h> +#include <stdlib.h> #include <iostream.h> +#include <strstream.h> -#include "builtins.h" +#include "tree.h" +#include "sighandlers.h" +#include "user-prefs.h" +#include "tree-expr.h" +#include "variables.h" +#include "oct-obj.h" +#include "symtab.h" +#include "octave.h" +#include "dirfns.h" +#include "pager.h" +#include "error.h" #include "utils.h" #include "help.h" +#include "defun.h" + +extern "C" +{ +#include "info/info.h" +#include "info/dribble.h" +#include "info/terminal.h" + +extern int initialize_info_session (); +extern int index_entry_exists (); +extern int do_info_index_search (); +extern void finish_info_session (); +extern char *replace_in_documentation (); + +// XXX FIXME XXX +#undef __FUNCTION_DEF +#include <readline/tilde.h> +} static help_list operators[] = { @@ -159,7 +190,7 @@ { "~=", "Logical not equals operator. See also `<>' and `!='.\n", }, - { (char *) NULL, (char *) NULL, }, + { 0, 0, }, }; static help_list keywords[] = @@ -215,7 +246,7 @@ { "while", "Begin a while loop.\n", }, - { (char *) NULL, (char *) NULL, }, + { 0, 0, }, }; /* @@ -226,26 +257,26 @@ { count = 0; help_list *ptr = lst; - while (ptr->name != (char *) NULL) + while (ptr->name) { count++; ptr++; } if (count == 0) - return (char **) NULL; + return 0; char **name_list = new char * [count+1]; ptr = lst; int i = 0; - while (ptr->name != (char *) NULL) + while (ptr->name) { name_list[i++] = strsave (ptr->name); ptr++; } - name_list[i] = (char *) NULL; + name_list[i] = 0; return name_list; } @@ -261,6 +292,267 @@ return keywords; } +static void +help_syms_list (ostrstream& output_buf, help_list *list, + const char *desc) +{ + int count = 0; + char **symbols = names (list, count); + output_buf << "\n*** " << desc << ":\n\n"; + if (symbols && count > 0) + list_in_columns (output_buf, symbols); + delete [] symbols; +} + +static void +simple_help (void) +{ + ostrstream output_buf; + + help_syms_list (output_buf, operator_help (), "operators"); + + help_syms_list (output_buf, keyword_help (), "reserved words"); + + help_syms_list (output_buf, builtin_text_functions_help (), + "text functions (these names are also reserved)"); + + help_syms_list (output_buf, builtin_mapper_functions_help (), + "mapper functions"); + + help_syms_list (output_buf, builtin_general_functions_help (), + "general functions"); + + help_syms_list (output_buf, builtin_variables_help (), + "builtin variables"); + +// Also need to list variables and currently compiled functions from +// the symbol table, if there are any. + +// Also need to search octave_path for script files. + + char **path = pathstring_to_vector (user_pref.loadpath); + + char **ptr = path; + if (ptr) + { + while (*ptr) + { + int count; + char **names = get_fcn_file_names (count, *ptr, 0); + output_buf << "\n*** function files in " + << make_absolute (*ptr, the_current_working_directory) + << ":\n\n"; + if (names && count > 0) + list_in_columns (output_buf, names); + delete [] names; + ptr++; + } + } + + additional_help_message (output_buf); + output_buf << ends; + maybe_page_output (output_buf); +} + +static int +try_info (const char *string, int force = 0) +{ + int status = 0; + + char *directory_name = strsave (user_pref.info_file); + char *temp = filename_non_directory (directory_name); + + if (temp != directory_name) + { + *temp = 0; + info_add_path (directory_name, INFOPATH_PREPEND); + } + + delete [] directory_name; + + NODE *initial_node = info_get_node (user_pref.info_file, 0); + + if (! initial_node) + { + warning ("can't find info file!\n"); + status = -1; + } + else + { + status = initialize_info_session (initial_node, 0); + + if (status == 0 && (force || index_entry_exists (windows, string))) + { + terminal_clear_screen (); + + terminal_prep_terminal (); + + display_update_display (windows); + + info_last_executed_command = 0; + + if (! force) + do_info_index_search (windows, 0, string); + + char *format = replace_in_documentation + ("Type \"\\[quit]\" to quit, \"\\[get-help-window]\" for help."); + + window_message_in_echo_area (format); + + info_read_and_dispatch (); + + terminal_goto_xy (0, screenheight - 1); + + terminal_clear_to_eol (); + + terminal_unprep_terminal (); + + status = 1; + } + + finish_info_session (initial_node, 0); + } + + return status; +} + +DEFUN_TEXT ("help", Fhelp, Shelp, -1, 1, + "help [-i] [topic ...]\n\ +\n\ +print cryptic yet witty messages") +{ + Octave_object retval; + + DEFINE_ARGV("help"); + + if (argc == 1) + { + simple_help (); + } + else + { + if (argv[1] && strcmp (argv[1], "-i") == 0) + { + argc--; + argv++; + + if (argc == 1) + { + volatile sig_handler *old_sigint_handler; + old_sigint_handler = signal (SIGINT, SIG_IGN); + + try_info (0, 1); + + signal (SIGINT, old_sigint_handler); + } + else + { + while (--argc > 0) + { + argv++; + + if (! *argv || ! **argv) + continue; + + volatile sig_handler *old_sigint_handler; + old_sigint_handler = signal (SIGINT, SIG_IGN); + + if (! try_info (*argv)) + { + message ("help", + "sorry, `%s' is not indexed in the manual", + *argv); + sleep (2); + } + + signal (SIGINT, old_sigint_handler); + } + } + } + else + { + ostrstream output_buf; + + char *fcn_file_name = 0; + symbol_record *sym_rec; + help_list *op_help_list = operator_help (); + help_list *kw_help_list = keyword_help (); + + while (--argc > 0) + { + argv++; + + if (! *argv || ! **argv) + continue; + + if (help_from_list (output_buf, op_help_list, *argv, 0)) + continue; + + if (help_from_list (output_buf, kw_help_list, *argv, 0)) + continue; + + sym_rec = curr_sym_tab->lookup (*argv, 0, 0); + if (sym_rec) + { + char *h = sym_rec->help (); + if (h && *h) + { + output_buf << "\n*** " << *argv << ":\n\n" + << h << "\n"; + continue; + } + } + + sym_rec = global_sym_tab->lookup (*argv, 0, 0); + if (sym_rec && ! symbol_out_of_date (sym_rec)) + { + char *h = sym_rec->help (); + if (h && *h) + { + output_buf << "\n*** " << *argv << ":\n\n" + << h << "\n"; + continue; + } + } + +// Try harder to find function files that might not be defined yet, or +// that appear to be out of date. Don\'t execute commands from the +// file if it turns out to be a script file. + + fcn_file_name = fcn_file_in_path (*argv); + if (fcn_file_name) + { + sym_rec = global_sym_tab->lookup (*argv, 1, 0); + if (sym_rec) + { + tree_identifier tmp (sym_rec); + tmp.parse_fcn_file (0); + char *h = sym_rec->help (); + if (h && *h) + { + output_buf << "\n*** " << *argv << ":\n\n" + << h << "\n"; + continue; + } + } + } + delete [] fcn_file_name; + + output_buf << "\nhelp: sorry, `" << *argv + << "' is not documented\n"; + } + + additional_help_message (output_buf); + output_buf << ends; + maybe_page_output (output_buf); + } + } + + DELETE_ARGV; + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/input.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/input.cc Wed Jul 20 19:19:08 1994 +0000 @@ -27,6 +27,11 @@ #include "config.h" #endif +#include <sys/types.h> +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif +#include <time.h> #include <stdio.h> #include <stdlib.h> #include <iostream.h> @@ -49,7 +54,7 @@ */ #if 0 #define LINE_SIZE 8192 -static int no_line_editing = 1; +static int no_line_editing = 0; #endif char * @@ -57,7 +62,7 @@ { #if 0 static int state = 0; - static char *line_from_stdin = (char *) NULL; + static char *line_from_stdin = 0; if (no_line_editing) { if (! state) @@ -75,20 +80,38 @@ } } -#include "variables.h" +#include "help.h" #include "error.h" #include "utils.h" #include "input.h" #include "pager.h" -#include "help.h" +#include "parse.h" +#include "dirfns.h" +#include "octave.h" +#include "variables.h" +#include "tree-const.h" #include "octave-hist.h" #include "sighandlers.h" -#include "parse.h" #include "user-prefs.h" -#include "builtins.h" +#include "oct-obj.h" +#include "defun.h" + +#ifndef MAXPATHLEN +#define MAXPATHLEN 1024 +#endif + +// The size that strings change by. +#ifndef DEFAULT_ARRAY_SIZE +#define DEFAULT_ARRAY_SIZE 512 +#endif + +// The growth rate for the prompt string. +#ifndef PROMPT_GROWTH +#define PROMPT_GROWTH 50 +#endif // Global pointer for eval(). -const char *current_eval_string = (char *) NULL; +const char *current_eval_string = 0; // Nonzero means get input from current_eval_string. int get_input_from_eval_string = 0; @@ -97,13 +120,13 @@ int reading_fcn_file = 0; // Simple name of function file we are reading. -char *curr_fcn_file_name = (char *) NULL; +char *curr_fcn_file_name = 0; // Nonzero means we're parsing a script file. int reading_script_file = 0; // If we are reading from an M-file, this is it. -FILE *ff_instream = (FILE *) NULL; +FILE *ff_instream = 0; // Nonzero means we are using readline. int using_readline = 1; @@ -121,11 +144,282 @@ int promptflag = 1; // The current line of input, from wherever. -char *current_input_line = (char *) NULL; +char *current_input_line = 0; // A line of input from readline. -static char *octave_gets_line = (char *) NULL; +static char *octave_gets_line = 0; + +extern tree_constant eval_string (const char *string, int print, + int ans_assign, int& parse_status); + +/* + * Append SOURCE to TARGET at INDEX. SIZE is the current amount of + * space allocated to TARGET. SOURCE can be NULL, in which case + * nothing happens. Gets rid of SOURCE by free ()ing it. Returns + * TARGET in case the location has changed. + */ +static char * +sub_append_string (char *source, char *target, int *index, int *size) +{ + if (source) + { + while ((int)strlen (source) >= (int)(*size - *index)) + { + char *tmp = new char [*size += DEFAULT_ARRAY_SIZE]; + strcpy (tmp, target); + delete [] target; + target = tmp; + } + + strcat (target, source); + *index += strlen (source); + + delete [] source; + } + return target; +} + +/* + * Return the octal number parsed from STRING, or -1 to indicate that + * the string contained a bad number. + */ +int +read_octal (const char *string) +{ + int result = 0; + int digits = 0; + + while (*string && *string >= '0' && *string < '8') + { + digits++; + result = (result * 8) + *string++ - '0'; + } + + if (! digits || result > 0777 || *string) + result = -1; + + return result; +} + +/* + * Return a string which will be printed as a prompt. The string may + * contain special characters which are decoded as follows: + * + * \t the time + * \d the date + * \n CRLF + * \s the name of the shell (program) + * \w the current working directory + * \W the last element of PWD + * \u your username + * \h the hostname + * \# the command number of this command + * \! the history number of this command + * \$ a $ or a # if you are root + * \<octal> character code in octal + * \\ a backslash + */ +static char * +decode_prompt_string (const char *string) +{ + int result_size = PROMPT_GROWTH; + int result_index = 0; + char *result = new char [PROMPT_GROWTH]; + int c; + char *temp = 0; + + result[0] = 0; + while (c = *string++) + { + if (c == '\\') + { + c = *string; + + switch (c) + { + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + { + char octal_string[4]; + int n; + + strncpy (octal_string, string, 3); + octal_string[3] = '\0'; + + n = read_octal (octal_string); + + temp = strsave ("\\"); + if (n != -1) + { + string += 3; + temp[0] = n; + } + + c = 0; + goto add_string; + } + + case 't': + case 'd': + /* Make the current time/date into a string. */ + { + time_t the_time = time (0); + char *ttemp = ctime (&the_time); + temp = strsave (ttemp); + + if (c == 't') + { + strcpy (temp, temp + 11); + temp[8] = '\0'; + } + else + temp[10] = '\0'; + + goto add_string; + } + case 'n': + if (! no_line_editing) + temp = strsave ("\r\n"); + else + temp = strsave ("\n"); + goto add_string; + + case 's': + { + temp = base_pathname (prog_name); + temp = strsave (temp); + goto add_string; + } + + case 'w': + case 'W': + { + char t_string[MAXPATHLEN]; +#define EFFICIENT +#ifdef EFFICIENT + +// Use the value of PWD because it is much more effecient. + + temp = user_pref.pwd; + + if (! temp) + getcwd (t_string, MAXPATHLEN); + else + strcpy (t_string, temp); +#else + getcwd (t_string, MAXPATHLEN); +#endif /* EFFICIENT */ + + if (c == 'W') + { + char *dir = strrchr (t_string, '/'); + if (dir && dir != t_string) + strcpy (t_string, dir + 1); + temp = strsave (t_string); + } + else + temp = strsave (polite_directory_format (t_string)); + goto add_string; + } + + case 'u': + { + temp = strsave (user_name); + + goto add_string; + } + + case 'h': + { + char *t_string; + + temp = strsave (host_name); + if (t_string = strchr (temp, '.')) + *t_string = '\0'; + + goto add_string; + } + + case '#': + { + char number_buffer[128]; + sprintf (number_buffer, "%d", current_command_number); + temp = strsave (number_buffer); + goto add_string; + } + + case '!': + { + char number_buffer[128]; + int num = current_history_number (); + if (num > 0) + sprintf (number_buffer, "%d", num); + else + strcpy (number_buffer, "!"); + temp = strsave (number_buffer); + goto add_string; + } + + case '$': + temp = strsave (geteuid () == 0 ? "#" : "$"); + goto add_string; + + case '\\': + temp = strsave ("\\"); + goto add_string; + + default: + temp = strsave ("\\ "); + temp[1] = c; + + add_string: + if (c) + string++; + result = + (char *)sub_append_string (temp, result, + &result_index, &result_size); + temp = 0; /* Free ()'ed in sub_append_string (). */ + result[result_index] = '\0'; + break; + } + } + else + { + while (3 + result_index > result_size) + { + char *tmp = new char [result_size += PROMPT_GROWTH]; + strcpy (tmp, result); + delete [] result; + result = tmp; + } + result[result_index++] = c; + result[result_index] = '\0'; + } + } + +#if 0 + /* I don't really think that this is a good idea. Do you? */ + if (! find_variable ("NO_PROMPT_VARS")) + { + WORD_LIST *expand_string (), *list; + char *string_list (); + + list = expand_string (result, 1); + free (result); + result = string_list (list); + dispose_words (list); + } +#endif + + return result; +} /* * Use GNU readline to get an input line and store it in the history * list. @@ -133,10 +427,10 @@ static char * octave_gets (void) { - if (octave_gets_line != NULL) + if (octave_gets_line) { free (octave_gets_line); - octave_gets_line = (char *) NULL; + octave_gets_line = 0; } if (interactive || forced_interactive) @@ -181,7 +475,7 @@ { int status = 0; - static char *stashed_line = (char *) NULL; + static char *stashed_line = 0; if (get_input_from_eval_string) { @@ -205,7 +499,7 @@ else if (using_readline) { char *cp = octave_gets (); - if (cp != (char *) NULL) + if (cp) { int len = strlen (cp); if (len >= max_size) @@ -226,12 +520,12 @@ if (reading_fcn_file || reading_script_file) curr_stream = ff_instream; - assert (curr_stream != (FILE *) NULL); + assert (curr_stream); // Why is this required? buf[0] = '\0'; - if (fgets (buf, max_size, curr_stream) != (char *) NULL) + if (fgets (buf, max_size, curr_stream)) { int len = strlen (buf); if (len > max_size - 2) @@ -272,14 +566,14 @@ * warning if the file doesn't exist. */ FILE * -get_input_from_file (char *name, int warn = 1) +get_input_from_file (char *name, int warn) { - FILE *instream = (FILE *) NULL; + FILE *instream = 0; if (name && *name) instream = fopen (name, "r"); - if (instream == (FILE *) NULL && warn) + if (! instream && warn) warning ("%s: no such file or directory", name); if (reading_fcn_file || reading_script_file) @@ -308,14 +602,14 @@ static int len = 0; static int list_index = 0; - static char **name_list = (char **) NULL; + static char **name_list = 0; if (state == 0) { list_index = 0; len = strlen (text); - if (name_list != (char **) NULL) + if (name_list) { char **ptr = name_list; while (ptr && *ptr) @@ -327,7 +621,7 @@ } char *name; - while ((name = name_list[list_index]) != (char *) NULL) + while ((name = name_list[list_index]) != 0) { list_index++; if (strncmp (name, text, len) == 0) @@ -338,13 +632,13 @@ } } - return (char *) NULL; + return 0; } static char ** command_completer (char *text, int start, int end) { - char **matches = (char **) NULL; + char **matches = 0; matches = completion_matches (text, command_generator); return matches; } @@ -359,7 +653,7 @@ static int saved_history_line_to_use = 0; // ?? -static Function *old_rl_startup_hook = (Function *) NULL; +static Function *old_rl_startup_hook = 0; static void set_saved_history (void) @@ -382,7 +676,7 @@ if (rl_undo_list) { free_undo_list (); - rl_undo_list = (UNDO_LIST *) NULL; + rl_undo_list = 0; } } } @@ -426,6 +720,124 @@ (Function *) operate_and_get_next, CTRL ('O')); } +static int +match_sans_spaces (const char *standard, const char *test) +{ + const char *tp = test; + while (*tp == ' ' || *tp == '\t') + tp++; + + const char *ep = test + strlen (test) - 1; + while (*ep == ' ' || *ep == '\t') + ep--; + + int len = ep - tp + 1; + + return (strncmp (standard, tp, len) == 0); +} + +static Octave_object +get_user_input (const Octave_object& args, int nargout, int debug = 0) +{ + tree_constant retval; + + int nargin = args.length (); + + int read_as_string = 0; + + if (nargin == 3) + read_as_string++; + + char *prompt = "debug> "; + if (nargin > 1) + { + if (args(1).is_string_type ()) + prompt = args(1).string_value (); + else + { + error ("input: unrecognized argument"); + return retval; + } + } + + again: + + flush_output_to_pager (); + + char *input_buf = gnu_readline (prompt); + + if (input_buf) + { + maybe_save_history (input_buf); + + int len = strlen (input_buf); + + if (len < 1) + { + if (debug) + goto again; + else + return retval; + } + + if (match_sans_spaces ("exit", input_buf) + || match_sans_spaces ("quit", input_buf) + || match_sans_spaces ("return", input_buf)) + return tree_constant (); + else if (read_as_string) + retval = input_buf; + else + { + int parse_status = 0; + retval = eval_string (input_buf, 0, 0, parse_status); + if (debug && retval.is_defined ()) + retval.eval (1); + } + } + else + error ("input: reading user-input failed!"); + + if (debug) + goto again; + + return retval; +} + +DEFUN ("input", Finput, Sinput, 3, 1, + "input (PROMPT [, S])\n\ +\n\ +Prompt user for input. If the second argument is present, return +value as a string.") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 2 || nargin == 3) + retval = get_user_input (args, nargout); + else + print_usage ("input"); + + return retval; +} + +DEFUN ("keyboard", Fkeyboard, Skeyboard, 2, 1, + "keyboard (PROMPT)\n\ +\n\ +maybe help in debugging function files") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 1 || nargin == 2) + retval = get_user_input (args, nargout, 1); + else + print_usage ("keyboard"); + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/mappers.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/mappers.cc Wed Jul 20 19:19:08 1994 +0000 @@ -28,8 +28,11 @@ #include <float.h> #include <Complex.h> +#include "missing-math.h" +#include "variables.h" #include "mappers.h" #include "utils.h" +#include "defun.h" #if defined (_AIX) && defined (__GNUG__) #undef finite @@ -272,6 +275,102 @@ return retval; } +void +install_mapper_functions (void) +{ + DEFUN_MAPPER ("abs", Sabs, 0, 0.0, 0.0, fabs, abs, 0, + "abs (X): compute abs (X) for each element of X"); + + DEFUN_MAPPER ("acos", Sacos, 1, -1.0, 1.0, acos, 0, acos, + "acos (X): compute acos (X) for each element of X"); + + DEFUN_MAPPER ("acosh", Sacosh, 1, 1.0, DBL_MAX, acosh, 0, acosh, + "acosh (X): compute acosh (X) for each element of X"); + + DEFUN_MAPPER ("angle", Sangle, 0, 0.0, 0.0, arg, arg, 0, + "angle (X): compute arg (X) for each element of X"); + + DEFUN_MAPPER ("arg", Sarg, 0, 0.0, 0.0, arg, arg, 0, + "arg (X): compute arg (X) for each element of X"); + + DEFUN_MAPPER ("asin", Sasin, 1, -1.0, 1.0, asin, 0, asin, + "asin (X): compute asin (X) for each element of X"); + + DEFUN_MAPPER ("asinh", Sasinh, 0, 0.0, 0.0, asinh, 0, asinh, + "asinh (X): compute asinh (X) for each element of X"); + + DEFUN_MAPPER ("atan", Satan, 0, 0.0, 0.0, atan, 0, atan, + "atan (X): compute atan (X) for each element of X"); + + DEFUN_MAPPER ("atanh", Satanh, 1, -1.0, 1.0, atanh, 0, atanh, + "atanh (X): compute atanh (X) for each element of X"); + + DEFUN_MAPPER ("ceil", Sceil, 0, 0.0, 0.0, ceil, 0, ceil, + "ceil (X): round elements of X toward +Inf"); + + DEFUN_MAPPER ("conj", Sconj, 0, 0.0, 0.0, conj, 0, conj, + "conj (X): compute complex conjugate for each element of X"); + + DEFUN_MAPPER ("cos", Scos, 0, 0.0, 0.0, cos, 0, cos, + "cos (X): compute cos (X) for each element of X"); + + DEFUN_MAPPER ("cosh", Scosh, 0, 0.0, 0.0, cosh, 0, cosh, + "cosh (X): compute cosh (X) for each element of X"); + + DEFUN_MAPPER ("exp", Sexp, 0, 0.0, 0.0, exp, 0, exp, + "exp (X): compute exp (X) for each element of X"); + + DEFUN_MAPPER ("finite", Sfinite, 0, 0.0, 0.0, xfinite, xfinite, 0, + "finite (X): return 1 for finite elements of X"); + + DEFUN_MAPPER ("fix", Sfix, 0, 0.0, 0.0, fix, 0, fix, + "fix (X): round elements of X toward zero"); + + DEFUN_MAPPER ("floor", Sfloor, 0, 0.0, 0.0, floor, 0, floor, + "floor (X): round elements of X toward -Inf"); + + DEFUN_MAPPER ("isinf", Sisinf, 0, 0.0, 0.0, xisinf, xisinf, 0, + "isinf (X): return 1 for elements of X infinite"); + + DEFUN_MAPPER ("imag", Simag, 0, 0.0, 0.0, imag, imag, 0, + "imag (X): return imaginary part for each elements of X"); + +#ifdef HAVE_ISNAN + DEFUN_MAPPER ("isnan", Sisnan, 0, 0.0, 0.0, xisnan, xisnan, 0, + "isnan (X): return 1 where elements of X are NaNs"); +#endif + + DEFUN_MAPPER ("log", Slog, 1, 0.0, DBL_MAX, log, 0, log, + "log (X): compute log (X) for each element of X"); + + DEFUN_MAPPER ("log10", Slog10, 1, 0.0, DBL_MAX, log10, 0, log10, + "log10 (X): compute log10 (X) for each element of X"); + + DEFUN_MAPPER ("real", Sreal, 0, 0.0, 0.0, real, real, 0, + "real (X): return real part for each element of X"); + + DEFUN_MAPPER ("round", Sround, 0, 0.0, 0.0, round, 0, round, + "round (X): round elements of X to nearest integer"); + + DEFUN_MAPPER ("sign", Ssign, 0, 0.0, 0.0, signum, 0, signum, + "sign (X): apply signum function to elements of X"); + + DEFUN_MAPPER ("sin", Ssin, 0, 0.0, 0.0, sin, 0, sin, + "sin (X): compute sin (X) for each element of X"); + + DEFUN_MAPPER ("sinh", Ssinh, 0, 0.0, 0.0, sinh, 0, sinh, + "sinh (X): compute sinh (X) for each element of X"); + + DEFUN_MAPPER ("sqrt", Ssqrt, 1, 0.0, DBL_MAX, sqrt, 0, sqrt, + "sqrt (X): compute sqrt (X) for each element of X"); + + DEFUN_MAPPER ("tan", Stan, 0, 0.0, 0.0, tan, 0, tan, + "tan (X): compute tan (X) for each element of X"); + + DEFUN_MAPPER ("tanh", Stanh, 0, 0.0, 0.0, tanh, 0, tanh, + "tanh (X): compute tanh (X) for each element of X"); +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/mappers.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/mappers.h Wed Jul 20 19:19:08 1994 +0000 @@ -26,7 +26,39 @@ class Complex; -#include "missing-math.h" +typedef double (*d_d_Mapper)(double); +typedef double (*d_c_Mapper)(const Complex&); +typedef Complex (*c_c_Mapper)(const Complex&); + +// If can_return_complex_for_real_arg is 1, lower_limit and +// upper_limit specify the range of values for which a real arg +// returns a real value. Outside that range, we have to convert args +// to complex, and call the complex valued function. +// +// If can_return_complex_for_real_arg is 0, lower_limit and +// upper_limit are ignored. + +struct Mapper_fcn +{ + int can_return_complex_for_real_arg; + double lower_limit; + double upper_limit; + d_d_Mapper d_d_mapper; + d_c_Mapper d_c_mapper; + c_c_Mapper c_c_mapper; +}; + +struct builtin_mapper_function +{ + char *name; + int can_return_complex_for_real_arg; + double lower_limit; + double upper_limit; + d_d_Mapper d_d_mapper; + d_c_Mapper d_c_mapper; + c_c_Mapper c_c_mapper; + char *help_string; +}; extern double arg (double x); extern double conj (double x); @@ -35,13 +67,13 @@ extern double real (double x); extern double round (double x); extern double signum (double x); +extern double xisnan (double x); extern double xfinite (double x); extern double xisinf (double x); -extern double xisnan (double x); +extern double xisnan (const Complex& x); extern double xfinite (const Complex& x); extern double xisinf (const Complex& x); -extern double xisnan (const Complex& x); extern Complex acos (const Complex& x); extern Complex acosh (const Complex& x); @@ -58,6 +90,8 @@ extern Complex tan (const Complex& x); extern Complex tanh (const Complex& x); +extern void install_mapper_functions (void); + #endif /*
--- a/src/oct-hist.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/oct-hist.cc Wed Jul 20 19:19:08 1994 +0000 @@ -49,10 +49,12 @@ #include "error.h" #include "input.h" #include "octave.h" +#include "oct-obj.h" #include "user-prefs.h" #include "unwind-prot.h" #include "octave-hist.h" #include "sighandlers.h" +#include "defun.h" extern "C" { @@ -86,7 +88,7 @@ { int size = 1024; char *env_size = getenv ("OCTAVE_HISTSIZE"); - if (env_size != (char *) NULL) + if (env_size) { int val; if (sscanf (env_size, "%d", &val) == 1) @@ -98,24 +100,21 @@ static char * default_history_file (void) { - char *file = (char *) NULL;; + char *file = 0; char *env_file = getenv ("OCTAVE_HISTFILE"); - if (env_file != (char *) NULL) + if (env_file) { fstream f (env_file, (ios::in | ios::out)); - if (f != 0) + if (f) { file = strsave (env_file); f.close (); } } - if (file == (char *) NULL) - { - if (home_directory != NULL) - file = strconcat (home_directory, "/.octave_hist"); - } + if (! file && home_directory) + file = strconcat (home_directory, "/.octave_hist"); return file; } @@ -260,7 +259,7 @@ if (hlist) { - for (int i = 0; hlist[i] != (HIST_ENTRY *) NULL; i++) + for (int i = 0; hlist[i]; i++) ; // Do nothing. if (limit < 0) @@ -321,7 +320,7 @@ if (! lindex) { delete [] line; - return (char *) NULL; + return 0; } if (lindex + 2 >= line_len) @@ -354,12 +353,12 @@ static void edit_history_repl_hist (char *command) { - if (command == (char *) NULL || *command == '\0') + if (! command || ! *command) return; HIST_ENTRY **hlist = history_list (); - if (hlist == (HIST_ENTRY **) NULL) + if (! hlist) return; for (int i = 0; hlist[i]; i++) @@ -371,11 +370,11 @@ // Don't free this. HIST_ENTRY *histent = history_get (history_base + i); - if (histent == (HIST_ENTRY *) NULL) + if (! histent) return; - char *data = (char *) NULL; - if (histent->data != (char *) NULL) + char *data = 0; + if (histent->data) { int len = strlen (histent->data); data = (char *) malloc (len); @@ -387,12 +386,12 @@ if (command[n - 1] == '\n') command[n - 1] = '\0'; - if (command != (char *) NULL && *command != '\0') + if (command && *command) { HIST_ENTRY *discard = replace_history_entry (i, command, data); - if (discard != (HIST_ENTRY *) NULL) + if (discard) { - if (discard->line != (char *) NULL) + if (discard->line) free (discard->line); free ((char *) discard); @@ -403,7 +402,7 @@ static void edit_history_add_hist (char *line) { - if (line != (char *) NULL) + if (line) { int len = strlen (line); if (len > 0 && line[len-1] == '\n') @@ -425,7 +424,7 @@ int hist_count = 0; - while (hlist[hist_count++] != (HIST_ENTRY *) NULL) + while (hlist[hist_count++]) ; // Find the number of items in the history list. // The current command line is already part of the history list by the @@ -474,13 +473,13 @@ || hist_end > hist_count) { error ("%s: history specification out of range", warn_for); - return (char *) NULL; + return 0; } if (usage_error) { usage ("%s [first] [last]", warn_for); - return (char *) NULL; + return 0; } if (hist_end < hist_beg) @@ -491,14 +490,14 @@ reverse = 1; } - char *name = tmpnam ((char *) NULL); + char *name = tmpnam (0); fstream file (name, ios::out); if (! file) { error ("%s: couldn't open temporary file `%s'", warn_for, name); - return (char *) NULL; + return 0; } if (reverse) @@ -522,7 +521,7 @@ { char *name = mk_tmp_hist_file (argc, argv, 0, "edit_history"); - if (name == (char *) NULL) + if (! name) return; // Call up our favorite editor on the file of commands. @@ -545,7 +544,7 @@ char *line; int first = 1; - while ((line = edit_history_readline (file)) != NULL) + while ((line = edit_history_readline (file)) != 0) { // Skip blank lines @@ -592,7 +591,7 @@ { char *name = mk_tmp_hist_file (argc, argv, 1, "run_history"); - if (name == (char *) NULL) + if (! name) return; // Turn on command echo, so the output from this will make better sense. @@ -627,6 +626,54 @@ } +DEFUN_TEXT ("edit_history", Fedit_history, Sedit_history, -1, 1, + "edit_history [first] [last]\n\ +\n\ +edit commands from the history list") +{ + Octave_object retval; + + DEFINE_ARGV("edit_history"); + + do_edit_history (argc, argv); + + DELETE_ARGV; + + return retval; +} + +DEFUN_TEXT ("history", Fhistory, Shistory, -1, 1, + "history [N] [-w file] [-r file] [-q]\n\ +\n\ +display, save, or load command history") +{ + Octave_object retval; + + DEFINE_ARGV("history"); + + do_history (argc, argv); + + DELETE_ARGV; + + return retval; +} + +DEFUN_TEXT ("run_history", Frun_history, Srun_history, -1, 1, + "run_history [first] [last]\n\ +\n\ +run commands from the history list") +{ + Octave_object retval; + + DEFINE_ARGV("run_history"); + + do_run_history (argc, argv); + + DELETE_ARGV; + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/octave.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/octave.cc Wed Jul 20 19:19:08 1994 +0000 @@ -40,6 +40,7 @@ #include <signal.h> #include <assert.h> #include <iostream.h> +#include <strstream.h> #include <fstream.h> #include "getopt.h" @@ -50,8 +51,8 @@ #include "variables.h" #include "error.h" #include "tree-const.h" +#include "tree-plot.h" #include "utils.h" -#include "builtins.h" #include "input.h" #include "pager.h" #include "lex.h" @@ -59,9 +60,11 @@ #include "parse.h" #include "unwind-prot.h" #include "octave-hist.h" +#include "builtins.h" #include "version.h" #include "file-io.h" #include "sysdep.h" +#include "defun.h" #if !defined (HAVE_ATEXIT) && defined (HAVE_ON_EXIT) extern "C" { int on_exit (); } @@ -69,31 +72,31 @@ #endif // argv[0] for this program. -char *raw_prog_name = (char *) NULL; +char *raw_prog_name = 0; // Cleaned-up name of this program, not including path information. -char *prog_name = (char *) NULL; +char *prog_name = 0; // Login name for user running this program. -char *user_name = (char *) NULL; +char *user_name = 0; // Name of the host we are running on. -char *host_name = (char *) NULL; +char *host_name = 0; // User's home directory. -char *home_directory = (char *) NULL; +char *home_directory = 0; // Guess what? -char *the_current_working_directory = (char *) NULL; +char *the_current_working_directory = 0; // Load path specified on command line. -char *load_path = (char *) NULL; +char *load_path = 0; // Name of the info file specified on command line. -char *info_file = (char *) NULL; +char *info_file = 0; // Name of the editor to be invoked by the edit_history command. -char *editor = (char *) NULL; +char *editor = 0; // If nonzero, don't do fancy line editing. int no_line_editing = 0; @@ -105,10 +108,10 @@ int quitting_gracefully = 0; // Current command to execute. -tree *global_command = (tree *) NULL; +tree *global_command = 0; // Pointer to function that is currently being evaluated. -tree_function *curr_function = (tree_function *) NULL; +tree_function *curr_function = 0; // Nonzero means input is coming from startup file. int input_from_startup_file = 0; @@ -182,10 +185,10 @@ host_name = strsave (hostname); char *hd = getenv ("HOME"); - if (hd == (char *) NULL) - home_directory = strsave ("I have no home~!"); + if (hd) + home_directory = strsave (hd); else - home_directory = strsave (hd); + home_directory = strsave ("I have no home!"); raw_prog_name = strsave (name); prog_name = strsave ("octave"); @@ -225,7 +228,7 @@ { reset_parser (); retval = yyparse (); - if (retval == 0 && global_command != NULL_TREE) + if (retval == 0 && global_command) { global_command->eval (print); delete global_command; @@ -246,7 +249,7 @@ reading_script_file = 1; FILE *f = get_input_from_file (s, 0); - if (f != (FILE *) NULL) + if (f) { unwind_protect_int (input_line_number); unwind_protect_int (current_input_column); @@ -281,8 +284,8 @@ // Try to execute commands from $HOME/.octaverc and ./.octaverc. - char *home_rc = (char *) NULL; - if (home_directory != NULL) + char *home_rc = 0; + if (home_directory) { home_rc = strconcat (home_directory, "/.octaverc"); parse_and_execute (home_rc, 0); @@ -416,7 +419,7 @@ forced_interactive = 1; break; case 'p': - if (optarg != (char *) NULL) + if (optarg) load_path = strsave (optarg); break; case 'q': @@ -429,7 +432,7 @@ print_version_and_exit (); break; case INFO_FILE_OPTION: - if (optarg != (char *) NULL) + if (optarg) info_file = strsave (optarg); break; default: @@ -479,13 +482,13 @@ else if (remaining_args == 1) { FILE *infile = get_input_from_file (argv[optind]); - if (infile == (FILE *) NULL) - clean_up_and_exit (1); - else + if (infile) { rl_blink_matching_paren = 0; switch_to_buffer (create_buffer (infile)); } + else + clean_up_and_exit (1); } else { @@ -544,7 +547,7 @@ retval = yyparse (); - if (retval == 0 && global_command != NULL_TREE) + if (retval == 0 && global_command) { global_command->eval (1); delete global_command; @@ -556,6 +559,196 @@ clean_up_and_exit (retval); } +DEFUN_TEXT ("casesen", Fcasesen, Scasesen, 2, 1, + "casesen [on|off]") +{ + Octave_object retval; + + DEFINE_ARGV("casesen"); + + if (argc == 1 || (argc > 1 && strcmp (argv[1], "off") == 0)) + warning ("casesen: sorry, Octave is always case sensitive"); + else if (argc > 1 && strcmp (argv[1], "on") == 0) + ; // ok. + else + print_usage ("casesen"); + + DELETE_ARGV; + + return retval; +} + +DEFALIAS (exit, quit) + +DEFUN ("flops", Fflops, Sflops, 2, 1, + "flops (): count floating point operations") +{ + int nargin = args.length (); + + if (nargin > 2) + print_usage ("flops"); + + warning ("flops is a flop, always returning zero"); + + return 0.0; +} + +DEFUN ("quit", Fquit, Squit, 1, 0, + "quit (): exit Octave gracefully") +{ + Octave_object retval; + quitting_gracefully = 1; + clean_up_and_exit (0); + return retval; +} + +DEFUN ("warranty", Fwarranty, Swarranty, 1, 0, + "warranty (): describe copying conditions") +{ + Octave_object retval; + + ostrstream output_buf; + output_buf << "\n Octave, version " << version_string + << ". Copyright (C) 1992, 1993, 1994 John W. Eaton\n" + << "\n\ + This program is free software; you can redistribute it and/or modify\n\ + it under the terms of the GNU General Public License as published by\n\ + the Free Software Foundation; either version 2 of the License, or\n\ + (at your option) any later version.\n\ +\n\ + This program is distributed in the hope that it will be useful,\n\ + but WITHOUT ANY WARRANTY; without even the implied warranty of\n\ + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n\ + GNU General Public License for more details.\n\ +\n\ + You should have received a copy of the GNU General Public License\n\ + along with this program. If not, write to the Free Software\n\ + Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.\n\ +\n"; + + output_buf << ends; + maybe_page_output (output_buf); + + return retval; +} + +// XXX FIXME XXX -- this may not be the best place for these... + +Octave_object +feval (const Octave_object& args, int nargout) +{ + Octave_object retval; + + tree_fvc *fcn = is_valid_function (args(1), "feval", 1); + if (fcn) + { + int nargin = args.length () - 1; + Octave_object tmp_args (nargin); + for (int i = 0; i < nargin; i++) + tmp_args(i) = args(i+1); + retval = fcn->eval (0, nargout, tmp_args); + } + + return retval; +} + +DEFUN ("feval", Ffeval, Sfeval, -1, 1, + "feval (NAME, ARGS, ...)\n\ +\n\ +evaluate NAME as a function, passing ARGS as its arguments") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin > 1) + retval = feval (args, nargout); + else + print_usage ("feval"); + + return retval; +} + +tree_constant +eval_string (const char *string, int print, int ans_assign, + int& parse_status) +{ + begin_unwind_frame ("eval_string"); + + unwind_protect_int (get_input_from_eval_string); + unwind_protect_ptr (global_command); + unwind_protect_ptr (current_eval_string); + + get_input_from_eval_string = 1; + current_eval_string = string; + + YY_BUFFER_STATE old_buf = current_buffer (); + YY_BUFFER_STATE new_buf = create_buffer (0); + + add_unwind_protect (restore_input_buffer, (void *) old_buf); + add_unwind_protect (delete_input_buffer, (void *) 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 *command = global_command; + + run_unwind_frame ("eval_string"); + + tree_constant retval; + + if (parse_status == 0 && command) + { + retval = command->eval (print); + delete command; + } + + return retval; +} + +tree_constant +eval_string (const tree_constant& arg, int& parse_status) +{ + if (! arg.is_string_type ()) + { + error ("eval: expecting string argument"); + return -1; + } + + char *string = arg.string_value (); + +// Yes Virginia, we always print here... + + return eval_string (string, 1, 1, parse_status); +} + +DEFUN ("eval", Feval, Seval, 2, 1, + "eval (STRING): evaluate STRING as octave code") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 2) + { + int parse_status = 0; + retval = eval_string (args(1), parse_status); + } + else + print_usage ("eval"); + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/pager.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pager.cc Wed Jul 20 19:19:08 1994 +0000 @@ -1,7 +1,7 @@ // pager.cc -*- C++ -*- /* -Copyright (C) 1992, 1993 John W. Eaton +Copyright (C) 1992, 1993, 1994 John W. Eaton This file is part of Octave. @@ -36,13 +36,13 @@ #include "pager.h" // Where we stash output headed for the screen. -static ostrstream *pager_buf = (ostrstream *) NULL; +static ostrstream *pager_buf = 0; static int line_count (char *s) { int count = 0; - if (s != (char *) NULL) + if (s) { char c; while ((c = *s++) != '\0') @@ -89,7 +89,7 @@ if (interactive && user_pref.page_screen_output - && user_pref.pager_binary != (char *) NULL) + && user_pref.pager_binary) { *pager_buf << message; delete [] message; @@ -109,7 +109,7 @@ char *message = pager_buf->str (); - if (message == (char *) NULL || *message == '\0') + if (! message || ! *message) { delete [] message; initialize_pager (); @@ -121,7 +121,7 @@ if (nlines > terminal_rows () - 2) { char *pgr = user_pref.pager_binary; - if (pgr != (char *) NULL) + if (pgr) { oprocstream pager_stream (pgr); if (pager_stream)
--- a/src/pr-output.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pr-output.cc Wed Jul 20 19:19:08 1994 +0000 @@ -27,7 +27,6 @@ #include <iostream.h> #include <strstream.h> -#include <stdio.h> #include <string.h> #include <math.h> #include <float.h> @@ -45,13 +44,14 @@ #include "pager.h" #include "error.h" #include "utils.h" +#include "defun.h" // Current format string for real numbers and the real part of complex // numbers. -static char *curr_real_fmt = (char *) NULL; +static char *curr_real_fmt = 0; // Current format string for the imaginary part of complex numbers. -static char *curr_imag_fmt = (char *) NULL; +static char *curr_imag_fmt = 0; // Nonzero means don\'t do any fancy formatting. static int free_format = 0; @@ -184,8 +184,8 @@ static void set_format (double d, int& fw) { - curr_real_fmt = (char *) NULL; - curr_imag_fmt = (char *) NULL; + curr_real_fmt = 0; + curr_imag_fmt = 0; if (free_format) return; @@ -275,8 +275,8 @@ static void set_format (const Matrix& m, int& fw) { - curr_real_fmt = (char *) NULL; - curr_imag_fmt = (char *) NULL; + curr_real_fmt = 0; + curr_imag_fmt = 0; if (free_format) return; @@ -389,8 +389,8 @@ static void set_format (const Complex& c, int& r_fw, int& i_fw) { - curr_real_fmt = (char *) NULL; - curr_imag_fmt = (char *) NULL; + curr_real_fmt = 0; + curr_imag_fmt = 0; if (free_format) return; @@ -528,8 +528,8 @@ static void set_format (const ComplexMatrix& cm, int& r_fw, int& i_fw) { - curr_real_fmt = (char *) NULL; - curr_imag_fmt = (char *) NULL; + curr_real_fmt = 0; + curr_imag_fmt = 0; if (free_format) return; @@ -678,8 +678,8 @@ static void set_format (const Range& r, int& fw) { - curr_real_fmt = (char *) NULL; - curr_imag_fmt = (char *) NULL; + curr_real_fmt = 0; + curr_imag_fmt = 0; if (free_format) return; @@ -790,9 +790,7 @@ if (d == -0.0) d = 0.0; - if (fmt == (char *) NULL) - os << d; - else + if (fmt) { if (xisinf (d)) { @@ -817,6 +815,8 @@ else os.form (fmt, d); } + else + os << d; } static inline void @@ -1130,6 +1130,21 @@ } } +DEFUN ("disp", Fdisp, Sdisp, 3, 1, + "disp (X): display value without name tag") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 2) + args(1).eval (1); + else + print_usage ("disp"); + + return retval; +} + static void init_format_state (void) { @@ -1143,7 +1158,7 @@ static void set_output_prec_and_fw (int prec, int fw) { - tree_constant *tmp = NULL_TREE_CONST; + tree_constant *tmp = 0; tmp = new tree_constant ((double) prec); bind_builtin_variable ("output_precision", tmp); @@ -1253,6 +1268,22 @@ } } +DEFUN_TEXT ("format", Fformat, Sformat, -1, 1, + "format [style]\n\ +\n\ +set output formatting style") +{ + Octave_object retval; + + DEFINE_ARGV("format"); + + set_format_style (argc, argv); + + DELETE_ARGV; + + return retval; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/pt-base.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-base.h Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// tree.h -*- C++ -*- +// tree-base.h -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -24,24 +24,7 @@ #if !defined (octave_tree_base_h) #define octave_tree_base_h 1 -#include <stdio.h> -#include <time.h> -#include <assert.h> - -#ifndef NULL_TREE -#define NULL_TREE (tree *)NULL -#endif - -#ifndef NULL_TREE_CONST -#define NULL_TREE_CONST (tree_constant *)NULL -#endif - -class tree; -class tree_fvc; -class ostream; class tree_constant; -class tree_identifier; -class tree_argument_list; /* * Base class for the parse tree.
--- a/src/pt-cmd.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-cmd.cc Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// Tree class. -*- C++ -*- +// tree-cmd.cc -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -31,9 +31,6 @@ #include <iostream.h> -// For NULL. -#include <stdio.h> - #include "user-prefs.h" #include "variables.h" #include "symtab.h" @@ -102,16 +99,16 @@ */ tree_command_list::tree_command_list (void) { - command = NULL_TREE; + command = 0; print_flag = 1; - next = (tree_command_list *) NULL; + next = 0; } tree_command_list::tree_command_list (tree *t) { command = t; print_flag = 1; - next = (tree_command_list *) NULL; + next = 0; } tree_command_list::~tree_command_list (void) @@ -139,9 +136,9 @@ { tree_command_list *list = this; tree_command_list *next; - tree_command_list *prev = (tree_command_list *) NULL; + tree_command_list *prev = 0; - while (list != (tree_command_list *) NULL) + while (list) { next = list->next; list->next = prev; @@ -160,8 +157,7 @@ if (error_state) return retval; - tree_command_list *list; - for (list = this; list != (tree_command_list *) NULL; list = list->next) + for (tree_command_list *list = this; list; list = list->next) { if (print == 0) pf = 0; @@ -169,7 +165,7 @@ pf = list->print_flag; tree *cmd = list->command; - if (cmd == NULL_TREE) + if (! cmd) retval = tree_constant (); else { @@ -191,34 +187,33 @@ /* * Global. */ -tree_global_command::tree_global_command (int l = -1, int c = -1) +tree_global_command::tree_global_command (int l, int c) { line_num = l; column_num = c; - sr = (symbol_record *) NULL; - rhs = (tree_expression *) NULL; - next = (tree_global_command *) NULL; + sr = 0; + rhs = 0; + next = 0; } -tree_global_command::tree_global_command (symbol_record *s, - int l = -1, int c = -1) +tree_global_command::tree_global_command (symbol_record *s, int l, int c) { line_num = l; column_num = c; sr = s; - rhs = (tree_expression *) NULL; - next = (tree_global_command *) NULL; + rhs = 0; + next = 0; } tree_global_command::tree_global_command (symbol_record *s, tree_expression *e, - int l = -1, int c = -1) + int l, int c) { line_num = l; column_num = c; sr = s; rhs = e; - next = (tree_global_command *) NULL; + next = 0; } tree_global_command::~tree_global_command (void) @@ -227,7 +222,7 @@ } tree_global_command * -tree_global_command::chain (symbol_record *s, int l = -1, int c = -1) +tree_global_command::chain (symbol_record *s, int l, int c) { tree_global_command *tmp = new tree_global_command (s, l, c); tmp->next = this; @@ -236,7 +231,7 @@ tree_global_command * tree_global_command::chain (symbol_record *s, tree_expression *e, - int l = -1, int c = -1) + int l, int c) { tree_global_command *tmp = new tree_global_command (s, e, l, c); tmp->next = this; @@ -248,9 +243,9 @@ { tree_global_command *list = this; tree_global_command *next; - tree_global_command *prev = (tree_global_command *) NULL; + tree_global_command *prev = 0; - while (list != (tree_global_command *) NULL) + while (list) { next = list->next; list->next = prev; @@ -267,7 +262,7 @@ link_to_global_variable (sr); - if (rhs != NULL_TREE) + if (rhs) { tree_identifier *id = new tree_identifier (sr); tree_constant tmp_rhs = rhs->eval (0); @@ -295,7 +290,7 @@ } } - if (next != (tree_global_command *) NULL) + if (next) next->eval (print); return retval; @@ -312,25 +307,24 @@ /* * While. */ -tree_while_command::tree_while_command (int l = -1, int c = -1) +tree_while_command::tree_while_command (int l, int c) { line_num = l; column_num = c; - expr = (tree_expression *) NULL; - list = NULL_TREE; + expr = 0; + list = 0; } -tree_while_command::tree_while_command (tree_expression *e, - int l = -1, int c = -1) +tree_while_command::tree_while_command (tree_expression *e, int l, int c) { line_num = l; column_num = c; expr = e; - list = NULL_TREE; + list = 0; } tree_while_command::tree_while_command (tree_expression *e, tree *lst, - int l = -1, int c = -1) + int l, int c) { line_num = l; column_num = c; @@ -355,7 +349,7 @@ for (;;) { int expr_value = 0; - if (expr == (tree_expression *) NULL) + if (! expr) return tree_constant (); tree_constant t1 = expr->eval (0); @@ -393,7 +387,7 @@ if (expr_value) { - if (list != NULL_TREE) + if (list) { retval = list->eval (1); if (error_state) @@ -423,18 +417,18 @@ /* * For. */ -tree_for_command::tree_for_command (int l = -1, int c = -1) +tree_for_command::tree_for_command (int l, int c) { line_num = l; column_num = c; - id = (tree_index_expression *) NULL; - expr = (tree_expression *) NULL; - list = NULL_TREE; + id = 0; + expr = 0; + list = 0; } tree_for_command::tree_for_command (tree_index_expression *ident, tree_expression *e, tree *lst, - int l = -1, int c = -1) + int l, int c) { line_num = l; column_num = c; @@ -455,7 +449,7 @@ { tree_constant retval; - if (error_state || expr == (tree_expression *) NULL) + if (error_state || ! expr) return retval; tree_constant tmp_expr = expr->eval (0); @@ -580,7 +574,7 @@ return tree_constant (); } - if (list != NULL_TREE) + if (list) { retval = list->eval (1); if (error_state) @@ -599,32 +593,32 @@ /* * If. */ -tree_if_command::tree_if_command (int l = -1, int c = -1) +tree_if_command::tree_if_command (int l, int c) { line_num = l; column_num = c; - expr = (tree_expression *) NULL; - list = NULL_TREE; - next = (tree_if_command *) NULL; + expr = 0; + list = 0; + next = 0; } -tree_if_command::tree_if_command (tree *lst, int l = -1, int c = -1) +tree_if_command::tree_if_command (tree *lst, int l, int c) { line_num = l; column_num = c; - expr = (tree_expression *) NULL; + expr = 0; list = lst; - next = (tree_if_command *) NULL; + next = 0; } tree_if_command::tree_if_command (tree_expression *e, tree *lst, - int l = -1, int c = -1) + int l, int c) { line_num = l; column_num = c; expr = e; list = lst; - next = (tree_if_command *) NULL; + next = 0; } tree_if_command::~tree_if_command (void) @@ -635,7 +629,7 @@ } tree_if_command * -tree_if_command::chain (tree *lst, int l = -1, int c = -1) +tree_if_command::chain (tree *lst, int l, int c) { tree_if_command *tmp = new tree_if_command (lst, l, c); tmp->next = this; @@ -643,7 +637,7 @@ } tree_if_command * -tree_if_command::chain (tree_expression *e, tree *lst, int l = -1, int c = -1) +tree_if_command::chain (tree_expression *e, tree *lst, int l, int c) { tree_if_command *tmp = new tree_if_command (e, lst, l, c); tmp->next = this; @@ -655,9 +649,9 @@ { tree_if_command *list = this; tree_if_command *next; - tree_if_command *prev = (tree_if_command *) NULL; + tree_if_command *prev = 0; - while (list != (tree_if_command *) NULL) + while (list) { next = list->next; list->next = prev; @@ -676,13 +670,13 @@ if (error_state) return retval; - tree_if_command *lst; - for (lst = this; lst != (tree_if_command *) NULL; lst = lst->next) + + for (tree_if_command *lst = this; lst; lst = lst->next) { - if (lst->expr != (tree_expression *) NULL) + if (lst->expr) { tree_expression *tmp = lst->expr; - if (tmp == (tree_expression *) NULL) + if (! tmp) return tree_constant (); tree_constant t1 = tmp->eval (0); if (error_state || t1.is_undefined ()) @@ -720,7 +714,7 @@ if (expr_value) { - if (lst->list != NULL_TREE) + if (lst->list) retval = lst->list->eval (1); else ::error ("if: empty command list"); @@ -733,7 +727,7 @@ } else { - if (lst->list != NULL_TREE) + if (lst->list) retval = lst->list->eval (1); else ::error ("if: empty command list"); @@ -759,7 +753,7 @@ /* * Break. Is this overkill, or what? */ -tree_break_command::tree_break_command (int l = -1, int c = -1) +tree_break_command::tree_break_command (int l, int c) { line_num = l; column_num = c; @@ -780,7 +774,7 @@ /* * Continue. */ -tree_continue_command::tree_continue_command (int l = -1, int c = -1) +tree_continue_command::tree_continue_command (int l, int c) { line_num = l; column_num = c; @@ -801,7 +795,7 @@ /* * Return. */ -tree_return_command::tree_return_command (int l = -1, int c = -1) +tree_return_command::tree_return_command (int l, int c) { line_num = l; column_num = c;
--- a/src/pt-cmd.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-cmd.h Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// Tree classes. -*- C++ -*- +// tree-cmd.h -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton
--- a/src/pt-const.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-const.cc Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// The constants for the tree class. -*- C++ -*- +// tree-const.cc -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -29,35 +29,10 @@ #pragma implementation #endif -#include <strstream.h> -#include <iostream.h> -#include <fstream.h> -#include <string.h> -#include <ctype.h> - -#include "EIG.h" - -#include "unwind-prot.h" #include "tree-const.h" -#include "user-prefs.h" -#include "variables.h" -#include "octave.h" #include "error.h" #include "gripes.h" -#include "input.h" -#include "octave-hist.h" -#include "pager.h" -#include "utils.h" -#include "parse.h" -#include "lex.h" - -#ifndef MAX -#define MAX(a,b) ((a) > (b) ? (a) : (b)) -#endif - -#ifndef MIN -#define MIN(a,b) ((a) < (b) ? (a) : (b)) -#endif +#include "user-prefs.h" tree_constant::~tree_constant (void) { @@ -110,7 +85,7 @@ Matrix m; retval.resize (nargout ? nargout : 1); for (int i = 0; i < nargout; i++) - retval(i) = tree_constant (m); + retval(i) = m; } else gripe_empty_arg (fcn_name, 1); @@ -118,1375 +93,6 @@ return retval; } -Matrix -max (const Matrix& a, const Matrix& b) -{ - int nr = a.rows (); - int nc = a.columns (); - if (nr != b.rows () || nc != b.columns ()) - { - error ("two-arg max expecting args of same size"); - return Matrix (); - } - - Matrix result (nr, nc); - - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - { - double a_elem = a.elem (i, j); - double b_elem = b.elem (i, j); - result.elem (i, j) = MAX (a_elem, b_elem); - } - - return result; -} - -ComplexMatrix -max (const ComplexMatrix& a, const ComplexMatrix& b) -{ - int nr = a.rows (); - int nc = a.columns (); - if (nr != b.rows () || nc != b.columns ()) - { - error ("two-arg max expecting args of same size"); - return ComplexMatrix (); - } - - ComplexMatrix result (nr, nc); - - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - { - double abs_a_elem = abs (a.elem (i, j)); - double abs_b_elem = abs (b.elem (i, j)); - if (abs_a_elem > abs_b_elem) - result.elem (i, j) = a.elem (i, j); - else - result.elem (i, j) = b.elem (i, j); - } - - return result; -} - -Matrix -min (const Matrix& a, const Matrix& b) -{ - int nr = a.rows (); - int nc = a.columns (); - if (nr != b.rows () || nc != b.columns ()) - { - error ("two-arg min expecting args of same size"); - return Matrix (); - } - - Matrix result (nr, nc); - - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - { - double a_elem = a.elem (i, j); - double b_elem = b.elem (i, j); - result.elem (i, j) = MIN (a_elem, b_elem); - } - - return result; -} - -ComplexMatrix -min (const ComplexMatrix& a, const ComplexMatrix& b) -{ - int nr = a.rows (); - int nc = a.columns (); - if (nr != b.rows () || nc != b.columns ()) - { - error ("two-arg min expecting args of same size"); - return ComplexMatrix (); - } - - ComplexMatrix result (nr, nc); - - for (int j = 0; j < nc; j++) - for (int i = 0; i < nr; i++) - { - double abs_a_elem = abs (a.elem (i, j)); - double abs_b_elem = abs (b.elem (i, j)); - if (abs_a_elem < abs_b_elem) - result.elem (i, j) = a.elem (i, j); - else - result.elem (i, j) = b.elem (i, j); - } - - return result; -} - -static void -get_dimensions (const tree_constant& a, const char *warn_for, - int& nr, int& nc) -{ - tree_constant tmpa = a.make_numeric (); - - if (tmpa.is_scalar_type ()) - { - double tmp = tmpa.double_value (); - nr = nc = NINT (tmp); - } - else - { - nr = tmpa.rows (); - nc = tmpa.columns (); - - if ((nr == 1 && nc == 2) || (nr == 2 && nc == 1)) - { - ColumnVector v = tmpa.to_vector (); - - nr = NINT (v.elem (0)); - nc = NINT (v.elem (1)); - } - else - warning ("%s (A): use %s (size (A)) instead", warn_for, warn_for); - } - - check_dimensions (nr, nc, warn_for); // May set error_state. -} - -static void -get_dimensions (const tree_constant& a, const tree_constant& b, - const char *warn_for, int& nr, int& nc) -{ - tree_constant tmpa = a.make_numeric (); - tree_constant tmpb = b.make_numeric (); - - if (tmpa.is_scalar_type () && tmpb.is_scalar_type ()) - { - nr = NINT (tmpa.double_value ()); - nc = NINT (tmpb.double_value ()); - - check_dimensions (nr, nc, warn_for); // May set error_state. - } - else - error ("%s: expecting two scalar arguments", warn_for); -} - -tree_constant -fill_matrix (const tree_constant& a, double val, const char *warn_for) -{ - int nr, nc; - get_dimensions (a, warn_for, nr, nc); - - if (error_state) - return tree_constant (); - - Matrix m (nr, nc, val); - - return tree_constant (m); -} - -tree_constant -fill_matrix (const tree_constant& a, const tree_constant& b, - double val, const char *warn_for) -{ - int nr, nc; - get_dimensions (a, b, warn_for, nr, nc); // May set error_state. - - if (error_state) - return tree_constant (); - - Matrix m (nr, nc, val); - - return tree_constant (m); -} - -tree_constant -identity_matrix (const tree_constant& a) -{ - int nr, nc; - get_dimensions (a, "eye", nr, nc); // May set error_state. - - if (error_state) - return tree_constant (); - - Matrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - int n = MIN (nr, nc); - for (int i = 0; i < n; i++) - m.elem (i, i) = 1.0; - } - - return tree_constant (m); -} - -tree_constant -identity_matrix (const tree_constant& a, const tree_constant& b) -{ - int nr, nc; - get_dimensions (a, b, "eye", nr, nc); // May set error_state. - - if (error_state) - return tree_constant (); - - Matrix m (nr, nc, 0.0); - - if (nr > 0 && nc > 0) - { - int n = MIN (nr, nc); - for (int i = 0; i < n; i++) - m.elem (i, i) = 1.0; - } - - return tree_constant (m); -} - -static Octave_object -find_to_fortran_idx (const ColumnVector i_idx, const ColumnVector j_idx, - const tree_constant& val, int nr, int nc, int nargout) -{ - Octave_object retval (nargout); - - switch (nargout) - { - case 1: - { - int count = i_idx.length (); - ColumnVector tmp (count); - for (int i = 0; i < count; i++) - tmp (i) = nr * (j_idx (i) - 1.0) + i_idx (i); - retval(0) = tree_constant (tmp, 1); -// If you want this to work more like Matlab, use the following line -// instead of the previous one. -// retval(0) = tree_constant (tmp, (nr != 1)); - } - break; - case 3: - retval(2) = val; - case 2: - retval(0) = tree_constant (i_idx, 1); -// If you want this to work more like Matlab, use the following line -// instead of the previous one. -// retval(0) = tree_constant (i_idx, (nr != 1)); - retval(1) = tree_constant (j_idx, 1); - break; - default: - panic_impossible (); - break; - } - - return retval; -} - -static Octave_object -find_nonzero_elem_idx (const Matrix& m, int nargout) -{ - int count = 0; - int m_nr = m.rows (); - int m_nc = m.columns (); - - int i, j; - for (j = 0; j < m_nc; j++) - for (i = 0; i < m_nr; i++) - if (m.elem (i, j) != 0.0) - count++; - - Matrix result; - Octave_object retval (nargout, result); - - if (count == 0) - return retval; - - ColumnVector i_idx (count); - ColumnVector j_idx (count); - ColumnVector v (count); - - count = 0; - for (j = 0; j < m_nc; j++) - for (i = 0; i < m_nr; i++) - { - double d = m.elem (i, j); - if (d != 0.0) - { - i_idx (count) = i + 1; - j_idx (count) = j + 1; - v (count) = d; - count++; - } - } - - tree_constant tmp (v, 1); - return find_to_fortran_idx (i_idx, j_idx, tmp, m_nr, m_nc, nargout); -} - -static Octave_object -find_nonzero_elem_idx (const ComplexMatrix& m, int nargout) -{ - int count = 0; - int m_nr = m.rows (); - int m_nc = m.columns (); - - int i, j; - for (j = 0; j < m_nc; j++) - for (i = 0; i < m_nr; i++) - if (m.elem (i, j) != 0.0) - count++; - - Matrix result; - Octave_object retval (nargout, result); - - if (count == 0) - return retval; - - ColumnVector i_idx (count); - ColumnVector j_idx (count); - ComplexColumnVector v (count); - - count = 0; - for (j = 0; j < m_nc; j++) - for (i = 0; i < m_nr; i++) - { - Complex c = m.elem (i, j); - if (c != 0.0) - { - i_idx (count) = i; - j_idx (count) = j; - v (count) = c; - count++; - } - } - - tree_constant tmp (v, 1); - return find_to_fortran_idx (i_idx, j_idx, tmp, m_nr, m_nc, nargout); -} - -Octave_object -find_nonzero_elem_idx (const tree_constant& a, int nargout) -{ - Matrix result; - - nargout = (nargout == 0) ? 1 : nargout; - Octave_object retval (nargout, result); - - tree_constant tmp = a.make_numeric (); - - switch (tmp.const_type ()) - { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - return find_nonzero_elem_idx (m, nargout); - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (d != 0.0) - { - retval(0) = 1.0; - if (nargout > 1) - retval(1) = 1.0; - if (nargout > 2) - retval(2) = d; - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - return find_nonzero_elem_idx (m, nargout); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - if (c != 0.0) - { - retval(0) = 1.0; - if (nargout > 1) - retval(1) = 1.0; - if (nargout > 2) - retval(2) = c; - } - } - break; - default: - break; - } - return retval; -} - -// XXX FIXME XXX -- the next two functions (and expm) should really be just -// one... - -Octave_object -matrix_log (const tree_constant& a) -{ - Octave_object retval (1); - - tree_constant tmp = a.make_numeric ();; - - if (tmp.rows () == 0 || tmp.columns () == 0) - { - int flag = user_pref.propagate_empty_matrices; - if (flag != 0) - { - if (flag < 0) - gripe_empty_arg ("logm", 0); - Matrix m; - retval(0) = tree_constant (m); - return retval; - } - else - gripe_empty_arg ("logm", 1); - } - - switch (tmp.const_type ()) - { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - - int nr = m.rows (); - int nc = m.columns (); - - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("logm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); - - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = log (real (elt)); - else - lambda.elem (i) = log (elt); - } - - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); - - retval(0) = tree_constant (result); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - - int nr = m.rows (); - int nc = m.columns (); - - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("logm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); - - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = log (real (elt)); - else - lambda.elem (i) = log (elt); - } - - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); - - retval(0) = tree_constant (result); - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (d > 0.0) - retval(0) = tree_constant (log (d)); - else - { - Complex dtmp (d); - retval(0) = tree_constant (log (dtmp)); - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval(0) = tree_constant (log (c)); - } - break; - default: - break; - } - return retval; -} - -Octave_object -matrix_sqrt (const tree_constant& a) -{ - Octave_object retval (1); - - tree_constant tmp = a.make_numeric ();; - - if (tmp.rows () == 0 || tmp.columns () == 0) - { - int flag = user_pref.propagate_empty_matrices; - if (flag != 0) - { - if (flag < 0) - gripe_empty_arg ("sqrtm", 0); - Matrix m; - retval(0) = tree_constant (m); - return retval; - } - else - gripe_empty_arg ("sqrtm", 1); - } - - switch (tmp.const_type ()) - { - case tree_constant_rep::matrix_constant: - { - Matrix m = tmp.matrix_value (); - - int nr = m.rows (); - int nc = m.columns (); - - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("sqrtm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); - - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = sqrt (real (elt)); - else - lambda.elem (i) = sqrt (elt); - } - - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); - - retval(0) = tree_constant (result); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = tmp.complex_matrix_value (); - - int nr = m.rows (); - int nc = m.columns (); - - if (nr == 0 || nc == 0 || nr != nc) - gripe_square_matrix_required ("sqrtm"); - else - { - EIG m_eig (m); - ComplexColumnVector lambda (m_eig.eigenvalues ()); - ComplexMatrix Q (m_eig.eigenvectors ()); - - for (int i = 0; i < nr; i++) - { - Complex elt = lambda.elem (i); - if (imag (elt) == 0.0 && real (elt) > 0.0) - lambda.elem (i) = sqrt (real (elt)); - else - lambda.elem (i) = sqrt (elt); - } - - ComplexDiagMatrix D (lambda); - ComplexMatrix result = Q * D * Q.inverse (); - - retval(0) = tree_constant (result); - } - } - break; - case tree_constant_rep::scalar_constant: - { - double d = tmp.double_value (); - if (d > 0.0) - retval(0) = tree_constant (sqrt (d)); - else - { - Complex dtmp (d); - retval(0) = tree_constant (sqrt (dtmp)); - } - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex c = tmp.complex_value (); - retval(0) = tree_constant (log (c)); - } - break; - default: - break; - } - return retval; -} - -Octave_object -column_max (const Octave_object& args, int nargout) -{ - Octave_object retval; - - tree_constant arg1; - tree_constant arg2; - tree_constant_rep::constant_type arg1_type = - tree_constant_rep::unknown_constant; - tree_constant_rep::constant_type arg2_type = - tree_constant_rep::unknown_constant; - - int nargin = args.length (); - - switch (nargin) - { - case 3: - arg2 = args(2).make_numeric (); - arg2_type = arg2.const_type (); -// Fall through... - case 2: - arg1 = args(1).make_numeric (); - arg1_type = arg1.const_type (); - break; - default: - panic_impossible (); - break; - } - - if (nargin == 2 && (nargout == 1 || nargout == 0)) - { - retval.resize (1); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - retval(0) = tree_constant (arg1.double_value ()); - break; - case tree_constant_rep::complex_scalar_constant: - retval(0) = tree_constant (arg1.complex_value ()); - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - retval(0) = tree_constant (m.row_max ()); - else - retval(0) = tree_constant (m.column_max (), 0); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - retval(0) = tree_constant (m.row_max ()); - else - retval(0) = tree_constant (m.column_max (), 0); - } - break; - default: - panic_impossible (); - break; - } - } - else if (nargin == 2 && nargout == 2) - { - retval.resize (2); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - { - retval(0) = tree_constant (arg1.double_value ()); - retval(1) = tree_constant (1); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - retval(0) = tree_constant (arg1.complex_value ()); - retval(1) = tree_constant (1); - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - { - retval(0) = tree_constant (m.row_max ()); - retval(1) = tree_constant (m.row_max_loc ()); - } - else - { - retval(0) = tree_constant (m.column_max (), 0); - retval(1) = tree_constant (m.column_max_loc (), 0); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - { - retval(0) = tree_constant (m.row_max ()); - retval(1) = tree_constant (m.row_max_loc ()); - } - else - { - retval(0) = tree_constant (m.column_max (), 0); - retval(1) = tree_constant (m.column_max_loc (), 0); - } - } - break; - default: - panic_impossible (); - break; - } - } - else if (nargin == 3) - { - if (arg1.rows () == arg2.rows () - && arg1.columns () == arg2.columns ()) - { - retval.resize (1); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - { - double result; - double a_elem = arg1.double_value (); - double b_elem = arg2.double_value (); - result = MAX (a_elem, b_elem); - retval(0) = tree_constant (result); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex result; - Complex a_elem = arg1.complex_value (); - Complex b_elem = arg2.complex_value (); - if (abs (a_elem) > abs (b_elem)) - result = a_elem; - else - result = b_elem; - retval(0) = tree_constant (result); - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix result; - result = max (arg1.matrix_value (), arg2.matrix_value ()); - retval(0) = tree_constant (result); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix result; - result = max (arg1.complex_matrix_value (), - arg2.complex_matrix_value ()); - retval(0) = tree_constant (result); - } - break; - default: - panic_impossible (); - break; - } - } - else - error ("max: nonconformant matrices"); - } - else - panic_impossible (); - - return retval; -} - -Octave_object -column_min (const Octave_object& args, int nargout) -{ - Octave_object retval; - - tree_constant arg1; - tree_constant arg2; - tree_constant_rep::constant_type arg1_type = - tree_constant_rep::unknown_constant; - tree_constant_rep::constant_type arg2_type = - tree_constant_rep::unknown_constant; - - int nargin = args.length (); - - switch (nargin) - { - case 3: - arg2 = args(2).make_numeric (); - arg2_type = arg2.const_type (); -// Fall through... - case 2: - arg1 = args(1).make_numeric (); - arg1_type = arg1.const_type (); - break; - default: - panic_impossible (); - break; - } - - if (nargin == 2 && (nargout == 1 || nargout == 0)) - { - retval.resize (1); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - retval(0) = tree_constant (arg1.double_value ()); - break; - case tree_constant_rep::complex_scalar_constant: - retval(0) = tree_constant (arg1.complex_value ()); - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - retval(0) = tree_constant (m.row_min ()); - else - retval(0) = tree_constant (m.column_min (), 0); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - retval(0) = tree_constant (m.row_min ()); - else - retval(0) = tree_constant (m.column_min (), 0); - } - break; - default: - panic_impossible (); - break; - } - } - else if (nargin == 2 && nargout == 2) - { - retval.resize (2); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - { - retval(0) = tree_constant (arg1.double_value ()); - retval(1) = tree_constant (1); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - retval(0) = tree_constant (arg1.complex_value ()); - retval(1) = tree_constant (1); - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix m = arg1.matrix_value (); - if (m.rows () == 1) - { - retval(0) = tree_constant (m.row_min ()); - retval(1) = tree_constant (m.row_min_loc ()); - } - else - { - retval(0) = tree_constant (m.column_min (), 0); - retval(1) = tree_constant (m.column_min_loc (), 0); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix m = arg1.complex_matrix_value (); - if (m.rows () == 1) - { - retval(0) = tree_constant (m.row_min ()); - retval(1) = tree_constant (m.row_min_loc ()); - } - else - { - retval(0) = tree_constant (m.column_min (), 0); - retval(1) = tree_constant (m.column_min_loc (), 0); - } - } - break; - default: - panic_impossible (); - break; - } - } - else if (nargin == 3) - { - if (arg1.rows () == arg2.rows () - && arg1.columns () == arg2.columns ()) - { - retval.resize (1); - switch (arg1_type) - { - case tree_constant_rep::scalar_constant: - { - double result; - double a_elem = arg1.double_value (); - double b_elem = arg2.double_value (); - result = MIN (a_elem, b_elem); - retval(0) = tree_constant (result); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - Complex result; - Complex a_elem = arg1.complex_value (); - Complex b_elem = arg2.complex_value (); - if (abs (a_elem) < abs (b_elem)) - result = a_elem; - else - result = b_elem; - retval(0) = tree_constant (result); - } - break; - case tree_constant_rep::matrix_constant: - { - Matrix result; - result = min (arg1.matrix_value (), arg2.matrix_value ()); - retval(0) = tree_constant (result); - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix result; - result = min (arg1.complex_matrix_value (), - arg2.complex_matrix_value ()); - retval(0) = tree_constant (result); - } - break; - default: - panic_impossible (); - break; - } - } - else - error ("min: nonconformant matrices"); - } - else - panic_impossible (); - - return retval; -} - -static void -mx_sort (Matrix& m, Matrix& idx, int return_idx) -{ - int nr = m.rows (); - int nc = m.columns (); - idx.resize (nr, nc); - int i, j; - - if (return_idx) - { - for (j = 0; j < nc; j++) - for (i = 0; i < nr; i++) - idx.elem (i, j) = i+1; - } - - for (j = 0; j < nc; j++) - { - for (int gap = nr/2; gap > 0; gap /= 2) - for (i = gap; i < nr; i++) - for (int k = i - gap; - k >= 0 && m.elem (k, j) > m.elem (k+gap, j); - k -= gap) - { - double tmp = m.elem (k, j); - m.elem (k, j) = m.elem (k+gap, j); - m.elem (k+gap, j) = tmp; - - if (return_idx) - { - double tmp = idx.elem (k, j); - idx.elem (k, j) = idx.elem (k+gap, j); - idx.elem (k+gap, j) = tmp; - } - } - } -} - -static void -mx_sort (RowVector& v, RowVector& idx, int return_idx) -{ - int n = v.capacity (); - idx.resize (n); - int i; - - if (return_idx) - for (i = 0; i < n; i++) - idx.elem (i) = i+1; - - for (int gap = n/2; gap > 0; gap /= 2) - for (i = gap; i < n; i++) - for (int k = i - gap; - k >= 0 && v.elem (k) > v.elem (k+gap); - k -= gap) - { - double tmp = v.elem (k); - v.elem (k) = v.elem (k+gap); - v.elem (k+gap) = tmp; - - if (return_idx) - { - double tmp = idx.elem (k); - idx.elem (k) = idx.elem (k+gap); - idx.elem (k+gap) = tmp; - } - } -} - -static void -mx_sort (ComplexMatrix& cm, Matrix& idx, int return_idx) -{ - int nr = cm.rows (); - int nc = cm.columns (); - idx.resize (nr, nc); - int i, j; - - if (return_idx) - { - for (j = 0; j < nc; j++) - for (i = 0; i < nr; i++) - idx.elem (i, j) = i+1; - } - - for (j = 0; j < nc; j++) - { - for (int gap = nr/2; gap > 0; gap /= 2) - for (i = gap; i < nr; i++) - for (int k = i - gap; - k >= 0 && abs (cm.elem (k, j)) > abs (cm.elem (k+gap, j)); - k -= gap) - { - Complex ctmp = cm.elem (k, j); - cm.elem (k, j) = cm.elem (k+gap, j); - cm.elem (k+gap, j) = ctmp; - - if (return_idx) - { - double tmp = idx.elem (k, j); - idx.elem (k, j) = idx.elem (k+gap, j); - idx.elem (k+gap, j) = tmp; - } - } - } -} - -static void -mx_sort (ComplexRowVector& cv, RowVector& idx, int return_idx) -{ - int n = cv.capacity (); - idx.resize (n); - int i; - - if (return_idx) - for (i = 0; i < n; i++) - idx.elem (i) = i+1; - - for (int gap = n/2; gap > 0; gap /= 2) - for (i = gap; i < n; i++) - for (int k = i - gap; - k >= 0 && abs (cv.elem (k)) > abs (cv.elem (k+gap)); - k -= gap) - { - Complex tmp = cv.elem (k); - cv.elem (k) = cv.elem (k+gap); - cv.elem (k+gap) = tmp; - - if (return_idx) - { - double tmp = idx.elem (k); - idx.elem (k) = idx.elem (k+gap); - idx.elem (k+gap) = tmp; - } - } -} - -Octave_object -sort (const Octave_object& args, int nargout) -{ -// Assumes that we have been given the correct number of arguments. - - Octave_object retval; - - int return_idx = nargout > 1; - if (return_idx) - retval.resize (2); - else - retval.resize (1); - - switch (args(1).const_type ()) - { - case tree_constant_rep::scalar_constant: - { - retval(0) = tree_constant (args(1).double_value ()); - if (return_idx) - retval(1) = tree_constant (1.0); - } - break; - case tree_constant_rep::complex_scalar_constant: - { - retval(0) = tree_constant (args(1).complex_value ()); - if (return_idx) - retval(1) = tree_constant (1.0); - } - break; - case tree_constant_rep::string_constant: - case tree_constant_rep::range_constant: - case tree_constant_rep::matrix_constant: - { - Matrix m = args(1).to_matrix (); - if (m.rows () == 1) - { - int nc = m.columns (); - RowVector v (nc); - for (int i = 0; i < nc; i++) - v.elem (i) = m.elem (0, i); - RowVector idx; - mx_sort (v, idx, return_idx); - - retval(0) = tree_constant (v, 0); - if (return_idx) - retval(1) = tree_constant (idx, 0); - } - else - { -// Sorts m in place, optionally computes index Matrix. - Matrix idx; - mx_sort (m, idx, return_idx); - - retval(0) = tree_constant (m); - if (return_idx) - retval(1) = tree_constant (idx); - } - } - break; - case tree_constant_rep::complex_matrix_constant: - { - ComplexMatrix cm = args(1).complex_matrix_value (); - if (cm.rows () == 1) - { - int nc = cm.columns (); - ComplexRowVector cv (nc); - for (int i = 0; i < nc; i++) - cv.elem (i) = cm.elem (0, i); - RowVector idx; - mx_sort (cv, idx, return_idx); - - retval(0) = tree_constant (cv, 0); - if (return_idx) - retval(1) = tree_constant (idx, 0); - } - else - { -// Sorts cm in place, optionally computes index Matrix. - Matrix idx; - mx_sort (cm, idx, return_idx); - - retval(0) = tree_constant (cm); - if (return_idx) - retval(1) = tree_constant (idx); - } - } - break; - default: - panic_impossible (); - break; - } - - return retval; -} - -Octave_object -feval (const Octave_object& args, int nargout) -{ -// Assumes that we have been given the correct number of arguments. - - Octave_object retval; - - tree_fvc *fcn = is_valid_function (args(1), "feval", 1); - if (fcn != (tree_fvc *) NULL) - { - int nargin = args.length () - 1; - Octave_object tmp_args (nargin); - for (int i = 0; i < nargin; i++) - tmp_args(i) = args(i+1); - retval = fcn->eval (0, nargout, tmp_args); - } - - return retval; -} - -tree_constant -eval_string (const char *string, int print, int ans_assign, - int& parse_status) -{ - begin_unwind_frame ("eval_string"); - - unwind_protect_int (get_input_from_eval_string); - unwind_protect_ptr (global_command); - unwind_protect_ptr (current_eval_string); - - get_input_from_eval_string = 1; - current_eval_string = string; - - YY_BUFFER_STATE old_buf = current_buffer (); - YY_BUFFER_STATE new_buf = create_buffer ((FILE *) NULL); - - add_unwind_protect (restore_input_buffer, (void *) old_buf); - add_unwind_protect (delete_input_buffer, (void *) 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 *command = global_command; - - run_unwind_frame ("eval_string"); - - tree_constant retval; - - if (parse_status == 0 && command != NULL_TREE) - { - retval = command->eval (print); - delete command; - } - - return retval; -} - -tree_constant -eval_string (const tree_constant& arg, int& parse_status) -{ - if (! arg.is_string_type ()) - { - error ("eval: expecting string argument"); - return -1; - } - - char *string = arg.string_value (); - -// Yes Virginia, we always print here... - - return eval_string (string, 1, 1, parse_status); -} - -static int -match_sans_spaces (const char *standard, const char *test) -{ - const char *tp = test; - while (*tp == ' ' || *tp == '\t') - tp++; - - const char *ep = test + strlen (test) - 1; - while (*ep == ' ' || *ep == '\t') - ep--; - - int len = ep - tp + 1; - - return (strncmp (standard, tp, len) == 0); -} - -tree_constant -get_user_input (const Octave_object& args, int nargout, int debug = 0) -{ - tree_constant retval; - - int nargin = args.length (); - - int read_as_string = 0; - - if (nargin == 3) - { - if (args(2).is_string_type () - && strcmp ("s", args(2).string_value ()) == 0) - read_as_string++; - else - { - error ("input: unrecognized second argument"); - return retval; - } - } - - char *prompt = "debug> "; - if (nargin > 1) - { - if (args(1).is_string_type ()) - prompt = args(1).string_value (); - else - { - error ("input: unrecognized argument"); - return retval; - } - } - - again: - - flush_output_to_pager (); - - char *input_buf = gnu_readline (prompt); - - if (input_buf != (char *) NULL) - { - if (input_buf) - maybe_save_history (input_buf); - - int len = strlen (input_buf); - - if (len < 1) - { - if (debug) - goto again; - else - return retval; - } - - if (match_sans_spaces ("exit", input_buf) - || match_sans_spaces ("quit", input_buf) - || match_sans_spaces ("return", input_buf)) - return tree_constant (); - else if (read_as_string) - retval = tree_constant (input_buf); - else - { - int parse_status; - retval = eval_string (input_buf, 0, 0, parse_status); - if (debug && retval.is_defined ()) - retval.eval (1); - } - } - else - error ("input: reading user-input failed!"); - - if (debug) - goto again; - - return retval; -} - /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/pt-const.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-const.h Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// The rest of the tree classes. -*- C++ -*- +// tree-const.h -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -33,7 +33,6 @@ #include "mx-base.h" #include "Range.h" -#include "builtins.h" #include "tree-base.h" #include "tree-expr.h" #include "tc-rep.h" @@ -41,6 +40,8 @@ class idx_vector; +struct Mapper_fcn; + /* * Constants. */ @@ -98,7 +99,7 @@ void operator delete (void *p, size_t size); #endif - tree_constant operator = (tree_constant& a) + tree_constant operator = (const tree_constant& a) { if (--rep->count <= 0 && rep != a.rep) delete rep; @@ -286,42 +287,10 @@ tree_constant_rep *rep; }; -/* - * Here are some extra functions that are related to the tree_constant - * class but that don't need to be class members or friends. - */ - +// XXX FIXME XXX -- this is not used very much now. Perhaps it can be +// eliminated. extern Octave_object vector_of_empties (int nargout, const char *fcn_name); -extern tree_constant fill_matrix (const tree_constant& a, - double d, const char *warn_for); -extern tree_constant fill_matrix (const tree_constant& a, - const tree_constant& b, - double d, const char *warn_for); - -extern tree_constant identity_matrix (const tree_constant& a); -extern tree_constant identity_matrix (const tree_constant& a, - const tree_constant& b); - -extern Octave_object find_nonzero_elem_idx (const tree_constant& a, - int nargout); - -extern Octave_object matrix_log (const tree_constant& a); -extern Octave_object matrix_sqrt (const tree_constant& a); - -extern Octave_object column_max (const Octave_object& args, int nargout); -extern Octave_object column_min (const Octave_object& args, int nargout); - -extern Octave_object sort (const Octave_object& args, int nargout); - -extern Octave_object feval (const Octave_object& args, int nargout); - -extern tree_constant eval_string (const tree_constant& arg, int& - parse_status); - -extern tree_constant get_user_input (const Octave_object& args, - int nargout, int debug = 0); - #endif /*
--- a/src/pt-exp-base.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-exp-base.cc Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// Tree class. -*- C++ -*- +// tree-expr.cc -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -55,6 +55,7 @@ #include "unwind-prot.h" #include "parse.h" #include "lex.h" +#include "defun.h" extern "C" { @@ -148,15 +149,15 @@ tree_matrix::tree_matrix (void) { dir = tree::md_none; - element = (tree_expression *) NULL; - next = (tree_matrix *) NULL; + element = 0; + next = 0; } tree_matrix::tree_matrix (tree_expression *e, tree::matrix_dir d) { dir = d; element = e; - next = (tree_matrix *) NULL; + next = 0; } tree_matrix::~tree_matrix (void) @@ -178,9 +179,9 @@ { tree_matrix *list = this; tree_matrix *next; - tree_matrix *prev = (tree_matrix *) NULL; - - while (list != (tree_matrix *) NULL) + tree_matrix *prev = 0; + + while (list) { next = list->next; list->next = prev; @@ -195,7 +196,7 @@ { tree_matrix *list = this; int len = 0; - while (list != (tree_matrix *) NULL) + while (list) { len++; list = list->next; @@ -206,9 +207,9 @@ tree_return_list * tree_matrix::to_return_list (void) { - tree_return_list *retval = (tree_return_list *) NULL; + tree_return_list *retval = 0; tree_matrix *list; - for (list = this; list != (tree_matrix *) NULL; list = list->next) + for (list = this; list; list = list->next) { tree_expression *elem = list->element; if (elem->is_identifier ()) @@ -232,12 +233,12 @@ else { delete retval; - retval = (tree_return_list *) NULL; + retval = 0; break; } } - if (retval != (tree_return_list *) NULL) + if (retval) retval = retval->reverse (); return retval; } @@ -302,8 +303,8 @@ Matrix m; ComplexMatrix cm; - char *string = (char *) NULL; - char *str_ptr = (char *) NULL; + char *string = 0; + char *str_ptr = 0; // Eliminate empties and gather stats. @@ -313,7 +314,7 @@ for (int i = 0; i < total_len; i++) { tree_expression *elem = ptr->element; - if (elem == (tree_expression *) NULL) + if (! elem) { retval = tree_constant (Matrix ()); goto done; @@ -494,7 +495,7 @@ cm (put_row, put_col) = tmp.double_value (); break; case tree_constant_rep::string_constant: - if (all_strings && str_ptr != (char *) NULL) + if (all_strings && str_ptr) { memcpy (str_ptr, tmp.string_value (), nc); str_ptr += nc; @@ -532,7 +533,7 @@ m (put_row, put_col) = tmp.double_value (); break; case tree_constant_rep::string_constant: - if (all_strings && str_ptr != (char *) NULL) + if (all_strings && str_ptr) { memcpy (str_ptr, tmp.string_value (), nc); str_ptr += nc; @@ -563,7 +564,7 @@ prev_nc = nc; } - if (all_strings && string != (char *) NULL) + if (all_strings && string) retval = tree_constant (string); else if (found_complex) retval = tree_constant (cm); @@ -586,47 +587,36 @@ /* * Builtin functions. */ -tree_builtin::tree_builtin (const char *nm = (char *) NULL) +tree_builtin::tree_builtin (const char *nm) { nargin_max = -1; nargout_max = -1; - text_fcn = (Text_fcn) NULL; - general_fcn = (General_fcn) NULL; - if (nm != (char *) NULL) + is_mapper = 0; + fcn = 0; + if (nm) my_name = strsave (nm); } tree_builtin::tree_builtin (int i_max, int o_max, Mapper_fcn& m_fcn, - const char *nm = (char *) NULL) + const char *nm) { nargin_max = i_max; nargout_max = o_max; mapper_fcn = m_fcn; - text_fcn = (Text_fcn) NULL; - general_fcn = (General_fcn) NULL; - if (nm != (char *) NULL) + is_mapper = 1; + fcn = 0; + if (nm) my_name = strsave (nm); } -tree_builtin::tree_builtin (int i_max, int o_max, Text_fcn t_fcn, - const char *nm = (char *) NULL) +tree_builtin::tree_builtin (int i_max, int o_max, Octave_builtin_fcn g_fcn, + const char *nm) { nargin_max = i_max; nargout_max = o_max; - text_fcn = t_fcn; - general_fcn = (General_fcn) NULL; - if (nm != (char *) NULL) - my_name = strsave (nm); -} - -tree_builtin::tree_builtin (int i_max, int o_max, General_fcn g_fcn, - const char *nm = (char *) NULL) -{ - nargin_max = i_max; - nargout_max = o_max; - text_fcn = (Text_fcn) NULL; - general_fcn = g_fcn; - if (nm != (char *) NULL) + is_mapper = 0; + fcn = g_fcn; + if (nm) my_name = strsave (nm); } @@ -642,6 +632,12 @@ } #endif +int +tree_builtin::is_mapper_function (void) const +{ + return is_mapper; +} + tree_constant tree_builtin::eval (int print) { @@ -650,20 +646,11 @@ if (error_state) return retval; - if (text_fcn != (Text_fcn) NULL) - { - char **argv = new char * [1]; - argv[0] = strsave (my_name); - Octave_object tmp = (*text_fcn) (1, argv, 1); - if (tmp.length () > 0) - retval = tmp(0); - delete [] argv; - } - else if (general_fcn != (General_fcn) NULL) + if (fcn) { Octave_object args (1); args(0) = tree_constant (my_name); - Octave_object tmp = (*general_fcn) (args, 1); + Octave_object tmp = (*fcn) (args, 1); if (tmp.length () > 0) retval = tmp(0); } @@ -683,31 +670,14 @@ int nargin = args.length (); - if (text_fcn != (Text_fcn) NULL) - { -// XXX FIXME XXX -- what if some arg is not a string? - - int argc = nargin; - char **argv = new char * [argc + 1]; - argv[0] = strsave (my_name); - for (int i = 1; i < argc; i++) - argv[i] = strsave (args(i).string_value ()); - argv[argc] = (char *) NULL; - - retval = (*text_fcn) (argc, argv, nargout); - - for (i = 0; i < argc; i++) - delete [] argv[i]; - delete [] argv; - } - else if (general_fcn != (General_fcn) NULL) + if (fcn) { if (any_arg_is_magic_colon (args)) ::error ("invalid use of colon in function argument list"); else - retval = (*general_fcn) (args, nargout); + retval = (*fcn) (args, nargout); } - else + else if (is_mapper) { if (nargin > nargin_max) ::error ("%s: too many arguments", my_name); @@ -718,6 +688,8 @@ retval(0) = tmp; } } + else + panic_impossible (); return retval; } @@ -742,15 +714,15 @@ /* * Symbols from the symbol table. */ -tree_identifier::tree_identifier (int l = -1, int c = -1) +tree_identifier::tree_identifier (int l, int c) { - sym = (symbol_record *) NULL; + sym = 0; line_num = l; column_num = c; maybe_do_ans_assign = 0; } -tree_identifier::tree_identifier (symbol_record *s, int l = -1, int c = -1) +tree_identifier::tree_identifier (symbol_record *s, int l, int c) { sym = s; line_num = l; @@ -787,7 +759,7 @@ if (status) return this; else - return (tree_identifier *) NULL; + return 0; } tree_identifier * @@ -797,13 +769,13 @@ if (status) return this; else - return (tree_identifier *) NULL; + return 0; } void tree_identifier::document (char *s) { - if (sym != (symbol_record *) NULL && s != (char *) NULL) + if (sym && s) { char *tmp = strsave (s); sym->document (tmp); @@ -889,22 +861,22 @@ int tree_identifier::is_defined (void) { - return (sym != (symbol_record *) NULL && sym->is_defined ()); + return (sym && sym->is_defined ()); } void tree_identifier::bump_value (tree::expression_type etype) { - if (sym != (symbol_record *) NULL) + if (sym) { tree_fvc *tmp = sym->def (); - if (tmp != NULL_TREE) + if (tmp) tmp->bump_value (etype); } } int -tree_identifier::parse_fcn_file (int exec_script = 1) +tree_identifier::parse_fcn_file (int exec_script) { curr_fcn_file_name = name (); char *ff = fcn_file_in_path (curr_fcn_file_name); @@ -966,13 +938,13 @@ } int -tree_identifier::parse_fcn_file (char *ff, int exec_script = 1) +tree_identifier::parse_fcn_file (char *ff, int exec_script) { begin_unwind_frame ("parse_fcn_file"); int script_file_executed = 0; - if (ff != (char *) NULL) + if (ff) { // Open function file and parse. @@ -993,7 +965,7 @@ FILE *ffile = get_input_from_file (ff, 0); - if (ffile != (FILE *) NULL) + if (ffile) { // Check to see if this file defines a function or is just a list of // commands. @@ -1114,7 +1086,7 @@ } } - tree_fvc *ans = (tree_fvc *) NULL; + tree_fvc *ans = 0; if (! script_file_executed) ans = sym->def (); @@ -1125,7 +1097,7 @@ void tree_identifier::mark_as_formal_parameter (void) { - if (sym != (symbol_record *) NULL) + if (sym) sym->mark_as_formal_parameter (); } @@ -1149,9 +1121,7 @@ if (! script_file_executed) { - if (ans == (tree_fvc *) NULL) - eval_undefined_error (); - else + if (ans) { int nargout = maybe_do_ans_assign ? 0 : 1; @@ -1162,6 +1132,8 @@ if (tmp.length () > 0) retval = tmp(0); } + else + eval_undefined_error (); } if (! error_state && retval.is_defined ()) @@ -1170,8 +1142,8 @@ { symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0); - assert (sr != (symbol_record *) NULL); - + assert (sr); + tree_identifier *ans_id = new tree_identifier (sr); tree_constant *tmp = new tree_constant (retval); @@ -1234,9 +1206,7 @@ if (! script_file_executed) { - if (ans == (tree_fvc *) NULL) - eval_undefined_error (); - else + if (ans) { if (maybe_do_ans_assign && nargout == 1) { @@ -1251,7 +1221,7 @@ { symbol_record *sr = global_sym_tab->lookup ("ans", 1, 0); - assert (sr != (symbol_record *) NULL); + assert (sr); tree_identifier *ans_id = new tree_identifier (sr); @@ -1267,6 +1237,8 @@ else retval = ans->eval (print, nargout, args); } + else + eval_undefined_error (); } return retval; @@ -1278,12 +1250,12 @@ tree_function::tree_function (void) { call_depth = 0; - param_list = (tree_parameter_list *) NULL; - ret_list = (tree_parameter_list *) NULL; - sym_tab = (symbol_table *) NULL; - cmd_list = NULL_TREE; - file_name = (char *) NULL; - fcn_name = (char *) NULL; + param_list = 0; + ret_list = 0; + sym_tab = 0; + cmd_list = 0; + file_name = 0; + fcn_name = 0; t_parsed = 0; system_fcn_file = 0; num_named_args = 0; @@ -1294,12 +1266,12 @@ tree_function::tree_function (tree *cl, symbol_table *st) { call_depth = 0; - param_list = (tree_parameter_list *) NULL; - ret_list = (tree_parameter_list *) NULL; + param_list = 0; + ret_list = 0; sym_tab = st; cmd_list = cl; - file_name = (char *) NULL; - fcn_name = (char *) NULL; + file_name = 0; + fcn_name = 0; t_parsed = 0; system_fcn_file = 0; num_named_args = 0; @@ -1323,7 +1295,7 @@ { param_list = t; - if (param_list != (tree_parameter_list *) NULL) + if (param_list) { int len = param_list->length (); int va_only = param_list->varargs_only (); @@ -1369,7 +1341,7 @@ void tree_function::mark_as_system_fcn_file (void) { - if (file_name != (char *) NULL) + if (file_name) { // We really should stash the whole path to the file we found, when we // looked it up, to avoid possible race conditions... XXX FIXME XXX @@ -1401,8 +1373,7 @@ int tree_function::takes_varargs (void) const { - return (param_list != (tree_parameter_list *) NULL - && param_list->takes_varargs ()); + return (param_list && param_list->takes_varargs ()); } void @@ -1443,7 +1414,7 @@ { tree_constant retval; - if (error_state || cmd_list == NULL_TREE) + if (error_state || ! cmd_list) return retval; Octave_object tmp_args (1); @@ -1479,7 +1450,7 @@ if (error_state) return retval; - if (cmd_list == NULL_TREE) + if (! cmd_list) return retval; int nargin = args.length (); @@ -1516,8 +1487,7 @@ unwind_protect_int (num_named_args); unwind_protect_int (curr_va_arg_number); - if (param_list != (tree_parameter_list *) NULL - && ! param_list->varargs_only ()) + if (param_list && ! param_list->varargs_only ()) { param_list->define_from_arg_vector (args); if (error_state) @@ -1549,7 +1519,7 @@ // Copy return values out. - if (ret_list != (tree_parameter_list *) NULL) + if (ret_list) { retval = ret_list->convert_to_const_vector (); } @@ -1569,7 +1539,7 @@ int tree_function::max_expected_args (void) { - if (param_list != NULL_TREE) + if (param_list) { if (param_list->takes_varargs ()) return -1; @@ -1586,22 +1556,80 @@ if (error_state >= 0) error_state = -1; - if (fcn_name != (char *) NULL) + if (fcn_name) { - if (file_name != (char *) NULL) + if (file_name) ::error ("called from `%s' in file `%s'", fcn_name, file_name); else ::error ("called from `%s'", fcn_name); } else { - if (file_name != (char *) NULL) + if (file_name) ::error ("called from file `%s'", file_name); else ::error ("called from `?unknown?'"); } } +DEFUN ("va_arg", Fva_arg, Sva_arg, 1, 1, + "va_arg (): return next argument in a function that takes a\n\ +varible number of parameters") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (curr_function) + { + if (curr_function->takes_varargs ()) + retval = curr_function->octave_va_arg (); + else + { + error ("va_arg only valid within function taking variable"); + error ("number of arguments"); + } + } + else + error ("va_arg only valid within function body"); + } + else + print_usage ("va_arg"); + + return retval; +} + +DEFUN ("va_start", Fva_start, Sva_start, 1, 0, + "va_start (): reset the pointer to the list of optional arguments\n\ +to the beginning") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 1) + { + if (curr_function) + { + if (curr_function->takes_varargs ()) + curr_function->octave_va_start (); + else + { + error ("va_start only valid within function taking variable"); + error ("number of arguments"); + } + } + else + error ("va_start only valid within function body"); + } + else + print_usage ("va_start"); + + return retval; +} + /* * Expressions. */ @@ -1631,9 +1659,9 @@ /* * Prefix expressions. */ -tree_prefix_expression::tree_prefix_expression (int l = -1, int c = -1) +tree_prefix_expression::tree_prefix_expression (int l, int c) { - id = (tree_identifier *) NULL; + id = 0; etype = unknown; line_num = l; column_num = c; @@ -1641,7 +1669,7 @@ tree_prefix_expression::tree_prefix_expression (tree_identifier *t, tree::expression_type et, - int l = -1, int c = -1) + int l, int c) { id = t; etype = et; @@ -1662,7 +1690,7 @@ if (error_state) return retval; - if (id != (tree_identifier *) NULL) + if (id) { id->bump_value (etype); retval = id->eval (print); @@ -1703,9 +1731,9 @@ /* * Postfix expressions. */ -tree_postfix_expression::tree_postfix_expression (int l = -1, int c = -1) +tree_postfix_expression::tree_postfix_expression (int l, int c) { - id = (tree_identifier *) NULL; + id = 0; etype = unknown; line_num = l; column_num = c; @@ -1713,7 +1741,7 @@ tree_postfix_expression::tree_postfix_expression (tree_identifier *t, tree::expression_type et, - int l = -1, int c = -1) + int l, int c) { id = t; etype = et; @@ -1734,7 +1762,7 @@ if (error_state) return retval; - if (id != (tree_identifier *) NULL) + if (id) { retval = id->eval (print); id->bump_value (etype); @@ -1769,17 +1797,17 @@ /* * Unary expressions. */ -tree_unary_expression::tree_unary_expression (int l = -1, int c = -1) +tree_unary_expression::tree_unary_expression (int l, int c) { etype = tree::unknown; - op = (tree_expression *) NULL; + op = 0; line_num = l; column_num = c; } tree_unary_expression::tree_unary_expression (tree_expression *a, tree::expression_type t, - int l = -1, int c = -1) + int l, int c) { etype = t; op = a; @@ -1806,7 +1834,7 @@ case tree::uminus: case tree::hermitian: case tree::transpose: - if (op != (tree_expression *) NULL) + if (op) { tree_constant u = op->eval (0); if (error_state) @@ -1854,11 +1882,11 @@ /* * Binary expressions. */ -tree_binary_expression::tree_binary_expression (int l = -1, int c = -1) +tree_binary_expression::tree_binary_expression (int l, int c) { etype = tree::unknown; - op1 = (tree_expression *) NULL; - op2 = (tree_expression *) NULL; + op1 = 0; + op2 = 0; line_num = l; column_num = c; } @@ -1866,7 +1894,7 @@ tree_binary_expression::tree_binary_expression (tree_expression *a, tree_expression *b, tree::expression_type t, - int l = -1, int c = -1) + int l, int c) { etype = t; op1 = a; @@ -1908,12 +1936,12 @@ case tree::cmp_ne: case tree::and: case tree::or: - if (op1 != (tree_expression *) NULL) + if (op1) { tree_constant a = op1->eval (0); if (error_state) eval_error (); - else if (a.is_defined () && op2 != (tree_expression *) NULL) + else if (a.is_defined () && op2) { tree_constant b = op2->eval (0); if (error_state) @@ -1935,7 +1963,7 @@ case tree::or_or: { int result = 0; - if (op1 != NULL_TREE) + if (op1) { tree_constant a = op1->eval (0); if (error_state) @@ -1968,7 +1996,7 @@ } } - if (op2 != NULL_TREE) + if (op2) { tree_constant b = op2->eval (0); if (error_state) @@ -2063,29 +2091,29 @@ * Simple assignment expressions. */ tree_simple_assignment_expression::tree_simple_assignment_expression - (int l = -1, int c = -1) + (int l, int c) { etype = tree::assignment; - lhs = (tree_identifier *) NULL; - index = (tree_argument_list *) NULL; - rhs = (tree_expression *) NULL; + lhs = 0; + index = 0; + rhs = 0; line_num = l; column_num = c; } tree_simple_assignment_expression::tree_simple_assignment_expression - (tree_identifier *i, tree_expression *r, int l = -1, int c = -1) + (tree_identifier *i, tree_expression *r, int l, int c) { etype = tree::assignment; lhs = i; - index = (tree_argument_list *) NULL; + index = 0; rhs = r; line_num = l; column_num = c; } tree_simple_assignment_expression::tree_simple_assignment_expression - (tree_index_expression *idx_expr, tree_expression *r, int l = -1, int c = -1) + (tree_index_expression *idx_expr, tree_expression *r, int l, int c) { etype = tree::assignment; lhs = idx_expr->ident (); @@ -2113,7 +2141,7 @@ if (error_state) return retval; - if (rhs != (tree_expression *) NULL) + if (rhs) { tree_constant rhs_val = rhs->eval (0); if (error_state) @@ -2121,7 +2149,7 @@ if (error_state) eval_error (); } - else if (index == NULL_TREE) + else if (! index) { ans = lhs->assign (rhs_val); if (error_state) @@ -2197,17 +2225,17 @@ * Multi-valued assignmnt expressions. */ tree_multi_assignment_expression::tree_multi_assignment_expression - (int l = -1, int c = -1) + (int l, int c) { etype = tree::multi_assignment; - lhs = (tree_return_list *) NULL; - rhs = (tree_expression *) NULL; + lhs = 0; + rhs = 0; line_num = l; column_num = c; } tree_multi_assignment_expression::tree_multi_assignment_expression - (tree_return_list *lst, tree_expression *r, int l = -1, int c = -1) + (tree_return_list *lst, tree_expression *r, int l, int c) { etype = tree::multi_assignment; lhs = lst; @@ -2245,7 +2273,7 @@ { assert (etype == tree::multi_assignment); - if (error_state || rhs == (tree_expression *) NULL) + if (error_state || ! rhs) return Octave_object (); nargout = lhs->length (); @@ -2264,8 +2292,7 @@ int i = 0; int pad_after = 0; int last_was_scalar_type = 0; - for (elem = lhs; elem != (tree_return_list *) NULL; - elem = elem->next_elem ()) + for (elem = lhs; elem; elem = elem->next_elem ()) { tree_index_expression *lhs_expr = elem->idx_expr (); if (i < nargout) @@ -2273,7 +2300,7 @@ // XXX FIXME? XXX -- this is apparently the way Matlab works, but // maybe we should have the option of skipping the assignment instead. - tree_constant *tmp = NULL_TREE_CONST; + tree_constant *tmp = 0; if (results(i).is_undefined ()) { Matrix m; @@ -2326,7 +2353,7 @@ else { tree_simple_assignment_expression tmp_expr - (lhs_expr, NULL_TREE_CONST, ma_line, ma_column); + (lhs_expr, 0, ma_line, ma_column); tmp_expr.eval (0); @@ -2362,23 +2389,23 @@ /* * Colon expressions. */ -tree_colon_expression::tree_colon_expression (int l = -1, int c = -1) +tree_colon_expression::tree_colon_expression (int l, int c) { etype = tree::colon; - op1 = (tree_expression *) NULL; - op2 = (tree_expression *) NULL; - op3 = (tree_expression *) NULL; + op1 = 0; + op2 = 0; + op3 = 0; line_num = l; column_num = c; } tree_colon_expression::tree_colon_expression (tree_expression *a, tree_expression *b, - int l = -1, int c = -1) + int l, int c) { etype = tree::colon; - op1 = a; // base - op2 = b; // limit - op3 = (tree_expression *) NULL; // increment if not empty. + op1 = a; // base + op2 = b; // limit + op3 = 0; // increment if not empty. line_num = l; column_num = c; } @@ -2393,8 +2420,8 @@ tree_colon_expression * tree_colon_expression::chain (tree_expression *t) { - tree_colon_expression *retval = (tree_colon_expression *) NULL; - if (op1 == NULL_TREE || op3 != NULL_TREE) + tree_colon_expression *retval = 0; + if (! op1 || op3) ::error ("invalid colon expression"); else { @@ -2411,7 +2438,7 @@ { tree_constant retval; - if (error_state || op1 == NULL_TREE || op2 == NULL_TREE) + if (error_state || ! op1 || ! op2) return retval; tree_constant tmp; @@ -2451,7 +2478,7 @@ double limit = tmp.double_value (); double inc = 1.0; - if (op3 != NULL_TREE) + if (op3) { tmp = op3->eval (0); @@ -2494,17 +2521,17 @@ /* * Index expressions. */ -tree_index_expression::tree_index_expression (int l = -1, int c = -1) +tree_index_expression::tree_index_expression (int l, int c) { - id = (tree_identifier *) NULL; - list = (tree_argument_list *) NULL; + id = 0; + list = 0; line_num = l; column_num = c; } tree_index_expression::tree_index_expression (tree_identifier *i, tree_argument_list *lst, - int l = -1, int c = -1) + int l, int c) { id = i; list = lst; @@ -2513,10 +2540,10 @@ } tree_index_expression::tree_index_expression (tree_identifier *i, - int l = -1, int c = -1) + int l, int c) { id = i; - list = (tree_argument_list *) NULL; + list = 0; line_num = l; column_num = c; } @@ -2560,13 +2587,7 @@ if (error_state) return retval; - if (list == (tree_argument_list *) NULL) - { - retval = id->eval (print); - if (error_state) - eval_error (); - } - else + if (list) { // Extract the arguments into a simple vector. Octave_object args = list->convert_to_const_vector (); @@ -2585,6 +2606,13 @@ retval = tmp(0); } } + else + { + retval = id->eval (print); + if (error_state) + eval_error (); + } + return retval; } @@ -2596,14 +2624,7 @@ if (error_state) return retval; - if (list == (tree_argument_list *) NULL) - { - Octave_object tmp_args; - retval = id->eval (print, nargout, tmp_args); - if (error_state) - eval_error (); - } - else + if (list) { // Extract the arguments into a simple vector. Octave_object args = list->convert_to_const_vector (); @@ -2617,6 +2638,14 @@ eval_error (); } } + else + { + Octave_object tmp_args; + retval = id->eval (print, nargout, tmp_args); + if (error_state) + eval_error (); + } + return retval; } @@ -2630,7 +2659,7 @@ char *fmt; if (l != -1 && c != -1) { - if (list != (tree_argument_list *) NULL) + if (list) fmt = "evaluating index expression near line %d, column %d"; else fmt = "evaluating expression near line %d, column %d"; @@ -2639,7 +2668,7 @@ } else { - if (list != (tree_argument_list *) NULL) + if (list) ::error ("evaluating index expression"); else ::error ("evaluating expression"); @@ -2652,14 +2681,14 @@ */ tree_argument_list::tree_argument_list (void) { - arg = NULL_TREE; - next = (tree_argument_list *) NULL; + arg = 0; + next = 0; } tree_argument_list::tree_argument_list (tree *t) { arg = t; - next = (tree_argument_list *) NULL; + next = 0; } tree_argument_list::~tree_argument_list (void) @@ -2681,9 +2710,9 @@ { tree_argument_list *list = this; tree_argument_list *next; - tree_argument_list *prev = (tree_argument_list *) NULL; - - while (list != (tree_argument_list *) NULL) + tree_argument_list *prev = 0; + + while (list) { next = list->next; list->next = prev; @@ -2698,7 +2727,7 @@ { tree_argument_list *list = this; int len = 0; - while (list != (tree_argument_list *) NULL) + while (list) { len++; list = list->next; @@ -2728,7 +2757,7 @@ tree_argument_list *tmp_list = this; for (int k = 1; k < len; k++) { - if (tmp_list != (tree_argument_list *) NULL) + if (tmp_list) { args(k) = tmp_list->eval (0); if (error_state) @@ -2750,7 +2779,7 @@ tree_constant tree_argument_list::eval (int print) { - if (error_state || arg == NULL_TREE) + if (error_state || ! arg) return tree_constant (); else return arg->eval (print); @@ -2762,15 +2791,15 @@ tree_parameter_list::tree_parameter_list (void) { marked_for_varargs = 0; - param = (tree_identifier *) NULL; - next = (tree_parameter_list *) NULL; + param = 0; + next = 0; } tree_parameter_list::tree_parameter_list (tree_identifier *t) { marked_for_varargs = 0; param = t; - next = (tree_parameter_list *) NULL; + next = 0; } tree_parameter_list::~tree_parameter_list (void) @@ -2792,9 +2821,9 @@ { tree_parameter_list *list = this; tree_parameter_list *next; - tree_parameter_list *prev = (tree_parameter_list *) NULL; - - while (list != (tree_parameter_list *) NULL) + tree_parameter_list *prev = 0; + + while (list) { next = list->next; list->next = prev; @@ -2809,7 +2838,7 @@ { tree_parameter_list *list = this; int len = 0; - while (list != (tree_parameter_list *) NULL) + while (list) { len++; list = list->next; @@ -2827,7 +2856,7 @@ tree_parameter_list::mark_as_formal_parameters (void) { param->mark_as_formal_parameter (); - if (next != (tree_parameter_list *) NULL) + if (next) next->mark_as_formal_parameters (); } @@ -2875,7 +2904,7 @@ for (int i = 1; i < expected_nargin; i++) { - tree_constant *tmp = NULL_TREE_CONST; + tree_constant *tmp = 0; if (i < nargin) { @@ -2901,10 +2930,8 @@ Octave_object retval (nout); int i = 0; - - tree_parameter_list *elem = this; - - for ( ; elem != (tree_parameter_list *) NULL; elem = elem->next) + + for (tree_parameter_list *elem = this; elem; elem = elem->next) { if (elem->is_defined ()) retval(i) = elem->eval (0); @@ -2917,7 +2944,7 @@ int tree_parameter_list::is_defined (void) { - return (param != (tree_identifier *) NULL && param->is_defined ()); + return (param && param->is_defined ()); } tree_parameter_list * @@ -2929,7 +2956,7 @@ tree_constant tree_parameter_list::eval (int print) { - if (error_state || param == NULL_TREE) + if (error_state || ! param) return tree_constant (); else return param->eval (print); @@ -2940,20 +2967,20 @@ */ tree_return_list::tree_return_list (void) { - retval = (tree_index_expression *) NULL; - next = (tree_return_list *) NULL; + retval = 0; + next = 0; } tree_return_list::tree_return_list (tree_identifier *t) { retval = new tree_index_expression (t); - next = (tree_return_list *) NULL; + next = 0; } tree_return_list::tree_return_list (tree_index_expression *t) { retval = t; - next = (tree_return_list *) NULL; + next = 0; } tree_return_list::~tree_return_list (void) @@ -2983,9 +3010,9 @@ { tree_return_list *list = this; tree_return_list *next; - tree_return_list *prev = (tree_return_list *) NULL; - - while (list != (tree_return_list *) NULL) + tree_return_list *prev = 0; + + while (list) { next = list->next; list->next = prev; @@ -3000,7 +3027,7 @@ { tree_return_list *list = this; int len = 0; - while (list != (tree_return_list *) NULL) + while (list) { len++; list = list->next;
--- a/src/pt-exp-base.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/pt-exp-base.h Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// Tree classes. -*- C++ -*- +// tree-expr.h -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -28,9 +28,11 @@ #pragma interface #endif +#include <time.h> #include <stdio.h> -#include "builtins.h" +#include "variables.h" +#include "mappers.h" #include "error.h" #include "oct-obj.h" @@ -38,9 +40,6 @@ class symbol_record; class symbol_table; -typedef Octave_object (*Text_fcn)(int, char **, int); -typedef Octave_object (*General_fcn)(const Octave_object&, int); - class tree_matrix; class tree_builtin; class tree_identifier; @@ -351,7 +350,7 @@ virtual tree_constant assign (tree_constant& t, const Octave_object& args); virtual char *name (void) const - { panic_impossible (); return (char *) NULL; } + { panic_impossible (); return 0; } virtual void bump_value (tree::expression_type) { panic_impossible (); } @@ -360,7 +359,7 @@ { panic_impossible (); return 0; } virtual char *fcn_file_name (void) - { return (char *) NULL; } + { return 0; } virtual time_t time_parsed (void) { panic_impossible (); return 0; } @@ -380,21 +379,20 @@ tree_builtin : public tree_fvc { public: - tree_builtin (const char *nm = (char *) NULL); + tree_builtin (const char *nm = 0); tree_builtin (int i_max, int o_max, Mapper_fcn& m_fcn, - const char *nm = (char *) NULL); + const char *nm = 0); - 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 (int i_max, int o_max, Octave_builtin_fcn f, + const char *nm = 0); ~tree_builtin (void); // int is_builtin (void) const; + int is_mapper_function (void) const; + tree_constant eval (int print); Octave_object eval (int print, int nargout, const Octave_object& args); @@ -406,9 +404,9 @@ private: int nargin_max; int nargout_max; + int is_mapper; Mapper_fcn mapper_fcn; - Text_fcn text_fcn; - General_fcn general_fcn; + Octave_builtin_fcn fcn; char *my_name; };
--- a/src/sighandlers.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/sighandlers.cc Wed Jul 20 19:19:08 1994 +0000 @@ -1,7 +1,7 @@ // sighandlers.cc -*- C++ -*- /* -Copyright (C) 1992, 1993 John W. Eaton +Copyright (C) 1992, 1993, 1994 John W. Eaton This file is part of Octave. @@ -127,7 +127,7 @@ sigpipe_handler (int i) { if (pipe_handler_error_count++ == 0) - message ((char *) NULL, "broken pipe"); + message (0, "broken pipe"); // Don\'t loop forever on account of this. if (pipe_handler_error_count > 100)
--- a/src/sysdep.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/sysdep.cc Wed Jul 20 19:19:08 1994 +0000 @@ -25,11 +25,47 @@ #include "config.h" #endif +#include <sys/types.h> +#ifdef HAVE_UNISTD_H +#include <unistd.h> +#endif #include <math.h> +#include <stddef.h> #include <stdlib.h> +#include <stdio.h> +#include "tree-const.h" +#include "octave.h" +#include "input.h" +#include "utils.h" +#include "oct-obj.h" #include "error.h" #include "sysdep.h" +#include "defun.h" + +extern "C" +{ +#include <readline/readline.h> + +extern char *term_clrpag; +extern void _rl_output_character_function (); + +#if defined (HAVE_TERMIOS_H) +#include <termios.h> +#elif defined (HAVE_TERMIO_H) +#include <termio.h> +#elif defined (HAVE_SGTTY_H) +#include <sgtty.h> +#else +LOSE! LOSE! +#endif + +extern int ioctl (); +} + +#ifndef STDIN_FILENO +#define STDIN_FILENO 1 +#endif // Octave's idea of infinity. double octave_Inf; @@ -80,6 +116,10 @@ #ifdef linux octave_Inf = HUGE_VAL; #else +#ifdef __alpha__ + extern unsigned int DINFINITY[2]; + octave_Inf = (*((double *) (DINFINITY))); +#else double tmp = 1e+10; octave_Inf = tmp; for (;;) @@ -91,6 +131,9 @@ } #endif #endif +#endif + + #if defined (HAVE_QUIET_NAN) octave_NaN = (double) quiet_nan (); @@ -98,9 +141,14 @@ #ifdef linux octave_NaN = NAN; #else +#ifdef __alpha__ + extern unsigned int DQNAN[2]; + octave_NaN = (*((double *) (DQNAN))); +#else octave_NaN = octave_Inf / octave_Inf; #endif #endif +#endif #else @@ -158,6 +206,289 @@ } /* + * Set terminal in raw mode. From less-177. + * + * Change terminal to "raw mode", or restore to "normal" mode. + * "Raw mode" means + * 1. An outstanding read will complete on receipt of a single keystroke. + * 2. Input is not echoed. + * 3. On output, \n is mapped to \r\n. + * 4. \t is NOT expanded into spaces. + * 5. Signal-causing characters such as ctrl-C (interrupt), + * etc. are NOT disabled. + * It doesn't matter whether an input \n is mapped to \r, or vice versa. + */ +void +raw_mode (int on) +{ + static int curr_on = 0; + + int tty_fd = STDIN_FILENO; + if (! isatty (tty_fd)) + { + if (interactive) + error ("stdin is not a tty!"); + return; + } + + if (on == curr_on) + return; + +#if defined (HAVE_TERMIOS_H) + { + struct termios s; + static struct termios save_term; + + if (on) + { +// Get terminal modes. + + tcgetattr (tty_fd, &s); + +// Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + +// Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = 1; + s.c_cc[VTIME] = 0; + } + else + { +// Restore saved modes. + s = save_term; + } + tcsetattr (tty_fd, TCSAFLUSH, &s); + } +#elif defined (HAVE_TERMIO_H) + { + struct termio s; + static struct termio save_term; + + if (on) + { +// Get terminal modes. + + ioctl (tty_fd, TCGETA, &s); + +// Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.c_cflag & CBAUD; +// erase_char = s.c_cc[VERASE]; +// kill_char = s.c_cc[VKILL]; + +// Set the modes to the way we want them. + + s.c_lflag &= ~(ICANON|ECHO|ECHOE|ECHOK|ECHONL); + s.c_oflag |= (OPOST|ONLCR); +#if defined (OCRNL) + s.c_oflag &= ~(OCRNL); +#endif +#if defined (ONOCR) + s.c_oflag &= ~(ONOCR); +#endif +#if defined (ONLRET) + s.c_oflag &= ~(ONLRET); +#endif + s.c_cc[VMIN] = 1; + s.c_cc[VTIME] = 0; + } + else + { +// Restore saved modes. + s = save_term; + } + ioctl (tty_fd, TCSETAW, &s); + } +#elif defined (HAVE_SGTTY_H) + { + struct sgttyb s; + static struct sgttyb save_term; + + if (on) + { +// Get terminal modes. + + ioctl (tty_fd, TIOCGETP, &s); + +// Save modes and set certain variables dependent on modes. + + save_term = s; +// ospeed = s.sg_ospeed; +// erase_char = s.sg_erase; +// kill_char = s.sg_kill; + +// Set the modes to the way we want them. + + s.sg_flags |= CBREAK; + s.sg_flags &= ~(ECHO); + } + else + { +// Restore saved modes. + s = save_term; + } + ioctl (tty_fd, TIOCSETN, &s); + } +#else +LOSE! LOSE! +#endif + + curr_on = on; +} + +/* + * Read one character from the terminal. + */ +int +kbhit (void) +{ + int c; + raw_mode (1); + c = cin.get (); + raw_mode (0); + return c; +} + +DEFUN ("clc", Fclc, Sclc, 1, 0, + "clc (): clear screen") +{ + Octave_object retval; + + rl_beg_of_line (); + rl_kill_line (1); + +#if ! defined (_GO32_) + if (term_clrpag) + tputs (term_clrpag, 1, _rl_output_character_function); + else + crlf (); +#else + crlf (); +#endif + + fflush (rl_outstream); + + return retval; +} + +DEFUN ("getenv", Fgetenv, Sgetenv, 2, 1, + "getenv (STRING): get environment variable values") +{ + Octave_object retval; + + int nargin = args.length (); + + if (nargin == 2 && args(1).is_string_type ()) + { + char *value = getenv (args(1).string_value ()); + if (value) + retval = value; + else + retval = ""; + } + else + print_usage ("getenv"); + + return retval; +} + +DEFALIAS (home, clc) + +DEFUN ("kbhit", Fkbhit, Skbhit, 1, 1, + "kbhit: get a single character from the terminal") +{ + Octave_object retval; + +// XXX FIXME XXX -- add timeout and default value args? + + if (interactive) + { + int c = kbhit (); + char *s = new char [2]; + s[0] = c; + s[1] = '\0'; + retval = s; + } + + return retval; +} + +DEFUN ("pause", Fpause, Spause, 1, 1, + "pause (seconds): suspend program execution") +{ + Octave_object retval; + + int nargin = args.length (); + + if (! (nargin == 1 || nargin == 2)) + { + print_usage ("pause"); + return retval; + } + + if (interactive) + { + switch (nargin) + { + case 2: + { + int delay = NINT (args(1).double_value ()); + if (delay > 0) + { + sleep (delay); + break; + } + } + default: + if (kbhit () == EOF) + clean_up_and_exit (0); + break; + } + } + + return retval; +} + +#if !defined (HAVE_GETHOSTNAME) && defined (HAVE_SYS_UTSNAME_H) +extern "C" +{ +#include <sys/utsname.h> +int +gethostname (char *name, int namelen) +{ + int i; + struct utsname ut; + + --namelen; + + uname (&ut); + i = strlen (ut.nodename) + 1; + strncpy (name, ut.nodename, i < namelen ? i : namelen); + name[namelen] = '\0'; + + return 0; +} +} +#endif + +/* ;;; Local Variables: *** ;;; mode: C++ *** ;;; page-delimiter: "^/\\*" ***
--- a/src/sysdep.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/sysdep.h Wed Jul 20 19:19:08 1994 +0000 @@ -26,6 +26,15 @@ extern void sysdep_init (void); +extern void raw_mode (int); +extern int kbhit (void); + + +extern "C" +{ +extern int gethostname (); +} + // Octave's idea of infinity. extern double octave_Inf;
--- a/src/tc-rep.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/tc-rep.cc Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// The constants for the tree class. -*- C++ -*- +// tc-rep.cc -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -656,7 +656,7 @@ } void -tree_constant_rep::maybe_resize (int i, force_orient f_orient = no_orient) +tree_constant_rep::maybe_resize (int i, force_orient f_orient) { int nr = rows (); int nc = columns (); @@ -816,7 +816,7 @@ } tree_constant_rep::constant_type -tree_constant_rep::force_numeric (int force_str_conv = 0) +tree_constant_rep::force_numeric (int force_str_conv) { switch (type_tag) { @@ -887,7 +887,7 @@ } tree_constant -tree_constant_rep::make_numeric (int force_str_conv = 0) const +tree_constant_rep::make_numeric (int force_str_conv) const { tree_constant retval; switch (type_tag) @@ -1488,10 +1488,10 @@ char *tag = extract_keyword (is, "type"); - if (tag != (char *) NULL && *tag != '\0') + if (tag && *tag) { char *ptr = strchr (tag, ' '); - if (ptr != (char *) NULL) + if (ptr) { *ptr = '\0'; is_global = (strncmp (tag, "global", 6) == 0); @@ -2567,7 +2567,7 @@ && (scalar < m_fcn.lower_limit || scalar > m_fcn.upper_limit)) { - if (m_fcn.c_c_mapper != NULL) + if (m_fcn.c_c_mapper) { Complex c = m_fcn.c_c_mapper (Complex (scalar)); retval = tree_constant (c); @@ -2577,7 +2577,7 @@ } else { - if (m_fcn.d_d_mapper != NULL) + if (m_fcn.d_d_mapper) { double d = m_fcn.d_d_mapper (scalar); retval = tree_constant (d); @@ -2591,7 +2591,7 @@ && (any_element_less_than (*matrix, m_fcn.lower_limit) || any_element_greater_than (*matrix, m_fcn.upper_limit))) { - if (m_fcn.c_c_mapper != NULL) + if (m_fcn.c_c_mapper) { ComplexMatrix cm = map (m_fcn.c_c_mapper, ComplexMatrix (*matrix)); @@ -2602,7 +2602,7 @@ } else { - if (m_fcn.d_d_mapper != NULL) + if (m_fcn.d_d_mapper) { Matrix m = map (m_fcn.d_d_mapper, *matrix); retval = tree_constant (m); @@ -2612,13 +2612,13 @@ } break; case complex_scalar_constant: - if (m_fcn.d_c_mapper != NULL) + if (m_fcn.d_c_mapper) { double d; d = m_fcn.d_c_mapper (*complex_scalar); retval = tree_constant (d); } - else if (m_fcn.c_c_mapper != NULL) + else if (m_fcn.c_c_mapper) { Complex c; c = m_fcn.c_c_mapper (*complex_scalar); @@ -2628,13 +2628,13 @@ panic_impossible (); break; case complex_matrix_constant: - if (m_fcn.d_c_mapper != NULL) + if (m_fcn.d_c_mapper) { Matrix m; m = map (m_fcn.d_c_mapper, *complex_matrix); retval = tree_constant (m); } - else if (m_fcn.c_c_mapper != NULL) + else if (m_fcn.c_c_mapper) { ComplexMatrix cm; cm = map (m_fcn.c_c_mapper, *complex_matrix); @@ -2659,7 +2659,7 @@ * hand off to other functions to do the real work. */ void -tree_constant_rep::assign (tree_constant& rhs, const Octave_object& args) +tree_constant_rep::assign (const tree_constant& rhs, const Octave_object& args) { tree_constant rhs_tmp = rhs.make_numeric (); @@ -2698,7 +2698,7 @@ * this can convert the left-hand side to a matrix. */ void -tree_constant_rep::do_scalar_assignment (tree_constant& rhs, +tree_constant_rep::do_scalar_assignment (const tree_constant& rhs, const Octave_object& args) { assert (type_tag == unknown_constant @@ -2805,7 +2805,7 @@ * matrix to an expression with empty indices to do nothing. */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, const Octave_object& args) { assert (type_tag == unknown_constant @@ -2878,8 +2878,8 @@ * Matrix assignments indexed by a single value. */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, - tree_constant& i_arg) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + const tree_constant& i_arg) { int nr = rows (); int nc = columns (); @@ -2924,8 +2924,8 @@ * multi-dimensional matrices. */ void -tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, - tree_constant& i_arg) +tree_constant_rep::fortran_style_matrix_assignment (const tree_constant& rhs, + const tree_constant& i_arg) { tree_constant tmp_i = i_arg.make_numeric_or_magic (); @@ -3087,7 +3087,7 @@ * Fortran-style assignment for vector index. */ void -tree_constant_rep::fortran_style_matrix_assignment (tree_constant& rhs, +tree_constant_rep::fortran_style_matrix_assignment (const tree_constant& rhs, idx_vector& i) { assert (rhs.is_matrix_type ()); @@ -3133,7 +3133,7 @@ */ void tree_constant_rep::fortran_style_matrix_assignment - (tree_constant& rhs, tree_constant_rep::constant_type mci) + (const tree_constant& rhs, tree_constant_rep::constant_type mci) { assert (rhs.is_matrix_type () && mci == tree_constant_rep::magic_colon); @@ -3182,7 +3182,8 @@ * assignment to a matrix indexed by two colons. */ void -tree_constant_rep::vector_assignment (tree_constant& rhs, tree_constant& i_arg) +tree_constant_rep::vector_assignment (const tree_constant& rhs, + const tree_constant& i_arg) { int nr = rows (); int nc = columns (); @@ -3301,7 +3302,7 @@ * Assignment to a vector with an integer index. */ void -tree_constant_rep::do_vector_assign (tree_constant& rhs, int i) +tree_constant_rep::do_vector_assign (const tree_constant& rhs, int i) { int rhs_nr = rhs.rows (); int rhs_nc = rhs.columns (); @@ -3359,7 +3360,8 @@ * Assignment to a vector with a vector index. */ void -tree_constant_rep::do_vector_assign (tree_constant& rhs, idx_vector& iv) +tree_constant_rep::do_vector_assign (const tree_constant& rhs, + idx_vector& iv) { if (rhs.is_zero_by_zero ()) { @@ -3464,7 +3466,8 @@ * Assignment to a vector with a range index. */ void -tree_constant_rep::do_vector_assign (tree_constant& rhs, Range& ri) +tree_constant_rep::do_vector_assign (const tree_constant& rhs, + Range& ri) { if (rhs.is_zero_by_zero ()) { @@ -3573,9 +3576,9 @@ * assignment. */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, - tree_constant& i_arg, - tree_constant& j_arg) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + const tree_constant& i_arg, + const tree_constant& j_arg) { tree_constant tmp_i = i_arg.make_numeric_or_range_or_magic (); @@ -3637,8 +3640,8 @@ /* MA1 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, - tree_constant& j_arg) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, int i, + const tree_constant& j_arg) { tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); @@ -3775,8 +3778,9 @@ /* MA2 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, - tree_constant& j_arg) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + idx_vector& iv, + const tree_constant& j_arg) { tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); @@ -3907,8 +3911,9 @@ /* MA3 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, - Range& ri, tree_constant& j_arg) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + Range& ri, + const tree_constant& j_arg) { tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); @@ -4044,9 +4049,9 @@ /* MA4 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, tree_constant_rep::constant_type i, - tree_constant& j_arg) + const tree_constant& j_arg) { tree_constant tmp_j = j_arg.make_numeric_or_range_or_magic (); @@ -4227,7 +4232,8 @@ /* 1 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, int j) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + int i, int j) { REP_ELEM_ASSIGN (i, j, rhs.double_value (), rhs.complex_value (), rhs.is_real_type ()); @@ -4235,7 +4241,7 @@ /* 2 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, int i, idx_vector& jv) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4247,7 +4253,8 @@ /* 3 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, Range& rj) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + int i, Range& rj) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4265,7 +4272,7 @@ /* 4 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, int i, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, int i, tree_constant_rep::constant_type mcj) { assert (mcj == magic_colon); @@ -4295,7 +4302,7 @@ /* 5 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, idx_vector& iv, int j) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4310,8 +4317,9 @@ /* 6 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, - idx_vector& iv, idx_vector& jv) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + idx_vector& iv, + idx_vector& jv) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4329,8 +4337,9 @@ /* 7 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, - idx_vector& iv, Range& rj) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + idx_vector& iv, + Range& rj) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4352,7 +4361,8 @@ /* 8 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, idx_vector& iv, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + idx_vector& iv, tree_constant_rep::constant_type mcj) { assert (mcj == magic_colon); @@ -4381,7 +4391,8 @@ /* 9 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, int j) +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + Range& ri, int j) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4399,7 +4410,8 @@ /* 10 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + Range& ri, idx_vector& jv) { REP_RHS_MATRIX (rhs, rhs_m, rhs_cm, rhs_nr, rhs_nc); @@ -4422,7 +4434,8 @@ /* 11 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + Range& ri, Range& rj) { double ib = ri.base (); @@ -4448,7 +4461,8 @@ /* 12 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, Range& ri, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, + Range& ri, tree_constant_rep::constant_type mcj) { assert (mcj == magic_colon); @@ -4479,7 +4493,7 @@ /* 13 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, tree_constant_rep::constant_type mci, int j) { @@ -4510,7 +4524,7 @@ /* 14 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, tree_constant_rep::constant_type mci, idx_vector& jv) { @@ -4540,7 +4554,7 @@ /* 15 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, tree_constant_rep::constant_type mci, Range& rj) { @@ -4574,7 +4588,7 @@ /* 16 */ void -tree_constant_rep::do_matrix_assignment (tree_constant& rhs, +tree_constant_rep::do_matrix_assignment (const tree_constant& rhs, tree_constant_rep::constant_type mci, tree_constant_rep::constant_type mcj) { @@ -5247,8 +5261,8 @@ if (index_nr >= 1 && index_nc >= 1) { - const double *cop_out = (const double *) NULL; - const Complex *c_cop_out = (const Complex *) NULL; + const double *cop_out = 0; + const Complex *c_cop_out = 0; int real_type = type_tag == matrix_constant; if (real_type) cop_out = matrix->data (); @@ -6224,9 +6238,10 @@ tree_constant_rep::do_matrix_index (tree_constant_rep::constant_type mci, tree_constant_rep::constant_type mcj) const { + tree_constant retval; assert (mci == magic_colon && mcj == magic_colon); - - return tree_constant (*this); + retval = tree_constant (*this); + return retval; } tree_constant
--- a/src/tc-rep.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/tc-rep.h Wed Jul 20 19:19:08 1994 +0000 @@ -1,4 +1,4 @@ -// The rest of the tree classes. -*- C++ -*- +// tc-rep.h -*- C++ -*- /* Copyright (C) 1992, 1993, 1994 John W. Eaton @@ -37,6 +37,8 @@ class idx_vector; +struct Mapper_fcn; + /* * Forward class declarations. */ @@ -156,64 +158,78 @@ tree_constant_rep::constant_type force_numeric (int force_str_conv = 0); tree_constant make_numeric (int force_str_conv = 0) const; - void assign (tree_constant& rhs, const Octave_object& args); + void assign (const tree_constant& rhs, const Octave_object& args); - void do_scalar_assignment (tree_constant& rhs, const Octave_object& args); + void do_scalar_assignment (const tree_constant& rhs, + const Octave_object& args); - void do_matrix_assignment (tree_constant& rhs, const Octave_object& args); + void do_matrix_assignment (const tree_constant& rhs, + const Octave_object& args); - void do_matrix_assignment (tree_constant& rhs, tree_constant& i_arg); + void do_matrix_assignment (const tree_constant& rhs, + const tree_constant& i_arg); - void do_matrix_assignment - (tree_constant& rhs, tree_constant& i_arg, tree_constant& j_arg); + void do_matrix_assignment (const tree_constant& rhs, + const tree_constant& i_arg, + const tree_constant& j_arg); - void fortran_style_matrix_assignment (tree_constant& rhs, - tree_constant& i_arg); + void fortran_style_matrix_assignment (const tree_constant& rhs, + const tree_constant& i_arg); - void fortran_style_matrix_assignment (tree_constant& rhs, constant_type ci); + void fortran_style_matrix_assignment (const tree_constant& rhs, + constant_type ci); - void fortran_style_matrix_assignment (tree_constant& rhs, idx_vector& i); + void fortran_style_matrix_assignment (const tree_constant& rhs, + idx_vector& i); - void vector_assignment (tree_constant& rhs, tree_constant& i_arg); + void vector_assignment (const tree_constant& rhs, + const tree_constant& i_arg); void check_vector_assign (int rhs_nr, int rhs_nc, int ilen, const char *rm); - void do_vector_assign (tree_constant& rhs, int i); - void do_vector_assign (tree_constant& rhs, idx_vector& i); - void do_vector_assign (tree_constant& rhs, Range& i); + void do_vector_assign (const tree_constant& rhs, int i); + void do_vector_assign (const tree_constant& rhs, idx_vector& i); + void do_vector_assign (const tree_constant& rhs, Range& i); + + void do_matrix_assignment (const tree_constant& rhs, int i, + const tree_constant& j_arg); + void do_matrix_assignment (const tree_constant& rhs, idx_vector& i, + const tree_constant& j_arg); + void do_matrix_assignment (const tree_constant& rhs, Range& i, + const tree_constant& j_arg); + void do_matrix_assignment (const tree_constant& rhs, constant_type i, + const tree_constant& j_arg); - void do_matrix_assignment - (tree_constant& rhs, int i, tree_constant& j_arg); - void do_matrix_assignment - (tree_constant& rhs, idx_vector& i, tree_constant& j_arg); - void do_matrix_assignment - (tree_constant& rhs, Range& i, tree_constant& j_arg); - void do_matrix_assignment - (tree_constant& rhs, constant_type i, tree_constant& j_arg); + void do_matrix_assignment (const tree_constant& rhs, int i, int j); + void do_matrix_assignment (const tree_constant& rhs, int i, idx_vector& jv); + void do_matrix_assignment (const tree_constant& rhs, int i, Range& j); + void do_matrix_assignment (const tree_constant& rhs, int i, constant_type cj); - void do_matrix_assignment (tree_constant& rhs, int i, int j); - void do_matrix_assignment (tree_constant& rhs, int i, idx_vector& jv); - void do_matrix_assignment (tree_constant& rhs, int i, Range& j); - void do_matrix_assignment (tree_constant& rhs, int i, constant_type cj); - - void do_matrix_assignment (tree_constant& rhs, idx_vector& iv, int j); - void do_matrix_assignment (tree_constant& rhs, idx_vector& iv, + void do_matrix_assignment (const tree_constant& rhs, idx_vector& iv, + int j); + void do_matrix_assignment (const tree_constant& rhs, idx_vector& iv, idx_vector& jv); - void do_matrix_assignment (tree_constant& rhs, idx_vector& iv, Range& j); - void do_matrix_assignment (tree_constant& rhs, idx_vector& iv, + void do_matrix_assignment (const tree_constant& rhs, idx_vector& iv, + Range& j); + void do_matrix_assignment (const tree_constant& rhs, idx_vector& iv, constant_type j); - void do_matrix_assignment (tree_constant& rhs, Range& i, int j); - void do_matrix_assignment (tree_constant& rhs, Range& i, idx_vector& jv); - void do_matrix_assignment (tree_constant& rhs, Range& i, Range& j); - void do_matrix_assignment (tree_constant& rhs, Range& i, constant_type j); + void do_matrix_assignment (const tree_constant& rhs, Range& i, int j); + void do_matrix_assignment (const tree_constant& rhs, Range& i, + idx_vector& jv); + void do_matrix_assignment (const tree_constant& rhs, Range& i, + Range& j); + void do_matrix_assignment (const tree_constant& rhs, Range& i, + constant_type j); - void do_matrix_assignment (tree_constant& rhs, constant_type i, int j); - void do_matrix_assignment (tree_constant& rhs, constant_type i, + void do_matrix_assignment (const tree_constant& rhs, constant_type i, int j); + void do_matrix_assignment (const tree_constant& rhs, constant_type i, idx_vector& jv); - void do_matrix_assignment (tree_constant& rhs, constant_type i, Range& j); - void do_matrix_assignment (tree_constant& rhs, constant_type i, + void do_matrix_assignment (const tree_constant& rhs, constant_type i, + Range& j); + void do_matrix_assignment (const tree_constant& rhs, + const constant_type i, constant_type j); void delete_row (int);
--- a/src/token.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/token.cc Wed Jul 20 19:19:08 1994 +0000 @@ -35,14 +35,14 @@ #include "utils.h" #include "symtab.h" -token::token (int l = -1, int c = -1) +token::token (int l, int c) { line_num = l; column_num = c; type_tag = generic_token; } -token::token (char *s, int l = -1, int c = -1) +token::token (char *s, int l, int c) { line_num = l; column_num = c; @@ -50,7 +50,7 @@ str = strsave (s); } -token::token (double d, int l = -1, int c = -1) +token::token (double d, int l, int c) { line_num = l; column_num = c; @@ -58,7 +58,7 @@ num = d; } -token::token (end_tok_type t, int l = -1, int c = -1) +token::token (end_tok_type t, int l, int c) { line_num = l; column_num = c; @@ -66,7 +66,7 @@ et = t; } -token::token (plot_tok_type t, int l = -1, int c = -1) +token::token (plot_tok_type t, int l, int c) { line_num = l; column_num = c; @@ -74,7 +74,7 @@ pt = t; } -token::token (symbol_record *s, int l = -1, int c = -1) +token::token (symbol_record *s, int l, int c) { line_num = l; column_num = c;
--- a/src/unwind-prot.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/unwind-prot.cc Wed Jul 20 19:19:08 1994 +0000 @@ -41,21 +41,21 @@ unwind_elem::unwind_elem (void) { - unwind_elem_tag = (char *) NULL; - unwind_elem_fptr = (cleanup_func) NULL; - unwind_elem_ptr = (void *) NULL; + unwind_elem_tag = 0; + unwind_elem_fptr = 0; + unwind_elem_ptr = 0; } unwind_elem::unwind_elem (char *t) { unwind_elem_tag = strsave (t); - unwind_elem_fptr = (cleanup_func) NULL; - unwind_elem_ptr = (void *) NULL; + unwind_elem_fptr = 0; + unwind_elem_ptr = 0; } unwind_elem::unwind_elem (cleanup_func f, void *p) { - unwind_elem_tag = (char *) NULL; + unwind_elem_tag = 0; unwind_elem_fptr = f; unwind_elem_ptr = p; } @@ -115,7 +115,7 @@ unwind_elem el = unwind_protect_list.pop (); cleanup_func f = el.fptr (); - if (f != (cleanup_func) NULL) + if (f) f (el.ptr ()); } @@ -140,11 +140,11 @@ unwind_elem el = unwind_protect_list.pop (); cleanup_func f = el.fptr (); - if (f != (cleanup_func) NULL) + if (f) f (el.ptr ()); char *t = el.tag (); - if (t != (char *) NULL && strcmp (t, tag) == 0) + if (t && strcmp (t, tag) == 0) break; } } @@ -156,7 +156,7 @@ { unwind_elem el = unwind_protect_list.pop (); char *t = el.tag (); - if (t != (char *) NULL && strcmp (t, tag) == 0) + if (t && strcmp (t, tag) == 0) break; } } @@ -169,7 +169,7 @@ unwind_elem el = unwind_protect_list.pop (); cleanup_func f = el.fptr (); - if (f != (cleanup_func) NULL) + if (f) f (el.ptr ()); } } @@ -225,8 +225,8 @@ saved_variable::saved_variable (void) { - gen_ptr = (void *) NULL; - gen_ptr_value = (void *) NULL; + gen_ptr = 0; + gen_ptr_value = 0; type_tag = generic; size = 0; }
--- a/src/unwind-prot.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/unwind-prot.h Wed Jul 20 19:19:08 1994 +0000 @@ -28,6 +28,8 @@ #pragma interface #endif +#include <stddef.h> + typedef void (*cleanup_func)(void *ptr); void add_unwind_protect (cleanup_func fptr, void *ptr);
--- a/src/user-prefs.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/user-prefs.cc Wed Jul 20 19:19:08 1994 +0000 @@ -50,7 +50,7 @@ { char *val = builtin_string_variable (var); int pref = -1; - if (val != (char *) NULL) + if (val) { if (strncmp (val, "yes", 3) == 0 || strncmp (val, "true", 4) == 0) @@ -103,7 +103,7 @@ { int pref = 0; char *val = builtin_string_variable ("commas_in_literal_matrix"); - if (val != (char *) NULL) + if (val) { if (strncmp (val, "required", 8) == 0) pref = 2; @@ -154,7 +154,7 @@ char *val = builtin_string_variable ("ignore_function_time_stamp"); - if (val != (char *) NULL) + if (val) { if (strncmp (val, "all", 3) == 0) pref = 2; @@ -486,7 +486,7 @@ int status = 0; char *s = builtin_string_variable ("EDITOR"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.editor; user_pref.editor = s; @@ -506,7 +506,7 @@ int status = 0; char *s = builtin_string_variable ("gnuplot_binary"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.gnuplot_binary; user_pref.gnuplot_binary = s; @@ -526,7 +526,7 @@ int status = 0; char *s = builtin_string_variable ("INFO_FILE"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.info_file; user_pref.info_file = s; @@ -546,7 +546,7 @@ int status = 0; char *s = builtin_string_variable ("LOADPATH"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.loadpath; user_pref.loadpath = s; @@ -566,7 +566,7 @@ int status = 0; char *s = builtin_string_variable ("PAGER"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.pager_binary; user_pref.pager_binary = s; @@ -586,7 +586,7 @@ int status = 0; char *s = builtin_string_variable ("PS1"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.ps1; user_pref.ps1 = s; @@ -606,7 +606,7 @@ int status = 0; char *s = builtin_string_variable ("PS2"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.ps2; user_pref.ps2 = s; @@ -626,7 +626,7 @@ int status = 0; char *s = builtin_string_variable ("PWD"); - if (s != (char *) NULL) + if (s) { delete [] user_pref.pwd; user_pref.pwd = s;
--- a/src/variables.cc Wed Jul 20 18:53:50 1994 +0000 +++ b/src/variables.cc Wed Jul 20 19:19:08 1994 +0000 @@ -30,21 +30,37 @@ #include <unistd.h> #endif #include <ctype.h> +#include <float.h> +#include <string.h> +#include <fstream.h> #include <iostream.h> #include <strstream.h> #include "statdefs.h" #include "tree-const.h" #include "variables.h" +#include "mappers.h" #include "user-prefs.h" +#include "version.h" #include "symtab.h" -#include "builtins.h" -#include "g-builtins.h" -#include "t-builtins.h" +#include "defaults.h" +#include "dirfns.h" +#include "pager.h" +#include "sysdep.h" +#include "octave.h" +#include "oct-obj.h" #include "error.h" #include "utils.h" #include "tree.h" #include "help.h" +#include "defun.h" + +extern "C" +{ +#include <readline/tilde.h> + +#include "fnmatch.h" +} // Symbol table for symbols at the top level. symbol_table *top_level_sym_tab; @@ -77,14 +93,13 @@ if (ignore == 2) return 0; - if (sr != (symbol_record *) NULL) + if (sr) { tree_fvc *ans = sr->def (); - if (ans != (tree_fvc *) NULL) + if (ans) { char *ff = ans->fcn_file_name (); - if (! (ff == (char *) NULL - || (ignore && ans->is_system_fcn_file ()))) + if (ff && ! (ignore && ans->is_system_fcn_file ())) { time_t tp = ans->time_parsed (); char *fname = fcn_file_in_path (ff); @@ -108,19 +123,15 @@ else { symbol_record *sym_rec = curr_sym_tab->lookup (name, 0); - if (sym_rec == (symbol_record *) NULL) - { - error ("document: no such symbol `%s'", name); - } + if (sym_rec) + sym_rec->document (help); else - { - sym_rec->document (help); - } + error ("document: no such symbol `%s'", name); } } void -install_builtin_mapper_function (builtin_mapper_functions *mf) +install_builtin_mapper (builtin_mapper_function *mf) { symbol_record *sym_rec = global_sym_tab->lookup (mf->name, 1); sym_rec->unprotect (); @@ -143,56 +154,43 @@ } void -install_builtin_text_function (builtin_text_functions *tf) +install_builtin_function (builtin_function *f) { - symbol_record *sym_rec = global_sym_tab->lookup (tf->name, 1); + symbol_record *sym_rec = global_sym_tab->lookup (f->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 (); - -} + tree_builtin *def = new tree_builtin (f->nargin_max, f->nargout_max, + f->fcn, f->name); -void -install_builtin_general_function (builtin_general_functions *gf) -{ - symbol_record *sym_rec = global_sym_tab->lookup (gf->name, 1); - sym_rec->unprotect (); + sym_rec->define (def, f->is_text_fcn); - 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->document (f->help_string); sym_rec->make_eternal (); sym_rec->protect (); } void -install_builtin_variable (builtin_string_variables *sv) +install_builtin_variable (builtin_variable *v) { - tree_constant *val = new tree_constant (sv->value); - - bind_builtin_variable (sv->name, val, 0, 1, sv->sv_function, - sv->help_string); + if (v->install_as_function) + install_builtin_variable_as_function (v->name, v->value, v->protect, + v->eternal, v->help_string); + else + bind_builtin_variable (v->name, v->value, v->protect, v->eternal, + v->sv_function, v->help_string); } void install_builtin_variable_as_function (const char *name, tree_constant *val, - int protect = 0, int eternal = 0) + int protect, int eternal, + const char *help) { symbol_record *sym_rec = global_sym_tab->lookup (name, 1); sym_rec->unprotect (); - char *tmp_help = sym_rec->help (); + const char *tmp_help = help; + if (! help) + tmp_help = sym_rec->help (); sym_rec->define_as_fcn (val); @@ -230,16 +228,15 @@ */ 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) + int protect, int eternal, sv_Function sv_fcn, + const char *help) { 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); + assert (sr); sr->unprotect (); @@ -264,7 +261,7 @@ /* * Look for the given name in the global symbol table. If it refers - * to a string, return a new copy. If not, return NULL. + * to a string, return a new copy. If not, return 0; */ char * builtin_string_variable (const char *name) @@ -273,20 +270,20 @@ // It is a prorgramming error to look for builtins that aren't. - assert (sr != (symbol_record *) NULL); + assert (sr); - char *retval = (char *) NULL; + char *retval = 0; tree_fvc *defn = sr->def (); - if (defn != (tree_fvc *) NULL) + if (defn) { tree_constant val = defn->eval (0); if (! error_state && val.is_string_type ()) { char *s = val.string_value (); - if (s != (char *) NULL) + if (s) retval = strsave (s); } } @@ -307,11 +304,11 @@ // It is a prorgramming error to look for builtins that aren't. - assert (sr != (symbol_record *) NULL); + assert (sr); tree_fvc *defn = sr->def (); - if (defn != (tree_fvc *) NULL) + if (defn) { tree_constant val = defn->eval (0); @@ -351,22 +348,20 @@ { // Would be nice not to have this cast. XXX FIXME XXX tree_constant *tmp = (tree_constant *) sr->def (); - if (tmp == NULL_TREE_CONST) + if (tmp) + tmp = new tree_constant (*tmp); + else tmp = new tree_constant (); - else - tmp = new tree_constant (*tmp); gsr->define (tmp); } else - { - sr->clear (); - } + 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); + gsr->define ((tree_constant *) 0); sr->alias (gsr, 1); sr->mark_as_linked_to_global (); @@ -381,13 +376,8 @@ { 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); - } - } + if (tmp_sym && tmp_sym->is_builtin_variable ()) + sr->alias (tmp_sym); } /* @@ -401,14 +391,10 @@ { 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); - } - } + if (tmp_sym + && (tmp_sym->is_builtin_variable () || tmp_sym->is_function ()) + && ! tmp_sym->is_formal_parameter ()) + sr->alias (tmp_sym); } /* @@ -432,15 +418,27 @@ } } -/* - * Return 1 if the argument names a globally visible variable. - * Otherwise, return 0. - */ -int -is_globally_visible (const char *name) +DEFUN ("is_global", Fis_global, Sis_global, 2, 1, + "is_global (X): return 1 if the string X names a global variable\n\ +otherwise, return 0.") { + Octave_object retval (0.0); + + int nargin = args.length (); + + if (nargin != 2 || ! args(1).is_string_type ()) + { + print_usage ("is_global"); + return retval; + } + + char *name = args(1).string_value (); + symbol_record *sr = curr_sym_tab->lookup (name, 0, 0); - return (sr != (symbol_record *) NULL && sr->is_linked_to_global ()); + + retval = (double) (sr && sr->is_linked_to_global ()); + + return retval; } /* @@ -457,7 +455,7 @@ { ostrstream buf; - char *retval = (char *) NULL; + char *retval = 0; char c; while (is.get (c)) @@ -576,7 +574,7 @@ int valid_identifier (char *s) { - if (s == (char *) NULL || ! (isalnum (*s) || *s == '_')) + if (! s || ! (isalnum (*s) || *s == '_')) return 0; while (*++s != '\0') @@ -586,36 +584,51 @@ return 1; } -/* - * See if the identifier is in scope. - */ -int -identifier_exists (char *name) +DEFUN ("exist", Fexist, Sexist, 2, 1, + "exist (NAME): check if variable or file exists\n\ +\n\ +return 0 if NAME is undefined, 1 if it is a variable, or 2 if it is\n\ +a function.") { + Octave_object retval; + + int nargin = args.length (); + + if (nargin != 2 || ! args(1).is_string_type ()) + { + print_usage ("exist"); + return retval; + } + + char *name = args(1).string_value (); + symbol_record *sr = curr_sym_tab->lookup (name, 0, 0); - if (sr == (symbol_record *) NULL) + if (! sr) sr = global_sym_tab->lookup (name, 0, 0); - if (sr != (symbol_record *) NULL && sr->is_variable () && sr->is_defined ()) - return 1; - else if (sr != (symbol_record *) NULL && sr->is_function ()) - return 2; + retval = 0.0; + + if (sr && sr->is_variable () && sr->is_defined ()) + retval = 1.0; + else if (sr && sr->is_function ()) + retval = 2.0; else { char *path = fcn_file_in_path (name); - if (path != (char *) NULL) + if (path) { delete [] path; - return 2; + retval = 2.0; } else { struct stat buf; if (stat (name, &buf) == 0 && S_ISREG (buf.st_mode)) - return 2; + retval = 2.0; } } - return 0; + + return retval; } /* @@ -625,16 +638,16 @@ 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 ()); + return (sr && sr->is_builtin_variable ()); } /* * Is this tree_constant a valid function? */ tree_fvc * -is_valid_function (tree_constant& arg, char *warn_for, int warn = 0) +is_valid_function (const tree_constant& arg, char *warn_for, int warn) { - tree_fvc *ans = (tree_fvc *) NULL; + tree_fvc *ans = 0; if (! arg.is_string_type ()) { @@ -646,25 +659,25 @@ char *fcn_name = arg.string_value (); symbol_record *sr = global_sym_tab->lookup (fcn_name, 0, 0); - if (sr == (symbol_record *) NULL) + if (sr && symbol_out_of_date (sr)) + { + tree_identifier tmp (sr); + tmp.parse_fcn_file (0); + } + else { sr = global_sym_tab->lookup (fcn_name, 1, 0); tree_identifier tmp (sr); tmp.parse_fcn_file (0); } - else if (symbol_out_of_date (sr)) - { - tree_identifier tmp (sr); - tmp.parse_fcn_file (0); - } ans = sr->def (); - if (ans == (tree_fvc *) NULL || ! sr->is_function ()) + if (! ans || ! sr->is_function ()) { if (warn) error ("%s: the symbol `%s' is not valid as a function", warn_for, fcn_name); - ans = (tree_fvc *) NULL; + ans = 0; } return ans; @@ -675,7 +688,7 @@ */ int takes_correct_nargs (tree_fvc *fcn, int expected_nargin, char *warn_for, - int warn = 0) + int warn) { int nargin = fcn->max_expected_args () - 1; int e_nargin = expected_nargin - 1; @@ -683,7 +696,7 @@ { if (warn) error ("%s: expecting function to take %d argument%c", - warn_for, e_nargin, s_plural (e_nargin)); + warn_for, e_nargin, (e_nargin == 1 ? "" : "s")); return 0; } return 1; @@ -700,11 +713,11 @@ int lcl_len = 0; int ffl_len = 0; - char **key = (char **) NULL; - char **glb = (char **) NULL; - char **top = (char **) NULL; - char **lcl = (char **) NULL; - char **ffl = (char **) NULL; + char **key = 0; + char **glb = 0; + char **top = 0; + char **lcl = 0; + char **ffl = 0; // Each of these functions returns a new vector of pointers to new // strings. @@ -741,7 +754,7 @@ for (i = 0; i < ffl_len; i++) list[j++] = ffl[i]; - list[j] = (char *) NULL; + list[j] = 0; delete [] key; delete [] glb; @@ -752,6 +765,1224 @@ return list; } +int +is_text_function_name (const char *s) +{ + symbol_record *sr = global_sym_tab->lookup (s); + return (sr && sr->is_text_function ()); +} + +/* + * Help stuff. + */ +help_list * +builtin_mapper_functions_help (void) +{ +#if 0 + int count = 0; + builtin_mapper_functions *mfptr; + + mfptr = mapper_functions; + while (mfptr->name) + { + count++; + mfptr++; + } + + if (count == 0) + return 0; + + help_list *hl = new help_list [count+1]; + + int i = 0; + mfptr = mapper_functions; + while (mfptr->name) + { + hl[i].name = mfptr->name; + hl[i].help = mfptr->help_string; + i++; + mfptr++; + } + + hl[count].name = 0; + hl[count].help = 0; + + return hl; +#endif + + return 0; +} + +help_list * +builtin_general_functions_help (void) +{ +#if 0 + int count = 0; + builtin_general_functions *gfptr; + + gfptr = general_functions; + while (gfptr->name) + { + count++; + gfptr++; + } + + if (count == 0) + return 0; + + help_list *hl = new help_list [count+1]; + + int i = 0; + gfptr = general_functions; + while (gfptr->name) + { + hl[i].name = gfptr->name; + hl[i].help = gfptr->help_string; + i++; + gfptr++; + } + + hl[count].name = 0; + hl[count].help = 0; + + return hl; +#endif + + return 0; +} + +help_list * +builtin_text_functions_help (void) +{ +#if 0 + int count = 0; + builtin_text_functions *tfptr; + + tfptr = text_functions; + while (tfptr->name) + { + count++; + tfptr++; + } + + if (count == 0) + return 0; + + help_list *hl = new help_list [count+1]; + + int i = 0; + tfptr = text_functions; + while (tfptr->name) + { + hl[i].name = tfptr->name; + hl[i].help = tfptr->help_string; + i++; + tfptr++; + } + + hl[count].name = 0; + hl[count].help = 0; + + return hl; +#endif + + return 0; +} + +help_list * +builtin_variables_help (void) +{ +#if 0 + int count = 0; + + builtin_string_variables *svptr; + + svptr = string_variables; + while (svptr->name) + { + count++; + svptr++; + } + + if (count == 0) + return 0; + + help_list *hl = new help_list [count+1]; + + int i = 0; + svptr = string_variables; + while (svptr->name) + { + hl[i].name = svptr->name; + hl[i].help = svptr->help_string; + i++; + svptr++; + } + + hl[count].name = 0; + hl[count].help = 0; + + return hl; +#endif + + return 0; +} + +int +help_from_list (ostrstream& output_buf, const help_list *list, + const char *string, int usage) +{ + char *name; + while ((name = list->name) != 0) + { + if (strcmp (name, string) == 0) + { + if (usage) + output_buf << "\nusage: "; + else + { + output_buf << "\n*** " << string << ":\n\n"; + } + + output_buf << list->help << "\n"; + + return 1; + } + list++; + } + return 0; +} + +void +additional_help_message (ostrstream& output_buf) +{ + output_buf + << "\n" + << "Additional help for builtin functions, operators, and variables\n" + << "is available in the on-line version of the manual.\n" + << "\n" + << "Use the command `help -i <topic>' to search the manual index.\n"; +} + +void +print_usage (const char *string, int just_usage) +{ + ostrstream output_buf; + + help_list *gf_help_list = builtin_general_functions_help (); + help_list *tf_help_list = builtin_text_functions_help (); + help_list *mf_help_list = builtin_mapper_functions_help (); + + if (help_from_list (output_buf, gf_help_list, string, 1) + || help_from_list (output_buf, tf_help_list, string, 1) + || help_from_list (output_buf, mf_help_list, string, 1)) + { + if (! just_usage) + additional_help_message (output_buf); + output_buf << ends; + maybe_page_output (output_buf); + } +} + +void +install_builtin_variables (void) +{ +// XXX FIXME XX -- these should probably be moved to where they +// logically belong instead of being all grouped here. + + DEFVAR ("EDITOR", SBV_EDITOR, editor, 0, 0, 1, sv_editor, + "name of the editor to be invoked by the edit_history command"); + + DEFVAR ("I", SBV_I, Complex (0.0, 1.0), 0, 1, 1, 0, + "sqrt (-1)"); + + DEFVAR ("Inf", SBV_Inf, octave_Inf, 0, 1, 1, 0, + "infinity"); + + DEFVAR ("INFO_FILE", SBV_INFO_FILE, info_file, 0, 0, 1, sv_info_file, + "name of the Octave info file"); + + DEFVAR ("J", SBV_J, Complex (0.0, 1.0), 0, 1, 1, 0, + "sqrt (-1)"); + + #if defined (HAVE_ISNAN) + DEFVAR ("NaN", SBV_NaN, octave_NaN, 0, 1, 1, 0, + "not a number"); + #endif + + DEFVAR ("LOADPATH", SBV_LOADPATH, load_path, 0, 0, 1, sv_loadpath, + "colon separated list of directories to search for scripts"); + + DEFVAR ("PAGER", SBV_PAGER, default_pager (), 0, 0, 1, sv_pager_binary, + "path to pager binary"); + + DEFVAR ("PS1", SBV_PS1, "\\s:\\#> ", 0, 0, 1, sv_ps1, + "primary prompt string"); + + DEFVAR ("PS2", SBV_PS2, "> ", 0, 0, 1, sv_ps2, + "secondary prompt string"); + + DEFVAR ("PWD", SBV_PWD, get_working_directory ("initialize_globals"), + 0, 1, 1, sv_pwd, + "current working directory"); + + DEFVAR ("SEEK_SET", SBV_SEEK_SET, 0.0, 0, 1, 1, 0, + "used with fseek to position file relative to the beginning"); + + DEFVAR ("SEEK_CUR", SBV_SEEK_CUR, 1.0, 0, 1, 1, 0, + "used with fseek to position file relative to the current position"); + + DEFVAR ("SEEK_END", SBV_SEEK_END, 2.0, 0, 1, 1, 0, + "used with fseek to position file relative to the end"); + + DEFVAR ("ans", SBV_ans, , 0, 0, 1, 0, + ""); + + DEFVAR ("commas_in_literal_matrix", SBV_commas_in_literal_matrix, "", + 0, 0, 1, commas_in_literal_matrix, + "control auto-insertion of commas in literal matrices"); + + DEFVAR ("do_fortran_indexing", SBV_do_fortran_indexing, "false", 0, 0, + 1, do_fortran_indexing, + "allow single indices for matrices"); + + DEFVAR ("empty_list_elements_ok", SBV_empty_list_elements_ok, "warn", + 0, 0, 1, empty_list_elements_ok, + "ignore the empty element in expressions like `a = [[], 1]'"); + + DEFVAR ("eps", SBV_eps, DBL_EPSILON, 0, 1, 1, 0, + "machine precision"); + + DEFVAR ("gnuplot_binary", SBV_gnuplot_binary, "gnuplot", 0, 0, 1, + sv_gnuplot_binary, + "path to gnuplot binary"); + + DEFVAR ("i", SBV_i, Complex (0.0, 1.0), 1, 1, 1, 0, + "sqrt (-1)"); + + DEFVAR ("ignore_function_time_stamp", SBV_ignore_function_time_stamp, + "system", 0, 0, 1, + ignore_function_time_stamp, + "don't check to see if function files have changed since they were\n\ + last compiled. Possible values are \"system\" and \"all\""); + + DEFVAR ("implicit_str_to_num_ok", SBV_implicit_str_to_num_ok, "false", + 0, 0, 1, implicit_str_to_num_ok, + "allow implicit string to number conversion"); + + DEFVAR ("inf", SBV_inf, octave_Inf, 0, 1, 1, 0, + "infinity"); + + DEFVAR ("j", SBV_j, Complex (0.0, 1.0), 1, 1, 1, 0, + "sqrt (-1)"); + + #if defined (HAVE_ISNAN) + DEFVAR ("nan", SBV_nan, octave_NaN, 0, 1, 1, 0, + "not a number"); + #endif + + DEFVAR ("ok_to_lose_imaginary_part", SBV_ok_to_lose_imaginary_part, + "warn", 0, 0, 1, ok_to_lose_imaginary_part, + "silently convert from complex to real by dropping imaginary part"); + + DEFVAR ("output_max_field_width", SBV_output_max_field_width, 10.0, 0, + 0, 1, set_output_max_field_width, + "maximum width of an output field for numeric output"); + + DEFVAR ("output_precision", SBV_output_precision, 5.0, 0, 0, 1, + set_output_precision, + "number of significant figures to display for numeric output"); + + DEFVAR ("page_screen_output", SBV_page_screen_output, "true", 0, 0, 1, + page_screen_output, + "if possible, send output intended for the screen through the pager"); + + DEFVAR ("pi", SBV_pi, 4.0 * atan (1.0), 0, 1, 1, 0, + "ratio of the circumference of a circle to its diameter"); + + DEFVAR ("prefer_column_vectors", SBV_prefer_column_vectors, "true", 0, + 0, 1, prefer_column_vectors, + "prefer column/row vectors"); + + DEFVAR ("prefer_zero_one_indexing", SBV_prefer_zero_one_indexing, + "false", 0, 0, 1, prefer_zero_one_indexing, + "when there is a conflict, prefer zero-one style indexing"); + + DEFVAR ("print_answer_id_name", SBV_print_answer_id_name, "true", 0, + 0, 1, print_answer_id_name, + "set output style to print `var_name = ...'"); + + DEFVAR ("print_empty_dimensions", SBV_print_empty_dimensions, "true", + 0, 0, 1, print_empty_dimensions, + "also print dimensions of empty matrices"); + + DEFVAR ("propagate_empty_matrices", SBV_propagate_empty_matrices, + "true", 0, 0, 1, propagate_empty_matrices, + "operations on empty matrices return an empty matrix, not an error"); + + DEFVAR ("resize_on_range_error", SBV_resize_on_range_error, "true", 0, + 0, 1, resize_on_range_error, + "enlarge matrices on assignment"); + + DEFVAR ("return_last_computed_value", SBV_return_last_computed_value, + "false", 0, 0, 1, + return_last_computed_value, + "if a function does not return any values explicitly, return the\n\ + last computed value"); + + DEFVAR ("save_precision", SBV_save_precision, 17.0, 0, 0, 1, + set_save_precision, + "number of significant figures kept by the ASCII save command"); + + DEFVAR ("silent_functions", SBV_silent_functions, "false", 0, 0, 1, + silent_functions, + "suppress printing results in called functions"); + + DEFVAR ("split_long_rows", SBV_split_long_rows, "true", 0, 0, 1, + split_long_rows, + "split long matrix rows instead of wrapping"); + + DEFVAR ("stdin", SBV_stdin, 0.0, 0, 1, 1, 0, + "file number of the standard input stream"); + + DEFVAR ("stdout", SBV_stdout, 1.0, 0, 1, 1, 0, + "file number of the standard output stream"); + + DEFVAR ("stderr", SBV_stderr, 2.0, 0, 1, 1, 0, + "file number of the standard error stream"); + + DEFVAR ("treat_neg_dim_as_zero", SBV_treat_neg_dim_as_zero, "false", + 0, 0, 1, treat_neg_dim_as_zero, + "convert negative dimensions to zero"); + + DEFVAR ("warn_assign_as_truth_value", SBV_warn_assign_as_truth_value, + "true", 0, 0, 1, + warn_assign_as_truth_value, + "produce warning for assignments used as truth values"); + + DEFVAR ("warn_comma_in_global_decl", SBV_warn_comma_in_global_decl, + "true", 0, 0, 1, warn_comma_in_global_decl, + "produce warning for commas in global declarations"); + + DEFVAR ("warn_divide_by_zero", SBV_warn_divide_by_zero, "true", 0, 0, + 1, warn_divide_by_zero, + "on IEEE machines, allow divide by zero errors to be suppressed"); +} + +/* + * 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) + 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 && 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 && count > 0) + { + output_buf << "\n" << header << "\n\n"; + list_in_columns (output_buf, symbols); + status = 1; + } + delete [] symbols; + } + return status; +} + +DEFUN_TEXT ("clear", Fclear, Sclear, -1, 1, + "clear [name ...]\n\ +\n\ +clear symbol(s) matching a list of globbing patterns\n\ +if no arguments are given, clear all user-defined variables and functions") +{ + Octave_object retval; + + DEFINE_ARGV("clear"); + +// 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 (); + global_sym_tab->clear (clear_user_functions); + } + else + { + 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) + { + argv++; + if (*argv) + { + int i; + for (i = 0; i < lcount; i++) + { + if (fnmatch (*argv, lvars[i], __FNM_FLAGS) == 0) + curr_sym_tab->clear (lvars[i]); + } + + int count; + for (i = 0; i < gcount; i++) + { + if (fnmatch (*argv, gvars[i], __FNM_FLAGS) == 0) + { + count = curr_sym_tab->clear (gvars[i]); + if (count > 0) + global_sym_tab->clear (gvars[i], clear_user_functions); + } + } + + for (i = 0; i < fcount; i++) + { + if (fnmatch (*argv, fcns[i], __FNM_FLAGS) == 0) + { + count = curr_sym_tab->clear (fcns[i]); + if (count > 0) + global_sym_tab->clear (fcns[i], clear_user_functions); + } + } + } + } + + delete [] lvars; + delete [] gvars; + delete [] fcns; + + } + + DELETE_ARGV; + + return retval; +} + +DEFUN_TEXT ("document", Fdocument, Sdocument, -1, 1, + "document symbol string ...\n\ +\n\ +Associate a cryptic message with a variable name.") +{ + Octave_object retval; + + DEFINE_ARGV("document"); + + if (argc == 3) + document_symbol (argv[1], argv[2]); + else + print_usage ("document"); + + DELETE_ARGV; + + return retval; +} + +static int +load_variable (char *nm, int force, istream& is) +{ +// Is there already a symbol by this name? If so, what is it? + + symbol_record *lsr = curr_sym_tab->lookup (nm, 0, 0); + + int is_undefined = 1; + int is_variable = 0; + int is_function = 0; + int is_global = 0; + + if (lsr) + { + is_undefined = ! lsr->is_defined (); + is_variable = lsr->is_variable (); + is_function = lsr->is_function (); + is_global = lsr->is_linked_to_global (); + } + +// Try to read data for this name. + + tree_constant tc; + int global = tc.load (is); + + if (tc.const_type () == tree_constant_rep::unknown_constant) + { + error ("load: unable to load variable `%s'", nm); + return 0; + } + + symbol_record *sr = 0; + + if (global) + { + if (is_global || is_undefined) + { + if (force || is_undefined) + { + lsr = curr_sym_tab->lookup (nm, 1, 0); + link_to_global_variable (lsr); + sr = lsr; + } + else + { + warning ("load: global variable name `%s' exists.", nm); + warning ("use `load -force' to overwrite"); + } + } + else if (is_function) + { + if (force) + { + lsr = curr_sym_tab->lookup (nm, 1, 0); + link_to_global_variable (lsr); + sr = lsr; + } + else + { + warning ("load: `%s' is currently a function in this scope", nm); + warning ("`load -force' will load variable and hide function"); + } + } + else if (is_variable) + { + if (force) + { + lsr = curr_sym_tab->lookup (nm, 1, 0); + link_to_global_variable (lsr); + sr = lsr; + } + else + { + warning ("load: local variable name `%s' exists.", nm); + warning ("use `load -force' to overwrite"); + } + } + else + panic_impossible (); + } + else + { + if (is_global) + { + if (force || is_undefined) + { + lsr = curr_sym_tab->lookup (nm, 1, 0); + link_to_global_variable (lsr); + sr = lsr; + } + else + { + warning ("load: global variable name `%s' exists.", nm); + warning ("use `load -force' to overwrite"); + } + } + else if (is_function) + { + if (force) + { + lsr = curr_sym_tab->lookup (nm, 1, 0); + link_to_global_variable (lsr); + sr = lsr; + } + else + { + warning ("load: `%s' is currently a function in this scope", nm); + warning ("`load -force' will load variable and hide function"); + } + } + else if (is_variable || is_undefined) + { + if (force || is_undefined) + { + lsr = curr_sym_tab->lookup (nm, 1, 0); + sr = lsr; + } + else + { + warning ("load: local variable name `%s' exists.", nm); + warning ("use `load -force' to overwrite"); + } + } + else + panic_impossible (); + } + + if (sr) + { + tree_constant *tmp_tc = new tree_constant (tc); + sr->define (tmp_tc); + return 1; + } + else + error ("load: unable to load variable `%s'", nm); + + return 0; +} + +DEFUN_TEXT ("load", Fload, Sload, -1, 1, + "load [-force] file\n +\n\ +load variables from a file") +{ + Octave_object retval; + + DEFINE_ARGV("load"); + + argc--; + argv++; + + int force = 0; + if (argc > 0 && strcmp (*argv, "-force") == 0) + { + force++; + argc--; + argv++; + } + + if (argc < 1) + { + error ("load: you must specify a single file to read"); + DELETE_ARGV; + return retval; + } + + static istream stream; + static ifstream file; + if (strcmp (*argv, "-") == 0) + { + stream = cin; + } + else + { + char *fname = tilde_expand (*argv); + file.open (fname); + if (! file) + { + error ("load: couldn't open input file `%s'", *argv); + DELETE_ARGV; + return retval; + } + stream = file; + } + + int count = 0; + char *nm = 0; + for (;;) + { +// Read name for this entry or break on EOF. + delete [] nm; + nm = extract_keyword (stream, "name"); + if (nm) + count++; + else + { + if (count == 0) + { + error ("load: no name keywords found in file `%s'", *argv); + error ("Are you sure this is an octave data file?"); + } + break; + } + + if (! *nm) + continue; + + if (! valid_identifier (nm)) + { + warning ("load: skipping bogus identifier `%s'"); + continue; + } + + load_variable (nm, force, stream); + + if (error_state) + { + error ("reading file %s", *argv); + break; + } + } + + if (file); + file.close (); + + DELETE_ARGV; + + return retval; +} + +/* + * Return nonzero if PATTERN has any special globbing chars in it. + */ +static int +glob_pattern_p (char *pattern) +{ + char *p = pattern; + char c; + int open = 0; + + while ((c = *p++) != '\0') + { + switch (c) + { + case '?': + case '*': + return 1; + + case '[': // Only accept an open brace if there is a close + open++; // brace to match it. Bracket expressions must be + continue; // complete, according to Posix.2 + + case ']': + if (open) + return 1; + continue; + + case '\\': + if (*p++ == '\0') + return 0; + + default: + continue; + } + } + + return 0; +} + +DEFUN_TEXT ("save", Fsave, Ssave, -1, 1, + "save file [var ...]\n\ +\n\ +save variables in a file") +{ + Octave_object retval; + +#if 0 + DEFINE_ARGV("save"); + + if (argc < 2) + { + print_usage ("save"); + DELETE_ARGV; + return retval; + } + + argc--; + argv++; + + static ostream stream; + static ofstream file; + if (strcmp (*argv, "-") == 0) + { +// XXX FIXME XXX -- should things intended for the screen end up in a +// tree_constant (string)? + stream = cout; + } + else if (argc == 1 && glob_pattern_p (*argv)) // Guard against things + { // like `save a*', + print_usage ("save"); // which are probably + DELETE_ARGV; // mistakes... + return retval; + } + else + { + char *fname = tilde_expand (*argv); + file.open (fname); + if (! file) + { + error ("save: couldn't open output file `%s'", *argv); + DELETE_ARGV; + return retval; + } + stream = file; + + } + + int prec = user_pref.save_precision; + + if (argc == 1) + { + int count; + char **vars = curr_sym_tab->list (count, 0, + symbol_def::USER_VARIABLE, + SYMTAB_ALL_SCOPES); + + for (int i = 0; i < count; i++) + curr_sym_tab->save (stream, vars[i], + is_globally_visible (vars[i]), prec); + + delete [] vars; + } + else + { + while (--argc > 0) + { + argv++; + + int count; + char **lvars = curr_sym_tab->list (count, 0, + symbol_def::USER_VARIABLE); + + int saved_or_error = 0; + int i; + for (i = 0; i < count; i++) + { + if (fnmatch (*argv, lvars[i], __FNM_FLAGS) == 0 + && curr_sym_tab->save (stream, lvars[i], + is_globally_visible (lvars[i]), + prec) != 0) + saved_or_error++; + } + + char **bvars = global_sym_tab->list (count, 0, + symbol_def::BUILTIN_VARIABLE); + + for (i = 0; i < count; i++) + { + if (fnmatch (*argv, bvars[i], __FNM_FLAGS) == 0 + && global_sym_tab->save (stream, bvars[i], 0, prec) != 0) + saved_or_error++; + } + + delete [] lvars; + delete [] bvars; + + if (! saved_or_error) + warning ("save: no such variable `%s'", *argv); + } + } + + if (file); + file.close (); + + DELETE_ARGV; +#endif + + return retval; +} + +DEFUN_TEXT ("who", Fwho, Swho, -1, 1, + "who [-all] [-builtins] [-functions] [-long] [-variables]\n\ +\n\ +List currently defined symbol(s). Options may be shortened to one\n\ +character, but may not be combined.") +{ + Octave_object retval; + + DEFINE_ARGV("who"); + + 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_functions = 0; + show_variables = 0; + } + + for (int i = 1; i < argc; i++) + { + argv++; + if (strcmp (*argv, "-all") == 0 || strcmp (*argv, "-a") == 0) + { + show_builtins++; + show_functions++; + show_variables++; + } + 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 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_builtins) + { + pad_after += maybe_list ("*** built-in variables:", + output_buf, show_verbose, global_sym_tab, + symbol_def::BUILTIN_VARIABLE, + SYMTAB_ALL_SCOPES); + + pad_after += maybe_list ("*** built-in functions:", + output_buf, show_verbose, global_sym_tab, + symbol_def::BUILTIN_FUNCTION, + SYMTAB_ALL_SCOPES); + } + + if (show_functions) + { + pad_after += maybe_list ("*** currently compiled functions:", + output_buf, show_verbose, global_sym_tab, + symbol_def::USER_FUNCTION, + SYMTAB_ALL_SCOPES); + } + + if (show_variables) + { + 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) + output_buf << "\n"; + + output_buf << ends; + maybe_page_output (output_buf); + + DELETE_ARGV; + + return retval; +} + +// XXX FIXME XXX -- should these really be here? + +char * +octave_home (void) +{ +#ifdef RUN_IN_PLACE + static char *home = OCTAVE_HOME; + return home; +#else + static char *home = 0; + delete [] home; + char *oh = getenv ("OCTAVE_HOME"); + if (oh) + home = strsave (oh); + else + home = strsave (OCTAVE_HOME); + return home; +#endif +} + +char * +octave_lib_dir (void) +{ +#ifdef RUN_IN_PLACE + static char *ol = OCTAVE_LIB_DIR; + return ol; +#else + static char *ol = 0; + delete [] ol; + char *oh = octave_home (); + char *tmp = strconcat (oh, "/lib/octave/"); + ol = strconcat (tmp, version_string); + delete [] tmp; + return ol; +#endif +} + +char * +octave_info_dir (void) +{ +#ifdef RUN_IN_PLACE + static char *oi = OCTAVE_INFO_DIR; + return oi; +#else + static char *oi = 0; + delete [] oi; + char *oh = octave_home (); + oi = strconcat (oh, "/info/"); + return oi; +#endif +} + +/* + * Handle OCTAVE_PATH from the environment like TeX handles TEXINPUTS. + * If the path starts with `:', prepend the standard path. If it ends + * with `:' append the standard path. If it begins and ends with + * `:', do both (which is useless, but the luser asked for it...). + * + * This function may eventually be called more than once, so be + * careful not to create memory leaks. + */ +char * +default_path (void) +{ + static char *pathstring = 0; + delete [] pathstring; + + static char *std_path = 0; + delete [] std_path; + + char *libdir = octave_lib_dir (); + + std_path = strconcat (".:", libdir); + + char *oct_path = getenv ("OCTAVE_PATH"); + + if (oct_path) + { + pathstring = strsave (oct_path); + + if (pathstring[0] == ':') + { + char *tmp = pathstring; + pathstring = strconcat (std_path, pathstring); + delete [] tmp; + } + + int tmp_len = strlen (pathstring); + if (pathstring[tmp_len-1] == ':') + { + char *tmp = pathstring; + pathstring = strconcat (pathstring, std_path); + delete [] tmp; + } + } + else + pathstring = strsave (std_path); + + return pathstring; +} + +char * +default_info_file (void) +{ + static char *info_file_string = 0; + delete [] info_file_string; + char *oct_info_file = getenv ("OCTAVE_INFO_FILE"); + if (oct_info_file) + info_file_string = strsave (oct_info_file); + else + { + char *infodir = octave_info_dir (); + info_file_string = strconcat (infodir, "/octave.info"); + } + return info_file_string; +} + +char * +default_editor (void) +{ + static char *editor_string = 0; + delete [] editor_string; + char *env_editor = getenv ("EDITOR"); + if (env_editor && *env_editor) + editor_string = strsave (env_editor); + else + editor_string = strsave ("vi"); + return editor_string; +} + +char * +get_site_defaults (void) +{ + static char *sd = 0; + delete [] sd; + char *libdir = octave_lib_dir (); + sd = strconcat (libdir, "/octaverc"); + return sd; +} + +char * +default_pager (void) +{ + static char *pager_binary = 0; + delete [] pager_binary; + char *pgr = getenv ("PAGER"); + if (pgr) + pager_binary = strsave (pgr); + else +#ifdef DEFAULT_PAGER + pager_binary = strsave (DEFAULT_PAGER); +#else + pager_binary = strsave (""); +#endif + + return pager_binary; +} + /* ;;; Local Variables: *** ;;; mode: C++ ***
--- a/src/variables.h Wed Jul 20 18:53:50 1994 +0000 +++ b/src/variables.h Wed Jul 20 19:19:08 1994 +0000 @@ -25,18 +25,42 @@ #define octave_variables_h 1 class istream; +class ostrstream; class symbol_record; class symbol_table; class tree; class tree_fvc; class tree_constant; +class Octave_object; -struct builtin_mapper_functions; -struct builtin_text_functions; -struct builtin_general_functions; -struct builtin_string_variables; +struct builtin_mapper_function; +struct builtin_function; +struct builtin_variable; + +typedef int (*sv_Function)(void); -#include "builtins.h" +struct builtin_variable +{ + char *name; + tree_constant *value; + int install_as_function; + int protect; + int eternal; + sv_Function sv_function; + char *help_string; +}; + +typedef Octave_object (*Octave_builtin_fcn)(const Octave_object&, int); + +struct builtin_function +{ + char *name; + int nargin_max; + int nargout_max; + int is_text_fcn; + Octave_builtin_fcn fcn; + char *help_string; +}; extern void initialize_symbol_tables (void); @@ -44,18 +68,17 @@ 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_mapper (builtin_mapper_function *mf); -extern void install_builtin_general_function (builtin_general_functions *gf); +extern void install_builtin_function (builtin_function *gf); -extern void install_builtin_variable (builtin_string_variables *sv); +extern void install_builtin_variable (builtin_variable *v); extern void install_builtin_variable_as_function (const char *name, tree_constant *val, int protect = 0, - int eternal = 0); + int eternal = 0, + const char *help = 0); extern void bind_nargin_and_nargout (symbol_table *sym_tab, int nargin, int nargout); @@ -63,7 +86,7 @@ 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); + const char *help = 0); extern char *builtin_string_variable (const char *); extern int builtin_real_scalar_variable (const char *, double&); @@ -83,10 +106,39 @@ extern int valid_identifier (char *); extern int identifier_exists (char *); extern int is_builtin_variable (const char *name); -extern tree_fvc *is_valid_function (tree_constant&, char *, int warn = 0); +extern tree_fvc *is_valid_function (const tree_constant&, char *, + int warn = 0); extern int takes_correct_nargs (tree_fvc *, int, char *, int warn = 0); extern char **make_name_list (void); +extern int is_text_function_name (const char *s); + +struct help_list; + +extern help_list *builtin_mapper_functions_help (void); +extern help_list *builtin_general_functions_help (void); +extern help_list *builtin_text_functions_help (void); +extern help_list *builtin_variables_help (void); + +extern int help_from_list (ostrstream& output_buf, + const help_list *list, const char *string, + int usage); + +extern void additional_help_message (ostrstream& output_buf); + +extern void print_usage (const char *s, int just_usage = 0); + +extern void install_builtin_variables (void); + +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); + // Symbol table for symbols at the top level. extern symbol_table *top_level_sym_tab;