aboutsummaryrefslogtreecommitdiffstats
path: root/repl.c
diff options
context:
space:
mode:
Diffstat (limited to 'repl.c')
-rw-r--r--repl.c551
1 files changed, 296 insertions, 255 deletions
diff --git a/repl.c b/repl.c
index ae7642f..07b357c 100644
--- a/repl.c
+++ b/repl.c
@@ -53,6 +53,11 @@ void scm_fill_freelist P((void));
# include <sys/types.h>
#endif
+#ifdef __NetBSD__
+# include <ctype.h>
+# include <unistd.h>
+#endif
+
#ifdef __OpenBSD__
# include <ctype.h>
# include <unistd.h>
@@ -143,17 +148,17 @@ char *isymnames[] = {
};
static char s_read_char[] = "read-char", s_peek_char[] = "peek-char";
-char s_read[] = "read", s_write[] = "write", s_newline[] = "newline";
+char s_write[] = "write", s_newline[] = "newline";
static char s_display[] = "display", s_write_char[] = "write-char";
static char s_freshline[] = "freshline";
static char s_eofin[] = "end of file in ";
static char s_unknown_sharp[] = "unknown # object";
-static SCM lread1 P((SCM port, int nump, char *what));
-static SCM lreadr P((SCM tok_buf, SCM port, int nump));
-static SCM lreadpr P((SCM tok_buf, SCM port, int nump));
-static SCM lreadparen P((SCM tok_buf, SCM port, int nump, char *name));
+static SCM lread1 P((SCM port, int flgs, char *what));
+static SCM lreadr P((SCM tok_buf, SCM port, int flgs));
+static SCM lreadpr P((SCM tok_buf, SCM port, int flgs));
+static SCM lreadparen P((SCM tok_buf, SCM port, int flgs, char *name));
static SCM lread_rec P((SCM tok_buf, SCM port));
static sizet read_token P((int ic, SCM tok_buf, SCM port));
static void err_head P((char *str));
@@ -256,7 +261,12 @@ taloop:
break;
}
lputs("#@", port);
+#ifdef _M_ARM
+ /* MS CLARM compiler workaround */
+ exp = CAR(MS_CLARM_dumy = exp - 1);
+#else
exp = CAR(exp-1);
+#endif
goto taloop;
default:
idef:
@@ -427,7 +437,7 @@ static int input_waiting(f)
tv.tv_usec = 0;
SYSCALL(ret = select((fileno(f) + 1), &ifds, (fd_set *) NULL,
(fd_set *) NULL, &tv););
- ASSERT(ret>=0, MAKINUM(ret), "select error", s_char_readyp);
+ ASRTER(ret>=0, MAKINUM(ret), "select error", s_char_readyp);
return FD_ISSET(fileno(f), &ifds);
# else
# ifdef FIONREAD
@@ -446,7 +456,7 @@ SCM char_readyp(port)
SCM port;
{
if UNBNDP(port) port = cur_inp;
- ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp);
+ ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp);
if (CRDYP(port) || !(BUF0 & SCM_PORTFLAGS(port))) return BOOL_T;
return input_waiting(STREAM(port)) ? BOOL_T : BOOL_F;
}
@@ -472,7 +482,7 @@ SCM wait_for_input(args)
{
SCM how_long, port1, port, ports, ans = EOL;
int timeout, pos = ARG2;
- ASSERT(!NULLP(args), INUM0, WNA, s_wfi);
+ ASRTER(!NULLP(args), INUM0, WNA, s_wfi);
how_long = CAR(args);
args = CDR(args);
if NULLP(args) port1 = cur_inp;
@@ -481,11 +491,11 @@ SCM wait_for_input(args)
args = CDR(args);
}
timeout = num2long(how_long, (char *)ARG1, s_wfi);
- ASSERT(timeout >= 0, how_long, ARG1, s_wfi);
+ ASRTER(timeout >= 0, how_long, ARG1, s_wfi);
port = port1;
ports = args;
while (1) {
- ASSERT(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)),
+ ASRTER(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)),
port, pos, s_wfi);
if (CRDYP(port) || feof(STREAM(port))) timeout = 0;
if (NULLP(ports)) break;
@@ -516,7 +526,7 @@ SCM wait_for_input(args)
ports = CDR(ports);
}
SYSCALL(ret = select(fd_max + 1, &ifds, (fd_set *)0L, (fd_set *)0L, &tv););
- ASSERT(ret>=0, MAKINUM(ret), "select error", s_wfi);
+ ASRTER(ret>=0, MAKINUM(ret), "select error", s_wfi);
port = port1;
ports = args;
@@ -538,17 +548,21 @@ SCM wait_for_input(args)
FILE *f = STREAM(port);
if (feof(f)) ans = cons(port, ans);
else {
-# ifdef FIONREAD
- long remir;
- ioctl(fileno(f), FIONREAD, &remir);
- if (remir) ans = cons(port, ans);
+# ifdef _WIN32
+ if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin))) && kbhit())
+ ans = cons(port, ans);
# else
- if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin))) && kbhit())
- ans = cons(port, ans);
+# ifdef FIONREAD
+ long remir;
+ ioctl(fileno(f), FIONREAD, &remir);
+ if (remir) ans = cons(port, ans);
+# else
+ /* If we get here this is not going to work */
+# endif
# endif
- if (NULLP(ports)) break;
- port = CAR(ports);
- ports = CDR(ports);
+ if (NULLP(ports)) break;
+ port = CAR(ports);
+ ports = CDR(ports);
}
} while (time((timet*)0L) < start);
#endif
@@ -608,7 +622,7 @@ SCM lflush(port) /* user accessible as force-output */
SCM port;
{
if UNBNDP(port) port = cur_outp;
- else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush);
+ else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush);
{
sizet i = PTOBNUM(port);
while ((ptobs[i].fflush)(STREAM(port)) &&
@@ -622,7 +636,7 @@ SCM lwrite(obj, port)
SCM obj, port;
{
if UNBNDP(port) port = cur_outp;
- else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write);
+ else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write);
iprin1(obj, port, 1);
return UNSPECIFIED;
}
@@ -630,7 +644,7 @@ SCM display(obj, port)
SCM obj, port;
{
if UNBNDP(port) port = cur_outp;
- else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display);
+ else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display);
iprin1(obj, port, 0);
return UNSPECIFIED;
}
@@ -638,7 +652,7 @@ SCM newline(port)
SCM port;
{
if UNBNDP(port) port = cur_outp;
- else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline);
+ else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline);
lputc('\n', port);
if (port==cur_outp) lfflush(port);
return UNSPECIFIED;
@@ -647,8 +661,8 @@ SCM write_char(chr, port)
SCM chr, port;
{
if UNBNDP(port) port = cur_outp;
- else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char);
- ASSERT(ICHRP(chr), chr, ARG1, s_write_char);
+ else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char);
+ ASRTER(ICHRP(chr), chr, ARG1, s_write_char);
lputc((int)ICHR(chr), port);
return UNSPECIFIED;
}
@@ -656,7 +670,7 @@ SCM scm_freshline(port)
SCM port;
{
if UNBNDP(port) port = cur_outp;
- else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_freshline);
+ else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_freshline);
if (INUM0==scm_port_col(port)) return UNSPECIFIED;
lputc('\n', port);
if (port==cur_outp) lfflush(port);
@@ -688,7 +702,7 @@ void lputs(s, port)
SCM port;
{
sizet i = PTOBNUM(port);
- ASSERT(s, INUM0, ARG1, "lputs");
+ ASRTER(s, INUM0, ARG1, "lputs");
while (EOF==(ptobs[i].fputs)(s, STREAM(port)) &&
scm_io_error(port, "fputs"))
;
@@ -775,7 +789,7 @@ void lungetc(c, port)
SCM port;
{
int i = PTOBNUM(port);
-/* ASSERT(!CRDYP(port), port, ARG2, "too many lungetc");*/
+/* ASRTER(!CRDYP(port), port, ARG2, "too many lungetc");*/
if (ptobs[i].ungetc)
(ptobs[i].ungetc)(c, port);
else {
@@ -789,7 +803,7 @@ SCM scm_read_char(port)
{
int c;
if UNBNDP(port) port = cur_inp;
- ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char);
+ ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char);
c = lgetc(port);
if (EOF==c) return EOF_VAL;
return MAKICHR(c);
@@ -799,7 +813,7 @@ SCM peek_char(port)
{
int c;
if UNBNDP(port) port = cur_inp;
- else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_peek_char);
+ else ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, s_peek_char);
c = lgetc(port);
if (EOF==c) return EOF_VAL;
lungetc(c, port);
@@ -832,187 +846,209 @@ static int flush_ws(port)
return c;
}
}
-SCM lread(port)
+
+/* Top-level readers */
+static SCM p_read_numbered, p_read_for_load, p_read;
+static char s_read[] = "read";
+static char s_read_for_load[] = "read-for-load";
+static char s_read_numbered[] = "read-numbered";
+SCM scm_read(port)
SCM port;
{
return lread1(port, 0, s_read);
}
-static SCM lread1(port, nump, what)
+
+SCM scm_read_for_load(port)
+ SCM port;
+{
+ return lread1(port, 4, s_read_for_load);
+}
+
+SCM scm_read_numbered(port)
+ SCM port;
+{
+ return lread1(port, 6, s_read_numbered);
+}
+
+static SCM lread1(port, flgs, what)
SCM port;
- int nump;
+ int flgs;
char *what;
{
int c;
SCM tok_buf;
if UNBNDP(port) port = cur_inp;
- ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, what);
+ ASRTER(NIMP(port) && OPINPORTP(port), port, ARG1, what);
do {
c = flush_ws(port);
if (EOF==c) return EOF_VAL;
lungetc(c, port);
tok_buf = makstr(30L);
- } while (EOF_VAL==(tok_buf = lreadr(tok_buf, port, nump)));
+ } while (EOF_VAL==(tok_buf = lreadr(tok_buf, port, flgs)));
return tok_buf;
}
-static SCM *loc_readsharp = 0, *loc_readsharpc = 0;
-static SCM lreadpr(tok_buf, port, nump)
+static SCM *loc_loadsharp = 0, *loc_readsharp = 0, *loc_charsharp = 0;
+static SCM lreadpr(tok_buf, port, flgs)
SCM tok_buf;
SCM port;
- int nump;
+ int flgs;
{
- int c;
- sizet j;
- SCM p;
- if (2==nump)
- return lread_rec(tok_buf, port);
-tryagain:
- c = flush_ws(port);
- switch (c) {
- case EOF: return EOF_VAL;
+ int c;
+ sizet j;
+ SCM p;
+ if (2==(3&flgs)) return lread_rec(tok_buf, port);
+ tryagain:
+ c = flush_ws(port);
+ switch (c) {
+ case EOF: return EOF_VAL;
#ifdef BRACKETS_AS_PARENS
- case '[':
+ case '[':
#endif
- case '(':
- return lreadparen(tok_buf, port, nump, s_list);
+ case '(': return lreadparen(tok_buf, port, flgs, s_list);
#ifdef BRACKETS_AS_PARENS
- case ']':
+ case ']':
#endif
- case ')': return UNDEFINED; /* goto tryagain; */
- case '\'': return cons2(i_quote,
- lreadr(tok_buf, port, nump), EOL);
- case '`': return cons2(i_quasiquote,
- lreadr(tok_buf, port, nump), EOL);
- case ',':
- c = lgetc(port);
- if ('@'==c) p = i_uq_splicing;
- else {
- lungetc(c, port);
- p = i_unquote;
- }
- return cons2(p, lreadr(tok_buf, port, nump), EOL);
- case '#':
- c = lgetc(port);
- switch (c) {
+ case ')': return UNDEFINED; /* goto tryagain; */
+ case '\'': return cons2(i_quote,
+ lreadr(tok_buf, port, flgs), EOL);
+ case '`': return cons2(i_quasiquote,
+ lreadr(tok_buf, port, flgs), EOL);
+ case ',':
+ c = lgetc(port);
+ if ('@'==c) p = i_uq_splicing;
+ else {
+ lungetc(c, port);
+ p = i_unquote;
+ }
+ return cons2(p, lreadr(tok_buf, port, flgs), EOL);
+ case '#':
+ c = lgetc(port);
+ switch (c) {
#ifdef BRACKETS_AS_PARENS
- case '[':
+ case '[':
#endif
- case '(':
- p = lreadparen(tok_buf, port, nump, s_vector);
- return NULLP(p) ? nullvect : vector(p);
- case 't': case 'T': return BOOL_T;
- case 'f': case 'F': return BOOL_F;
- case 'b': case 'B': case 'o': case 'O':
- case 'd': case 'D': case 'x': case 'X':
- case 'i': case 'I': case 'e': case 'E':
- lungetc(c, port);
- c = '#';
- goto num;
- case '*':
- j = read_token(c, tok_buf, port);
- p = istr2bve(CHARS(tok_buf)+1, (long)(j-1));
- if (NFALSEP(p)) return p;
- else goto unkshrp;
- case '\\':
- c = lgetc(port);
- j = read_token(c, tok_buf, port);
- if (j==1) return MAKICHR(c);
- if (c >= '0' && c < '8') {
- p = istr2int(CHARS(tok_buf), (long)j, 8);
- if (NFALSEP(p)) return MAKICHR(INUM(p));
- }
- for (c = 0;c<sizeof charnames/sizeof(char *);c++)
- if (charnames[c]
- && (0==strcmp(charnames[c], CHARS(tok_buf))))
- return MAKICHR(charnums[c]);
- if (loc_readsharpc && NIMP(*loc_readsharpc)) {
- resizuve(tok_buf, MAKINUM(j));
- p = apply(*loc_readsharpc, tok_buf, listofnull);
- if ICHRP(p) return p;
- }
- wta(UNDEFINED, "unknown # object: #\\", CHARS(tok_buf));
- case '|':
- j = 1; /* here j is the comment nesting depth */
-lp: c = lgetc(port);
-lpc: switch (c) {
- case EOF:
- wta(UNDEFINED, s_eofin, "balanced comment");
- case LINE_INCREMENTORS:
- default:
- goto lp;
- case '|':
- if ('#' != (c = lgetc(port))) goto lpc;
- if (--j) goto lp;
- break;
- case '#':
- if ('|' != (c = lgetc(port))) goto lpc;
- ++j; goto lp;
- }
- goto tryagain;
- default: callshrp:
- if (loc_readsharp && NIMP(*loc_readsharp)) {
- p = apply(*loc_readsharp, cons2(MAKICHR(c), port, EOL), EOL);
- if (UNSPECIFIED==p) goto tryagain;
- return p;
- }
- unkshrp: wta((SCM)MAKICHR(c), s_unknown_sharp, "");
- }
- case '\"':
- j = 0;
- while ('\"' != (c = lgetc(port))) {
- ASSERT(EOF != c, UNDEFINED, s_eofin, s_string);
- if (j+1 >= LENGTH(tok_buf)) grow_tok_buf(tok_buf);
- switch (c) {
- case LINE_INCREMENTORS: break;
- case '\\':
- switch (c = lgetc(port)) {
- case LINE_INCREMENTORS: continue;
- case '0': c = '\0'; break;
- case 'f': c = '\f'; break;
- case 'n': c = '\n'; break;
- case 'r': c = '\r'; break;
- case 't': c = '\t'; break;
- case 'a': c = '\007'; break;
- case 'v': c = '\v'; break;
- }
- }
- CHARS(tok_buf)[j] = c;
- ++j;
- }
- if (j==0) return nullstr;
- CHARS(tok_buf)[j] = 0;
- return makfromstr(CHARS(tok_buf), j);
- case DIGITS:
- case '.': case '-': case '+':
-num:
- j = read_token(c, tok_buf, port);
- p = istring2number(CHARS(tok_buf), (long)j, 10L);
- if NFALSEP(p) return p;
- if (c=='#') {
- if ((j==2) && (lgetc(port)=='(')) {
- lungetc('(', port);
- c = CHARS(tok_buf)[1];
- goto callshrp;
- }
- wta(UNDEFINED, s_unknown_sharp, CHARS(tok_buf));
- }
- goto tok;
- default:
- j = read_token(c, tok_buf, port);
-tok:
- p = intern(CHARS(tok_buf), j);
- return CAR(p);
+ case '(':
+ p = lreadparen(tok_buf, port, flgs, s_vector);
+ return NULLP(p) ? nullvect : vector(p);
+ case 't': case 'T': return BOOL_T;
+ case 'f': case 'F': return BOOL_F;
+ case 'b': case 'B': case 'o': case 'O':
+ case 'd': case 'D': case 'x': case 'X':
+ case 'i': case 'I': case 'e': case 'E':
+ lungetc(c, port);
+ c = '#';
+ goto num;
+ case '*':
+ j = read_token(c, tok_buf, port);
+ p = istr2bve(CHARS(tok_buf)+1, (long)(j-1));
+ if (NFALSEP(p)) return p;
+ else goto unkshrp;
+ case '\\':
+ c = lgetc(port);
+ j = read_token(c, tok_buf, port);
+ if (j==1) return MAKICHR(c);
+ for (c = 0;c<sizeof charnames/sizeof(char *);c++)
+ if (charnames[c]
+ && (0==strcmp(charnames[c], CHARS(tok_buf))))
+ return MAKICHR(charnums[c]);
+ if (loc_charsharp && NIMP(*loc_charsharp)) {
+ resizuve(tok_buf, MAKINUM(j));
+ p = apply(*loc_charsharp, tok_buf, listofnull);
+ if ICHRP(p) return p;
+ }
+ wta(UNDEFINED, "unknown # object: #\\", CHARS(tok_buf));
+ case '|':
+ j = 1; /* here j is the comment nesting depth */
+ lp: c = lgetc(port);
+ lpc:
+ switch (c) {
+ case EOF: wta(UNDEFINED, s_eofin, "balanced comment");
+ case LINE_INCREMENTORS:
+ default:
+ goto lp;
+ case '|':
+ if ('#' != (c = lgetc(port))) goto lpc;
+ if (--j) goto lp;
+ break;
+ case '#':
+ if ('|' != (c = lgetc(port))) goto lpc;
+ ++j; goto lp;
+ }
+ goto tryagain;
+ default: callshrp:
+ {
+ SCM reader = (3&flgs) ? p_read_numbered :
+ ((4&flgs) ? p_read_for_load : p_read);
+ SCM args = cons2(MAKICHR(c), port, cons(reader, EOL));
+ if ((4&flgs) && loc_loadsharp && NIMP(*loc_loadsharp)) {
+ p = apply(*loc_loadsharp, args, EOL);
+ if (UNSPECIFIED==p) goto tryagain;
+ return p;
+ } else if (loc_readsharp && NIMP(*loc_readsharp)) {
+ p = apply(*loc_readsharp, args, EOL);
+ if (UNSPECIFIED==p) goto tryagain;
+ return p;
}
+ }
+ unkshrp: wta((SCM)MAKICHR(c), s_unknown_sharp, "");
+ }
+ case '\"':
+ j = 0;
+ while ('\"' != (c = lgetc(port))) {
+ ASRTER(EOF != c, UNDEFINED, s_eofin, s_string);
+ if (j+1 >= LENGTH(tok_buf)) grow_tok_buf(tok_buf);
+ switch (c) {
+ case LINE_INCREMENTORS: break;
+ case '\\':
+ switch (c = lgetc(port)) {
+ case LINE_INCREMENTORS: continue;
+ case '0': c = '\0'; break;
+ case 'f': c = '\f'; break;
+ case 'n': c = '\n'; break;
+ case 'r': c = '\r'; break;
+ case 't': c = '\t'; break;
+ case 'a': c = '\007'; break;
+ case 'v': c = '\v'; break;
+ }
+ }
+ CHARS(tok_buf)[j] = c;
+ ++j;
+ }
+ if (j==0) return nullstr;
+ CHARS(tok_buf)[j] = 0;
+ return makfromstr(CHARS(tok_buf), j);
+ case DIGITS:
+ case '.': case '-': case '+':
+ num:
+ j = read_token(c, tok_buf, port);
+ p = istring2number(CHARS(tok_buf), (long)j, 10L);
+ if NFALSEP(p) return p;
+ if (c=='#') {
+ if ((j==2) && (lgetc(port)=='(')) {
+ lungetc('(', port);
+ c = CHARS(tok_buf)[1];
+ goto callshrp;
+ }
+ wta(UNDEFINED, s_unknown_sharp, CHARS(tok_buf));
+ }
+ goto tok;
+ default:
+ j = read_token(c, tok_buf, port);
+ tok:
+ p = intern(CHARS(tok_buf), j);
+ return CAR(p);
+ }
}
-static SCM lreadr(tok_buf, port, nump)
+static SCM lreadr(tok_buf, port, flgs)
SCM tok_buf;
SCM port;
- int nump;
+ int flgs;
{
- SCM ans = lreadpr(tok_buf, port, nump);
+ SCM ans = lreadpr(tok_buf, port, flgs);
switch (ans) {
case UNDEFINED:
scm_warn("unexpected \")\"", "", port);
- return lreadpr(tok_buf, port, nump);
+ return lreadpr(tok_buf, port, flgs);
}
return ans;
}
@@ -1026,8 +1062,8 @@ static SCM lread_rec(tok_buf, port)
default:
lungetc(c, port);
line = scm_port_line(port);
- form = lreadpr(tok_buf, port, 1);
- if (NFALSEP(line) && NIMP(form) &&
+ form = lreadpr(tok_buf, port, 5);
+ if (NFALSEP(line) && NIMP(form) &&
(CONSP(form) || VECTORP(form))) {
return cons(SCM_MAKE_LINUM(INUM(line)), form);
}
@@ -1076,26 +1112,37 @@ static sizet read_token(ic, tok_buf, port)
_Pragma("opt"); /* # pragma _CRI opt */
#endif
-static SCM lreadparen(tok_buf, port, nump, name)
+/* flgs was originally an argument to determine whether a read was */
+/* top-level or recursve. It has been overloaded to determine also */
+/* what to do in the case of a recursive read. */
+/* It distinguishes four states: */
+/* 0 - not adding line-numbers - never changes. Uses READ:SHARP */
+/* 4 - not adding line-numbers - never changes. Uses LOAD:SHARP */
+/* 5 - top level read when adding line-numbers. Uses LOAD:SHARP */
+/* 6 - recursive read when adding line-numbers. Uses LOAD:SHARP */
+
+static SCM lreadparen(tok_buf, port, flgs, name)
SCM tok_buf;
SCM port;
- int nump;
+ int flgs;
char *name;
{
- SCM lst, fst, tmp = lreadpr(tok_buf, port, nump ? 2 : 0);
+ SCM lst, fst,
+ tmp = lreadpr(tok_buf, port, (4&flgs) | ((3&flgs) ? 2 : 0));
if (UNDEFINED==tmp) return EOL;
if (i_dot==tmp) {
- fst = lreadr(tok_buf, port, nump ? 1 : 0);
+ fst = lreadr(tok_buf, port, (4&flgs) | ((3&flgs) ? 1 : 0));
closeit:
tmp = lreadpr(tok_buf, port, 0);
if (UNDEFINED != tmp) wta(UNDEFINED, "missing close paren", name);
return fst;
}
fst = lst = cons(tmp, EOL);
- while (UNDEFINED != (tmp = lreadpr(tok_buf, port, nump ? 2 : 0))) {
+ while (UNDEFINED !=
+ (tmp = lreadpr(tok_buf, port, (4&flgs) | ((3&flgs) ? 2 : 0)))) {
if (EOF_VAL==tmp) wta(lst, s_eofin, s_list);
if (i_dot==tmp) {
- CDR(lst) = lreadr(tok_buf, port, nump ? 1 : 0);
+ CDR(lst) = lreadr(tok_buf, port, (4&flgs) | ((3&flgs) ? 1 : 0));
goto closeit;
}
lst = (CDR(lst) = cons(tmp, EOL));
@@ -1111,7 +1158,7 @@ SCM swapcar(pair, value)
SCM pair, value;
{
SCM ret;
- ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_swapcar);
+ ASRTER(NIMP(pair) && CONSP(pair), pair, ARG1, s_swapcar);
DEFER_INTS;
ret = CAR(pair);
CAR(pair) = value;
@@ -1124,7 +1171,7 @@ long tc16_arbiter;
SCM tryarb(arb)
SCM arb;
{
- ASSERT((TYP16(arb)==tc16_arbiter), arb, ARG1, s_tryarb);
+ ASRTER((TYP16(arb)==tc16_arbiter), arb, ARG1, s_tryarb);
DEFER_INTS;
if (CAR(arb) & (1L<<16))
arb = BOOL_F;
@@ -1138,7 +1185,7 @@ SCM tryarb(arb)
SCM relarb(arb)
SCM arb;
{
- ASSERT((TYP16(arb)==tc16_arbiter), arb, ARG1, s_relarb);
+ ASRTER((TYP16(arb)==tc16_arbiter), arb, ARG1, s_relarb);
if (!(CAR(arb) & (1L<<16))) return BOOL_F;
CAR(arb) = tc16_arbiter;
return BOOL_T;
@@ -1226,7 +1273,7 @@ int handle_it(i)
if NIMP(proc) { /* Save environment stack, in case it
moves when applying proc. Do an ecache gc
to protect contents of stack. */
-
+
SCM estk, *estk_ptr, env, env_tmp;
DEFER_INTS;
#ifndef NO_ENV_CACHE
@@ -1254,40 +1301,6 @@ int handle_it(i)
}
return errmsgs[i-WNA].parent_err;
}
-static char s_eval_string[] = "eval-string";
-static char s_load_string[] = "load-string";
-static SCM i_eval_string = 0;
-SCM scm_eval_string(str)
- SCM str;
-{
- SCM env = EOL;
-#ifdef SCM_ENV_FILENAME
- if (i_eval_string)
- env = scm_env_addprop(SCM_ENV_FILENAME, i_eval_string, env);
-#endif
- str = mkstrport(INUM0, str, OPN | RDNG, s_eval_string);
- str = lread(str);
- return EVAL(str, env, EOL);
-}
-static SCM i_load_string = 0;
-SCM scm_load_string(str)
- SCM str;
-{
- SCM env = EOL;
-#ifdef SCM_ENV_FILENAME
- if (i_load_string)
- env = scm_env_addprop(SCM_ENV_FILENAME, i_load_string, env);
-#endif
- ASSERT(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1,
- s_load_string);
- str = mkstrport(INUM0, str, OPN | RDNG, s_load_string);
- while(1) {
- SCM form = lread(str);
- if (EOF_VAL==form) break;
- SIDEVAL(form, env, EOL);
- }
- return BOOL_T;
-}
SCM exitval = MAKINUM(EXIT_FAILURE); /* INUM return value */
extern char s_unexec[];
@@ -1423,7 +1436,7 @@ SCM scm_port_line(port)
SCM port;
{
sizet lnum;
- ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_line);
+ ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_line);
if (! (TRACKED & SCM_PORTFLAGS(port))) return BOOL_F;
lnum = scm_port_table[SCM_PORTNUM(port)].line;
switch (CGETUN(port)) {
@@ -1441,7 +1454,7 @@ SCM scm_port_col(port)
SCM port;
{
long col;
- ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_col);
+ ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_col);
if (! (TRACKED & SCM_PORTFLAGS(port))) return BOOL_F;
col = scm_port_table[SCM_PORTNUM(port)].col;
switch (CGETUN(port)) {
@@ -1461,7 +1474,7 @@ SCM scm_port_filename(port)
SCM port;
{
SCM x;
- ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_filename);
+ ASRTER(NIMP(port) && PORTP(port), port, ARG1, s_port_filename);
x = SCM_PORTDATA(port);
if (NIMP(x) && STRINGP(x))
return SCM_PORTDATA(port);
@@ -1672,7 +1685,7 @@ SCM repl()
scm_env_work = scm_ecache_index - scm_ecache_len;
scm_egcs = scm_clo_moved = scm_stk_moved = 0;
lmallocated = mallocated;
- x = lread(cur_inp);
+ x = scm_read_for_load(cur_inp);
rt = INUM(my_time());
scm_gcs = 0;
gc_time_taken = 0;
@@ -1732,7 +1745,7 @@ SCM abrt()
char s_restart[] = "restart";
SCM restart()
{
- /* ASSERT(!dumped, UNDEFINED, "dumped can't", s_restart); */
+ /* ASRTER(!dumped, UNDEFINED, "dumped can't", s_restart); */
longjump(CONT(rootcont)->jmpbuf, COOKIE(-3));
}
@@ -1741,8 +1754,8 @@ char s_unexec[] = "unexec";
SCM scm_unexec(newpath)
SCM newpath;
{
- ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec);
- ASSERT(execpath, UNSPECIFIED, s_no_execpath, s_unexec);
+ ASRTER(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec);
+ ASRTER(execpath, UNSPECIFIED, s_no_execpath, s_unexec);
*loc_errobj = newpath;
longjump(CONT(rootcont)->jmpbuf, COOKIE(-4));
}
@@ -1796,20 +1809,10 @@ void ints_warn(str1, str2, fname, linum)
}
#endif
-#ifdef CAUTIOUS
-static SCM f_read_numbered;
-static char s_read_numbered[] = "read-numbered";
-SCM scm_read_numbered(port)
- SCM port;
-{
- return lread1(port, 2, s_read_numbered);
-}
-#endif
-
SCM tryload(filename, reader)
SCM filename, reader;
{
- ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load);
+ ASRTER(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load);
if (FALSEP(reader)) reader = UNDEFINED;
#ifndef RECKLESS
if (!UNBNDP(reader)) scm_arity_check(reader, 1L, s_load);
@@ -1828,7 +1831,7 @@ SCM tryload(filename, reader)
#endif
while(1) {
if (UNBNDP(reader))
- form = lread(port);
+ form = scm_read_for_load(port);
else
form = scm_cvapply(reader, 1L, &port);
if (EOF_VAL==form) break;
@@ -1840,6 +1843,40 @@ SCM tryload(filename, reader)
}
return BOOL_T;
}
+static char s_eval_string[] = "eval-string";
+static char s_load_string[] = "load-string";
+static SCM i_eval_string = 0;
+SCM scm_eval_string(str)
+ SCM str;
+{
+ SCM env = EOL;
+#ifdef SCM_ENV_FILENAME
+ if (i_eval_string)
+ env = scm_env_addprop(SCM_ENV_FILENAME, i_eval_string, env);
+#endif
+ str = mkstrport(INUM0, str, OPN | RDNG, s_eval_string);
+ str = scm_read(str);
+ return EVAL(str, env, EOL);
+}
+static SCM i_load_string = 0;
+SCM scm_load_string(str)
+ SCM str;
+{
+ SCM env = EOL;
+#ifdef SCM_ENV_FILENAME
+ if (i_load_string)
+ env = scm_env_addprop(SCM_ENV_FILENAME, i_load_string, env);
+#endif
+ ASRTER(NIMP(str) && (STRINGP(str) || SYMBOLP(str)), str, ARG1,
+ s_load_string);
+ str = mkstrport(INUM0, str, OPN | RDNG, s_load_string);
+ while(1) {
+ SCM form = scm_read_for_load(str);
+ if (EOF_VAL==form) break;
+ SIDEVAL(form, env, EOL);
+ }
+ return BOOL_T;
+}
void scm_line_msg(file, linum, port)
SCM file, linum, port;
@@ -1925,7 +1962,7 @@ static char s_perror[] = "perror";
SCM lperror(arg)
SCM arg;
{
- ASSERT(NIMP(arg) && STRINGP(arg), arg, ARG1, s_perror);
+ ASRTER(NIMP(arg) && STRINGP(arg), arg, ARG1, s_perror);
err_head(CHARS(arg));
return UNSPECIFIED;
}
@@ -1984,9 +2021,10 @@ static void def_err_response()
err_pos = 0;
if (!UNBNDP(obj))
if (reset_safeport(sys_safep, 55, cur_errp))
- if (0==setjmp(SAFEP_JMPBUF(sys_safep)))
+ if (0==setjmp(SAFEP_JMPBUF(sys_safep))) {
if (codep) scm_princode(obj, EOL, sys_safep, writing);
else iprin1(obj, sys_safep, writing);
+ }
if UNBNDP(err_exp) goto getout;
if NIMP(err_exp) {
if (reset_safeport(sys_safep, 55, cur_errp))
@@ -2079,7 +2117,7 @@ SCM set_inp(port)
SCM port;
{
SCM oinp;
- ASSERT(NIMP(port) && INPORTP(port), port, ARG1, s_cur_inp);
+ ASRTER(NIMP(port) && INPORTP(port), port, ARG1, s_cur_inp);
DEFER_INTS;
oinp = cur_inp;
cur_inp = port;
@@ -2090,7 +2128,7 @@ SCM set_outp(port)
SCM port;
{
SCM ooutp;
- ASSERT(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_outp);
+ ASRTER(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_outp);
DEFER_INTS;
ooutp = cur_outp;
cur_outp = port;
@@ -2101,7 +2139,7 @@ SCM set_errp(port)
SCM port;
{
SCM oerrp;
- ASSERT(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_errp);
+ ASRTER(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_errp);
DEFER_INTS;
oerrp = cur_errp;
cur_errp = port;
@@ -2112,7 +2150,7 @@ static char s_isatty[] = "isatty?";
SCM l_isatty(port)
SCM port;
{
- ASSERT(NIMP(port) && OPPORTP(port), port, ARG1, s_isatty);
+ ASRTER(NIMP(port) && OPPORTP(port), port, ARG1, s_isatty);
if (tc16_fport != TYP16(port)) return BOOL_F;
return isatty(fileno(STREAM(port)))?BOOL_T:BOOL_F;
}
@@ -2144,7 +2182,6 @@ static iproc subr1s[] = {
{0, 0}};
static iproc subr1os[] = {
- {s_read, lread},
{s_read_char, scm_read_char},
{s_peek_char, peek_char},
{s_newline, newline},
@@ -2177,21 +2214,24 @@ void init_repl( iverbose )
i_repl = CAR(sysintern("repl", UNDEFINED));
loc_errobj = &CDR(sysintern("errobj", UNDEFINED));
loc_loadpath = &CDR(sysintern("*load-pathname*", BOOL_F));
+ loc_loadsharp = &CDR(sysintern("load:sharp", UNDEFINED));
loc_readsharp = &CDR(sysintern("read:sharp", UNDEFINED));
- loc_readsharpc = &CDR(sysintern("read:sharp-char", UNDEFINED));
+ loc_charsharp = &CDR(sysintern("char:sharp", UNDEFINED));
loc_broken_pipe = &CDR(sysintern("broken-pipe", UNDEFINED));
scm_verbose = iverbose;
init_iprocs(subr0s, tc7_subr_0);
init_iprocs(subr1os, tc7_subr_1o);
init_iprocs(subr1s, tc7_subr_1);
init_iprocs(subr2os, tc7_subr_2o);
-#ifdef CAUTIOUS
- f_read_numbered =
- make_subr(s_read_numbered, tc7_subr_1, scm_read_numbered);
-#endif
add_feature(s_char_readyp);
make_subr(s_swapcar, tc7_subr_2, swapcar);
make_subr(s_wfi, tc7_lsubr, wait_for_input);
+ p_read_numbered =
+ make_subr(s_read_numbered, tc7_subr_1, scm_read_numbered);
+ p_read_for_load =
+ make_subr(s_read_for_load, tc7_subr_1, scm_read_for_load);
+ p_read =
+ make_subr(s_read, tc7_subr_1o, scm_read);
i_eval_string = CAR(sysintern(s_eval_string, UNDEFINED));
i_load_string = CAR(sysintern(s_load_string, UNDEFINED));
#ifdef CAN_DUMP
@@ -2214,6 +2254,7 @@ void init_repl( iverbose )
}
void final_repl()
{
+ i_eval_string = i_load_string = 0;
loc_errobj = (SCM *)&tmp_errobj;
loc_loadpath = (SCM *)&tmp_loadpath;
loadports = EOL;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-22 06:48:04 +0000