diff --git a/src/c/backq.d b/src/c/backq.d index 4c4384135..deede61d3 100644 --- a/src/c/backq.d +++ b/src/c/backq.d @@ -257,7 +257,7 @@ cl_object comma_reader(cl_object in, cl_object c) if (backq_level <= 0) FEerror("A comma has appeared out of a backquote.", 0); - c = peek_char(FALSE, in); + c = cl_peek_char(0); /* Read character but skip spaces & complain at EOF */ if (c == CODE_CHAR('@@')) { x = @'si::,@'; read_char(in); diff --git a/src/c/file.d b/src/c/file.d index 361622cfc..165fc9d17 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -23,6 +23,7 @@ #include #include "machines.h" +#include "internal.h" #if defined(BSD) && !defined(MSDOS) #include diff --git a/src/c/load.d b/src/c/load.d index 80d740175..1a128e201 100644 --- a/src/c/load.d +++ b/src/c/load.d @@ -90,7 +90,6 @@ si_load_source(cl_object source, cl_object verbose, cl_object print) bds_bind(@'*standard-input*', strm); for (;;) { cl_object bytecodes = Cnil; - preserving_whitespace_flag = FALSE; detect_eos_flag = TRUE; x = read_object_non_recursive(strm); if (x == OBJNULL) diff --git a/src/c/read.d b/src/c/read.d index 176ca5926..a8f0ac1df 100644 --- a/src/c/read.d +++ b/src/c/read.d @@ -26,7 +26,6 @@ cl_object standard_readtable; #ifndef THREADS -bool preserving_whitespace_flag; bool escape_flag; cl_object delimiting_char; bool detect_eos_flag; @@ -55,24 +54,6 @@ unread_char(cl_object c, cl_object in) unreadc_stream(char_code(c), in); } -/* - peek_char corresponds to COMMON Lisp function PEEK-CHAR. - When pt is TRUE, preceeding whitespaces are ignored. -*/ -cl_object -peek_char(bool pt, cl_object in) -{ - int c; - cl_object rtbl = ecl_current_readtable(); - - c = readc_stream(in); - if (pt) - while (cat(rtbl, c) == cat_whitespace) - c = readc_stream(in); - unreadc_stream(c, in); - return CODE_CHAR(c); -} - static cl_object patch_sharp(cl_object x); cl_object @@ -175,9 +156,7 @@ BEGIN: /* Colon has appeared twice. */ } if (a == cat_whitespace || a == cat_terminating) { - if (preserving_whitespace_flag || - cat(rtbl, c) != cat_whitespace) - unreadc_stream(c, in); + unreadc_stream(c, in); break; } cl_string_push_extend(cl_token, c); @@ -883,8 +862,7 @@ sharp_colon_reader(cl_object in, cl_object ch, cl_object d) if (a == cat_whitespace || a == cat_terminating) break; } - if (preserving_whitespace_flag || cat(rtbl, c) != cat_whitespace) - unreadc_stream(c, in); + unreadc_stream(c, in); M: if (read_suppress) @@ -1314,13 +1292,12 @@ stream_or_default_input(cl_object stream) @(defun read (&optional (strm Cnil) (eof_errorp Ct) eof_value - recursivep - &aux x) + recursivep) + cl_object x; @ strm = stream_or_default_input(strm); detect_eos_flag = TRUE; if (Null(recursivep)) { - preserving_whitespace_flag = FALSE; x = read_object_non_recursive(strm); } else { x = read_object(strm); @@ -1330,6 +1307,19 @@ stream_or_default_input(cl_object stream) @(return eof_value) FEend_of_file(strm); } + /* Skip whitespace characters, but stop at beginning of new line or token */ + if (Null(recursivep)) { + cl_object rtbl = ecl_current_readtable(); + while (!stream_at_end(strm)) { + int c = readc_stream(strm); + if (c == '\n') + break; + if (cat(rtbl, c) != cat_whitespace) { + unreadc_stream(c, strm); + break; + } + } + } @(return x) @) @@ -1344,7 +1334,6 @@ stream_or_default_input(cl_object stream) strm = stream_or_default_input(strm); detect_eos_flag = TRUE; if (Null(recursivep)) { - preserving_whitespace_flag = TRUE; x = read_object_non_recursive(strm); } else { x = read_object(strm); @@ -1363,7 +1352,6 @@ do_read_delimited_list(cl_object d, cl_object strm) cl_object l, x, *p; l = Cnil; p = &l; - preserving_whitespace_flag = FALSE; /* necessary? */ for (;;) { delimiting_char = d; x = read_object(strm); @@ -1754,7 +1742,6 @@ si_string_to_object(cl_object x) assert_type_string(x); in = make_string_input_stream(x, 0, x->string.fillp); - preserving_whitespace_flag = FALSE; detect_eos_flag = FALSE; x = read_object(in); @(return x) diff --git a/src/c/unixsys.d b/src/c/unixsys.d index e54e9a686..6f4b85a98 100644 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -17,6 +17,7 @@ #include #include "ecl.h" #include "machines.h" +#include "internal.h" cl_object si_system(cl_object cmd) diff --git a/src/h/external.h b/src/h/external.h index 692409f04..b83696991 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -1037,7 +1037,6 @@ extern bool detect_eos_flag; #endif extern cl_object read_char(cl_object in); extern void unread_char(cl_object c, cl_object in); -extern cl_object peek_char(bool pt, cl_object in); extern cl_object read_object_non_recursive(cl_object in); extern cl_object read_object(cl_object in); extern cl_object parse_number(const char *s, cl_index end, cl_index *ep, int radix); diff --git a/src/h/internal.h b/src/h/internal.h index c0a97816a..f99228cce 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -34,6 +34,21 @@ extern const struct { short type; } all_functions[]; +/* file.d */ + +/* + * POSIX specifies that the "b" flag is ignored. This is good, because + * under MSDOS and Apple's OS we need to open text files in binary mode, + * so that we get both the carriage return and the linefeed characters. + * Otherwise, it would be complicated to implement file-position and + * seek operations. + */ +#define OPEN_R "rb" +#define OPEN_W "wb" +#define OPEN_RW "w+b" +#define OPEN_A "ab" +#define OPEN_RA "a+b" +#define CRLF /* print.d */ diff --git a/src/h/machines.h b/src/h/machines.h index efcd29ca9..f5e5b8ff4 100755 --- a/src/h/machines.h +++ b/src/h/machines.h @@ -47,22 +47,6 @@ # define PATH_SEPARATOR ':' #endif /* MSDOS */ -#if defined(MSDOS) || defined(cygwin) || defined(darwin) -# define OPEN_R "rb" -# define OPEN_W "wb" -# define OPEN_RW "w+b" -# define OPEN_A "ab" -# define OPEN_RA "a+b" -# define CRLF -#else -# define OPEN_R "r" -# define OPEN_W "w" -# define OPEN_RW "w+" -# define OPEN_A "a" -# define OPEN_RA "a+" -#endif /* MSDOS */ - - /*********************************************************************** Architectural features: