Mercurial > hg > octave-nkf
changeset 444:ba637cc5c5f3
[project @ 1994-06-02 17:15:07 by jwe]
author | jwe |
---|---|
date | Thu, 02 Jun 1994 17:15:07 +0000 |
parents | 25570b554bca |
children | 98a165f6e6c5 |
files | src/builtins.cc src/file-io.cc src/file-io.h src/g-builtins.cc src/g-builtins.h src/sysdep.cc src/sysdep.h src/utils.h |
diffstat | 8 files changed, 577 insertions(+), 51 deletions(-) [+] |
line wrap: on
line diff
--- a/src/builtins.cc +++ b/src/builtins.cc @@ -39,6 +39,7 @@ #include "tree.h" #include "help.h" #include "pager.h" +#include "sysdep.h" #include "mappers.h" #include "variables.h" #include "user-prefs.h" @@ -304,6 +305,16 @@ { "fclose", 2, 1, builtin_fclose, "fclose (\"filename\" or filenum): close a file", }, + { "feof", 3, 1, builtin_feof, + "eof = feof (filenum)\n\n\ + Returns a non zero eof for an end of file condition for the\n\ + file specified by \"filenum\" from fopen", }, + + { "ferror", 3, 1, builtin_ferror, + "error = ferror (filenum)\n\n\ + Returns a non zero \"error\" for an error condition on the\n\ + file specified by \"filenum\" from fopen", }, + { "feval", -1, 1, builtin_feval, "feval (\"name\", args, ...): evaluate first argument as function", }, @@ -336,6 +347,17 @@ { "fprintf", -1, 1, builtin_fprintf, "fprintf (\"file\", \"fmt\", ...)", }, + { "fread", 3, 1, builtin_fread, + "[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", }, + { "freport", 1, 1, builtin_freport, "freport (): list open files and their status", }, @@ -390,6 +412,16 @@ { "ftell", 2, 1, builtin_ftell, "position = ftell (\"filename\" or filenum): returns the current file position", }, + { "fwrite", 3, 1, builtin_fwrite, + "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", }, + { "getenv", 2, 1, builtin_getenv, "getenv (\"string\"): get environment variable values", }, @@ -397,7 +429,6 @@ "G = givens (x, y): compute orthogonal matrix G = [c s; -conj (s) c]\n\ such that G [x; y] = [*; 0] (x, y scalars)\n\n\ [c, s] = givens (x, y) returns the (c, s) values themselves.", }, - { "hess", 2, 2, builtin_hess, "[P, H] = hess (A) or H = hess (A): Hessenberg decomposition", }, @@ -898,50 +929,17 @@ tmp = new tree_constant (2.0); bind_builtin_variable ("stderr", tmp, 1, 1); -// If using 1.0 / 0.0 doesn't work, you might also try using a very -// large constant like 1.0e100000. - -#if defined (HAVE_ISINF) || defined (HAVE_FINITE) -#ifdef linux - double tmp_inf = HUGE_VAL; -#else - double tmp_inf = 1.0 / 0.0; -#endif - - tmp = new tree_constant (tmp_inf); + tmp = new tree_constant (octave_Inf); bind_builtin_variable ("Inf", tmp, 1, 1); - tmp = new tree_constant (tmp_inf); + tmp = new tree_constant (octave_Inf); bind_builtin_variable ("inf", tmp, 1, 1); -#else - -// This is sort of cheesy, but what can we do, other than blowing it -// off completely, or writing an entire IEEE emulation package? - - tmp = new tree_constant (DBL_MAX); - bind_builtin_variable ("Inf", tmp, 1, 1); - - tmp = new tree_constant (DBL_MAX); - bind_builtin_variable ("inf", tmp, 1, 1); -#endif - -// If 0.0 / 0.0 fails to produce a NaN, you might also try -// something like Inf / Inf. - -#if defined (HAVE_ISNAN) -#ifdef linux - double tmp_nan = NAN; -#else - double tmp_nan = 0.0 / 0.0; -#endif - - tmp = new tree_constant (tmp_nan); + tmp = new tree_constant (octave_NaN); bind_builtin_variable ("NaN", tmp, 1, 1); - tmp = new tree_constant (tmp_nan); + tmp = new tree_constant (octave_NaN); bind_builtin_variable ("nan", tmp, 1, 1); -#endif } int
--- a/src/file-io.cc +++ b/src/file-io.cc @@ -31,10 +31,13 @@ #include <unistd.h> #include <string.h> #include <stdio.h> +#include <errno.h> #include <stdlib.h> #include <strstream.h> #include <ctype.h> +#include "Matrix.h" + #include "statdefs.h" #include "file-io.h" #include "input.h" @@ -43,6 +46,8 @@ #include "error.h" #include "utils.h" #include "pager.h" +#include "sysdep.h" +#include "mappers.h" // keeps a count of how many files are open and in the file list static int file_count = 0; @@ -66,6 +71,9 @@ FILE *fptr (void) const; const char *mode (void) const; + int eof (void) const; + int error (void) const; + private: int file_number; char *file_name; @@ -159,6 +167,10 @@ file_count = 3; } +/* + * Given a file name or number, return a pointer to the corresponding + * open file. If the file has not already been opened, return NULL. + */ Pix return_valid_file (const tree_constant& arg) { @@ -1196,6 +1208,382 @@ } /* + * Find out how many elements are left. + * + * size is the size of the elements + * nr is the number of rows or columns in the matrix + */ +static long +get_whats_left (FILE *fptr, int size, int nn) +{ + long curr_pos = ftell (fptr); + + fseek (fptr, 0, SEEK_END); + long end_of_file = ftell (fptr); + + fseek (fptr, end_of_file, SEEK_SET); + + long len = end_of_file - curr_pos; + + long num_items = len / size / nn; + + if (len > num_items * size * nn) + num_items++; + + return num_items; +} + +static void +get_size_conv (const char *preci, int& size, Matrix::conversion& conv, + const char *warn) +{ +// Get type and number of bytes per element to read. + + char *prec = strdup (preci); + char *ip = prec; + + while (*ip > 0) + { + tolower (*ip); + ip++; + } + + if (strcmp (prec, "uchar") == 0) + { + size = 1; + conv = Matrix::CNV_UCHAR; + } + else if (strcmp (prec, "char") == 0) + { + size = 1; + conv = Matrix::CNV_CHAR; + } + else if (strcmp (prec, "schar") == 0) + { + size = 1; + conv = Matrix::CNV_CHAR; +// Some systems may need this?? +// size = 1; +// conv = CNV_SCHAR; + } + else if (strcmp (prec, "short") == 0) + { + size = 2; + conv = Matrix::CNV_SHORT; + } + else if (strcmp (prec, "ushort") == 0) + { + size = 2; + conv = Matrix::CNV_USHORT; + } + else if (strcmp (prec, "int") == 0) + { + size = 4; + conv = Matrix::CNV_INT; + } + else if (strcmp (prec, "uint") == 0) + { + size = 4; + conv = Matrix::CNV_UINT; + } + else if (strcmp (prec, "long") == 0) + { + size = 4; + conv = Matrix::CNV_LONG; + } + else if (strcmp (prec, "ulong") == 0) + { + size = 4; + conv = Matrix::CNV_ULONG; + } + else if (strcmp (prec, "float") == 0) + { + size = 4; + conv = Matrix::CNV_FLOAT; + } + else if (strcmp (prec, "double") == 0) + { + size = 8; + conv = Matrix::CNV_DOUBLE; + } + else + { + error ("%s: precision: \'%s\' unknown", warn, prec); + size = -1; + conv = Matrix::CNV_UNKNOWN; + } + + delete [] prec; + + return; +} + +/* + * Read binary data from a file. + * + * [data, count] = fread (fid, size, 'precision') + * + * fid : the file id from fopen + * size : the size of the matrix or vector or scaler to read + * + * n : reads n elements of a column vector + * inf : reads to the end of file (default) + * [m, n] : reads enough elements to fill the matrix + * the number of columns can be inf + * + * precision : type of the element. Can be: + * + * char, uchar, schar, short, ushort, int, uint, + * long, ulong, float, double + * + * Default is uchar. + * + * data : output data + * count : number of elements read + */ +tree_constant * +fread_internal (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + + Pix p = file_io_get_file (args[1], "r", "fread"); + + if (p == (Pix) NULL) + return retval; + +// Get type and number of bytes per element to read. + char *prec = "uchar"; + if (nargin > 3) + { + if (args[3].is_string_type ()) + prec = args[3].string_value (); + else + { + error ("fread: precision must be a specified as a string"); + return retval; + } + } + + int size; + Matrix::conversion conv; + get_size_conv (prec, size, conv, "fread"); + if (size < 0) + return retval; + +// Get file info. + file_info file = file_list (p); + FILE * fptr = file.fptr (); + +// Set up matrix to read into. If specified in arguments use that +// number, otherwise read everyting left in file. + + double dnr = 1.0; + double dnc = 1.0; + int nr = 1; + int nc = 1; + + if (nargin > 2) + { +// tree_constant tmpa = args[2].make_numeric (); // ?? + + if (args[2].is_scalar_type ()) + { + tree_constant tmpa = args[2].make_numeric (); + + dnr = 1.0; + dnc = tmpa.double_value (); + } + else if (args[2].is_matrix_type ()) + { +// tree_constant tmpa = args[2].make_numeric (); // ?? + Matrix tmpm = args[2].to_matrix (); + nr = tmpm.rows (); + nc = tmpm.columns (); + + if(nr != 1 || nc > 2) + { + error ("fread: Illegal size specification\n"); + print_usage ("fread"); + return retval; + } + dnr = tmpm.elem (0, 0); + dnc = tmpm.elem (0, 1); + } + + if ((xisinf (dnr)) && (xisinf (dnc))) + { + error ("fread: number of rows and columns cannot both be infinite\n"); + return retval; + } + + if (xisinf (dnr)) + { + nc = NINT (dnc); + nr = get_whats_left (fptr, size, nc); + } + else if (xisinf (dnc)) + { + nr = NINT (dnr); + nc = get_whats_left (fptr, size, nr); + } + else + { + nr = NINT (dnr); + nc = NINT (dnc); + } + } + else + { +// No size parameter, read what's left of the file. + nr = 1; + nc = get_whats_left (fptr, size, nr); + } + + Matrix m (nr, nc, octave_NaN); + +// Read data. + + int count = m.read (fptr, size, conv); + + if (nargout > 1) + { + retval = new tree_constant[3]; + retval[1] = tree_constant ((double) count); + } + else + retval = new tree_constant[2]; + + retval[0] = tree_constant (m); + + return retval; +} + +/* + * Write binary data to a file. + * + * count = fwrite (fid, data, 'precision') + * + * fid : file id from fopen + * Data : data to be written + * precision : type of output element. Can be: + * + * char, uchar, schar, short, ushort, int, uint, + * long, float, double + * + * Default is uchar. + * + * count : the number of elements written + */ +tree_constant * +fwrite_internal (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + + Pix p = file_io_get_file (args[1], "a+", "fwrite"); + + if (p == (Pix) NULL) + return retval; + +// Get type and number of bytes per element to read. + char *prec = "uchar"; + if (nargin > 3) + { + if (args[3].is_string_type ()) + prec = args[3].string_value (); + else + { + error ("fwrite: precision must be a specified as a string"); + return retval; + } + } + + int size; + Matrix::conversion conv; + get_size_conv(prec, size, conv, "fwrite"); + if (size < 0) + return retval; + +// Get file info. + file_info file = file_list (p); + +// Write the matrix data. + tree_constant tmpa = args[2].make_numeric (); + + Matrix tmpm = tmpa.to_matrix (); + + int count = tmpm.write (file.fptr(), size, conv); + + retval = new tree_constant[2]; + retval[0] = tree_constant ((double) count); + + return retval; +} + +/* + * Check for an EOF condition on a file opened by fopen. + * + * eof = feof (fid) + * + * fid : file id from fopen + * eof : non zero for an end of file condition + */ +tree_constant * +feof_internal (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + +// Get file info. + Pix p = return_valid_file (args[1]); + + if (p == (Pix) NULL) + return retval; + + file_info file = file_list (p); + + retval = new tree_constant[2]; + retval[0] = tree_constant (feof (file.fptr ())); + + return retval; +} + +/* + * Check for an error condition on a file opened by fopen. + * + * [message, errnum] = ferror (fid) + * + * fid : file id from fopen + * message : system error message + * errnum : error number + */ +tree_constant * +ferror_internal (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + +// Get file info. + Pix p = return_valid_file (args[1]); + + if (p == (Pix) NULL) + return retval; + + file_info file = file_list (p); + + int ierr = ferror (file.fptr ()); + + if (nargout > 1) + { + retval = new tree_constant[3]; + retval[1] = tree_constant ((double) ierr); + } + else + retval = new tree_constant[2]; + + retval[0] = tree_constant (strsave (strerror (ierr))); + + return retval; +} + +/* ;;; Local Variables: *** ;;; mode: C++ *** ;;; page-delimiter: "^/\\*" ***
--- a/src/file-io.h +++ b/src/file-io.h @@ -33,13 +33,21 @@ extern Pix return_valid_file (const tree_constant& arg); extern tree_constant *fclose_internal (const tree_constant *args); +extern tree_constant *feof_internal (const tree_constant *args, + int nargin, int nargout); +extern tree_constant *ferror_internal (const tree_constant *args, + int nargin, int nargout); extern tree_constant *fflush_internal (const tree_constant *args); extern tree_constant *fgets_internal (const tree_constant *args, int nargout); extern tree_constant *fopen_internal (const tree_constant *args); +extern tree_constant *fread_internal (const tree_constant *args, + int nargin, int nargout); extern tree_constant *freport_internal (void); extern tree_constant *frewind_internal (const tree_constant *args); extern tree_constant *fseek_internal (const tree_constant *args, int nargin); extern tree_constant *ftell_internal (const tree_constant *args); +extern tree_constant *fwrite_internal (const tree_constant *args, + int nargin, int nargout); extern void initialize_file_io (void);
--- a/src/g-builtins.cc +++ b/src/g-builtins.cc @@ -582,6 +582,38 @@ } /* + * Check file for EOF condition. + */ +tree_constant * +builtin_feof (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + + if (nargin < 1) + print_usage ("feof"); + else + retval = feof_internal (args, nargin, nargout); + + return retval; +} + +/* + * Check file for error condition. + */ +tree_constant * +builtin_ferror (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + + if (nargin < 1) + print_usage ("ferror"); + else + retval = ferror_internal (args, nargin, nargout); + + return retval; +} + +/* * Evaluate first argument as a function. */ tree_constant * @@ -598,7 +630,7 @@ } /* - * Flushing output to a file + * Flushing output to a file. */ tree_constant * builtin_fflush (const tree_constant *args, int nargin, int nargout) @@ -614,7 +646,7 @@ } /* - * Fast Fourier Transform + * Fast Fourier Transform. */ tree_constant * builtin_fft (const tree_constant *args, int nargin, int nargout) @@ -634,7 +666,7 @@ } /* - * get a string from a file + * Get a string from a file. */ tree_constant * builtin_fgets (const tree_constant *args, int nargin, int nargout) @@ -721,7 +753,23 @@ } /* - * rewind a file + * Read binary data from a file. + */ +tree_constant * +builtin_fread (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + + if (nargin < 2) + print_usage ("fread"); + else + retval = fread_internal (args, nargin, nargout); + + return retval; +} + +/* + * Rewind a file. */ tree_constant * builtin_frewind (const tree_constant *args, int nargin, int nargout) @@ -737,7 +785,7 @@ } /* - * report on open files + * Report on open files. */ tree_constant * builtin_freport (const tree_constant *args, int nargin, int nargout) @@ -769,7 +817,7 @@ } /* - * seek a point in a file for reading and/or writing + * Seek a point in a file for reading and/or writing. */ tree_constant * builtin_fseek (const tree_constant *args, int nargin, int nargout) @@ -851,7 +899,7 @@ } /* - * tell current position of file + * Tell current position of file. */ tree_constant * builtin_ftell (const tree_constant *args, int nargin, int nargout) @@ -867,6 +915,22 @@ } /* + * Write binary data to a file. + */ +tree_constant * +builtin_fwrite (const tree_constant *args, int nargin, int nargout) +{ + tree_constant *retval = NULL_TREE_CONST; + + if (nargin < 3) + print_usage ("fwrite"); + else + retval = fwrite_internal (args, nargin, nargout); + + return retval; +} + +/* * Get the value of an environment variable. */ tree_constant * @@ -890,7 +954,7 @@ } /* - * Inverse Fast Fourier Transform + * Inverse Fast Fourier Transform. */ tree_constant * builtin_ifft (const tree_constant *args, int nargin, int nargout) @@ -1721,7 +1785,7 @@ } /* - * Schur Decomposition + * Schur Decomposition. */ tree_constant * builtin_schur (const tree_constant *args, int nargin, int nargout) @@ -1738,7 +1802,7 @@ } /* - * Givens rotation + * Givens rotation. */ tree_constant * builtin_givens (const tree_constant *args, int nargin, int nargout) @@ -1754,7 +1818,7 @@ } /* - * Hessenberg Decomposition + * Hessenberg Decomposition. */ tree_constant * builtin_hess (const tree_constant *args, int nargin, int nargout)
--- a/src/g-builtins.h +++ b/src/g-builtins.h @@ -58,6 +58,8 @@ extern tree_constant *builtin_expm (const tree_constant *, int, int); extern tree_constant *builtin_eye (const tree_constant *, int, int); extern tree_constant *builtin_fclose (const tree_constant *, int, int); +extern tree_constant *builtin_feof (const tree_constant *, int, int); +extern tree_constant *builtin_ferror (const tree_constant *, int, int); extern tree_constant *builtin_feval (const tree_constant *, int, int); extern tree_constant *builtin_fflush (const tree_constant *, int, int); extern tree_constant *builtin_fft (const tree_constant *, int, int); @@ -66,6 +68,7 @@ extern tree_constant *builtin_flops (const tree_constant *, int, int); extern tree_constant *builtin_fopen (const tree_constant *, int, int); extern tree_constant *builtin_fprintf (const tree_constant *, int, int); +extern tree_constant *builtin_fread (const tree_constant *, int, int); extern tree_constant *builtin_frewind (const tree_constant *, int, int); extern tree_constant *builtin_freport (const tree_constant *, int, int); extern tree_constant *builtin_fscanf (const tree_constant *, int, int); @@ -75,6 +78,7 @@ extern tree_constant *builtin_fsqp (const tree_constant *, int, int); extern tree_constant *builtin_fsqp_options (const tree_constant *, int, int); extern tree_constant *builtin_ftell (const tree_constant *, int, int); +extern tree_constant *builtin_fwrite (const tree_constant *, int, int); extern tree_constant *builtin_getenv (const tree_constant *, int, int); extern tree_constant *builtin_givens (const tree_constant *, int, int); extern tree_constant *builtin_hess (const tree_constant *, int, int); @@ -86,7 +90,8 @@ extern tree_constant *builtin_keyboard (const tree_constant *, int, int); extern tree_constant *builtin_logm (const tree_constant *, int, int); extern tree_constant *builtin_lpsolve (const tree_constant *, int, int); -extern tree_constant *builtin_lpsolve_options (const tree_constant *, int, int); +extern tree_constant *builtin_lpsolve_options (const tree_constant *, + int, int); extern tree_constant *builtin_lsode (const tree_constant *, int, int); extern tree_constant *builtin_lsode_options (const tree_constant *, int, int); extern tree_constant *builtin_lu (const tree_constant *, int, int);
--- a/src/sysdep.cc +++ b/src/sysdep.cc @@ -28,6 +28,13 @@ #include <stdlib.h> #include "error.h" +#include "sysdep.h" + +// Octave's idea of infinity. +double octave_Inf; + +// Octave's idea of not a number. +double octave_NaN; #if defined (__386BSD__) && defined (HAVE_FLOATINGPOINT_H) #include <floatingpoint.h> @@ -58,6 +65,53 @@ } #endif +static void +octave_ieee_init (void) +{ +#if defined (HAVE_ISINF) || defined (HAVE_FINITE) + +// Some version of gcc on some old version of Linux used to crash when +// trying to make Inf and NaN. + +#if defined (HAVE_INFINITY) + octave_Inf = infinity (); +#else +#ifdef linux + octave_Inf = HUGE_VAL; +#else + double tmp = 1e+10; + octave_Inf = tmp; + for (;;) + { + octave_Inf *= 1e+10; + if (octave_Inf == tmp) + break; + tmp = octave_Inf; + } +#endif +#endif + +#if defined (HAVE_QUIET_NAN) + octave_NaN = quiet_nan (); +#else +#ifdef linux + octave_NaN = NAN; +#else + octave_NaN = octave_Inf / octave_Inf; +#endif +#endif + +#else + +// This is sort of cheesy, but what can we do, other than blowing it +// off completely, or writing an entire IEEE emulation package? + + octave_Inf = DBL_MAX; + octave_NaN = DBL_MAX; + +#endif +} + void sysdep_init (void) { @@ -69,6 +123,8 @@ #ifdef NeXT NeXT_init (); #endif + + octave_ieee_init (); } /*
--- a/src/sysdep.h +++ b/src/sysdep.h @@ -26,6 +26,12 @@ extern void sysdep_init (void); +// Octave's idea of infinity. +extern double octave_Inf; + +// Octave's idea of not a number. +extern double octave_NaN; + #endif /*
--- a/src/utils.h +++ b/src/utils.h @@ -79,7 +79,8 @@ extern int keyword_almost_match (const char **std, int *min_len, const char *s, int min_toks_to_match, int max_toks); -extern char **get_fcn_file_names (int& ffl_len, const char *dir, int no_suffix); +extern char **get_fcn_file_names (int& ffl_len, const char *dir, + int no_suffix); extern char **get_fcn_file_names (int& ffl_len, int no_suffix); extern int NINT (double x); extern double D_NINT (double x);