aboutsummaryrefslogtreecommitdiffstats
path: root/repl.c
diff options
context:
space:
mode:
Diffstat (limited to 'repl.c')
-rw-r--r--repl.c647
1 files changed, 395 insertions, 252 deletions
diff --git a/repl.c b/repl.c
index 20be8b1..ae7642f 100644
--- a/repl.c
+++ b/repl.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1990-1999 Free Software Foundation, Inc.
+/* Copyright (C) 1990-2002 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -15,26 +15,26 @@
* the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
*
* As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * for additional uses of the text contained in its release of SCM.
*
- * The exception is that, if you link the GUILE library with other files
+ * The exception is that, if you link the SCM library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
+ * linking the SCM library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE. If you copy
+ * Free Software Foundation under the name SCM. If you copy
* code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
+ * SCM, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
- * If you write modifications of your own for GUILE, it is your choice
+ * If you write modifications of your own for SCM, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
@@ -53,6 +53,15 @@ void scm_fill_freelist P((void));
# include <sys/types.h>
#endif
+#ifdef __OpenBSD__
+# include <ctype.h>
+# include <unistd.h>
+#endif
+
+#ifdef PLAN9
+# include <ctype.h>
+#endif
+
#ifdef ARM_ULIB
# include <termio.h>
int set_erase()
@@ -62,7 +71,7 @@ int set_erase()
ioctl(0, TCGETA, &tin);
tin.c_cc[VERASE] = '\010';
- ioctl(0, TCSETA,&tin);
+ ioctl(0, TCSETA, &tin);
return(0);
}
#endif
@@ -122,8 +131,11 @@ char *isymnames[] = {
/* NUM_ISPCSYMS ISPCSYMS here */
"#@and", "#@begin", "#@case", "#@cond", "#@do", "#@if", "#@lambda",
"#@let", "#@let*", "#@letrec", "#@or", "#@quote", "#@set!",
- "#@define", "#@apply", "#@farloc-car", "#@farloc-cdr", "#@delay",
- "#@quasiquote", "#@unquote", "#@unquote-splicing", "#@else", "#@=>",
+ "#@funcall", "#@apply", "#@farloc-car", "#@farloc-cdr", "#@delay",
+ "#@quasiquote", "#@eval-for-apply", "#@let-syntax", "#@acro-call",
+ "#<line>", "#@define",
+ "#@unquote", "#@unquote-splicing", "#@else", "#@=>", "#@values-token",
+ "#@keyword",
/* user visible ISYMS */
/* other keywords */
/* Flags */
@@ -138,9 +150,13 @@ static char s_freshline[] = "freshline";
static char s_eofin[] = "end of file in ";
static char s_unknown_sharp[] = "unknown # object";
-static SCM lreadr P((SCM tok_buf, SCM port));
-static SCM lreadparen P((SCM tok_buf, SCM port, char *name));
+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 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));
void intprint(n, radix, port)
long n;
@@ -196,7 +212,7 @@ void iprlist(hdr, exp, tlr, port, writing)
void iprin1(exp, port, writing)
SCM exp;
SCM port;
-int writing;
+ int writing;
{
register long i;
taloop:
@@ -219,6 +235,11 @@ taloop:
intprint(i, -8, port);
else lputc((int)i, port);
}
+ else if (SCM_LINUMP(exp)) {
+ lputs("#<line ", port);
+ intprint(SCM_LINUM(exp), -10, port);
+ lputc('>', port);
+ }
else if (IFLAGP(exp) && (ISYMNUM(exp)<(sizeof isymnames/sizeof(char *))))
lputs(ISYMCHARS(exp), port);
else if ILOCP(exp) {
@@ -247,14 +268,29 @@ taloop:
break;
}
switch TYP7(exp) {
+ case (127 & IM_LET):
+ if (CAR(exp) != IM_LET) {
+ lputs("(#@call ", port);
+ exp = CDR(exp);
+ iprin1(CAR(exp), port, writing);
+ iprlist(" ", CAR(CDR(exp)), ')', port, writing);
+ break;
+ }
+ /* else fall through */
+ case (127 & IM_AND): case (127 & IM_BEGIN): case (127 & IM_CASE):
+ case (127 & IM_COND): case (127 & IM_DO): case (127 & IM_IF):
+ case (127 & IM_LAMBDA): case (127 & IM_LETSTAR):
+ case (127 & IM_LETREC): case (127 & IM_OR): case (127 & IM_QUOTE):
+ case (127 & IM_SET): case (127 & IM_FUNCALL):
+ case tcs_cons_inum:
+ case tcs_cons_iloc:
+ case tcs_cons_chflag:
case tcs_cons_gloc:
- case tcs_cons_imcar:
case tcs_cons_nimcar:
iprlist("(", exp, ')', port, writing);
break;
case tcs_closures:
- exp = CODE(exp);
- iprlist("#<CLOSURE ", exp, '>', port, writing);
+ scm_princlosure(exp, port, writing);
break;
case tc7_string:
if (writing) {
@@ -363,7 +399,9 @@ static int input_waiting(f)
# else
# ifndef macintosh
# ifndef ARM_ULIB
-# include <sys/ioctl.h>
+# ifndef PLAN9
+# include <sys/ioctl.h>
+# endif
# endif
# endif
# endif
@@ -408,7 +446,7 @@ SCM char_readyp(port)
SCM port;
{
if UNBNDP(port) port = cur_inp;
- else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp);
+ ASSERT(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;
}
@@ -417,7 +455,11 @@ SCM char_readyp(port)
# include <pc.h>
#endif
#ifndef HAVE_SELECT
-# include <time.h>
+# ifdef PLAN9
+# define kbhit() 0
+# else
+# include <time.h>
+# endif
#endif
#ifdef __STDC__
# define timet time_t
@@ -520,11 +562,46 @@ SCM eof_objectp(x)
return (EOF_VAL==x) ? BOOL_T : BOOL_F;
}
+static SCM *loc_broken_pipe = 0;
+/* returning non-zero means try again. */
+int scm_io_error(port, what)
+ SCM port;
+ char *what;
+{
+#ifdef HAVE_PIPE
+# ifdef EPIPE
+ if (EPIPE==errno) {
+ if (verbose > 2) {
+ err_head("WARNING");
+ lputs(";;", cur_errp);
+ lputs(what, cur_errp);
+ lputs(": closing pipe ", cur_errp);
+ iprin1(port, cur_errp, 1);
+ newline(cur_errp);
+ }
+ close_port(port);
+ if (*loc_broken_pipe && NIMP(*loc_broken_pipe))
+ apply(*loc_broken_pipe, port, listofnull);
+ return 0;
+ }
+# endif
+#endif
+ if (SCM_INTERRUPTED(errno)) {
+ errno = 0;
+ return !0;
+ }
+ wta(port, what, "Input/Output");
+ return 0; /* squelch warning */
+}
+
+static char s_fflush[] = "fflush";
void lfflush(port) /* internal SCM call */
SCM port;
{
sizet i = PTOBNUM(port);
- (ptobs[i].fflush)(STREAM(port));
+ while ((ptobs[i].fflush)(STREAM(port)) &&
+ scm_io_error(port, s_fflush))
+ ;
}
static char s_flush[] = "force-output";
SCM lflush(port) /* user accessible as force-output */
@@ -534,7 +611,9 @@ SCM lflush(port) /* user accessible as force-output */
else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush);
{
sizet i = PTOBNUM(port);
- SYSCALL((ptobs[i].fflush)(STREAM(port)););
+ while ((ptobs[i].fflush)(STREAM(port)) &&
+ scm_io_error(port, s_fflush))
+ ;
return UNSPECIFIED;
}
}
@@ -545,11 +624,6 @@ SCM lwrite(obj, port)
if UNBNDP(port) port = cur_outp;
else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write);
iprin1(obj, port, 1);
-#ifdef HAVE_PIPE
-# ifdef EPIPE
- if (EPIPE==errno) close_port(port);
-# endif
-#endif
return UNSPECIFIED;
}
SCM display(obj, port)
@@ -558,11 +632,6 @@ SCM display(obj, port)
if UNBNDP(port) port = cur_outp;
else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display);
iprin1(obj, port, 0);
-#ifdef HAVE_PIPE
-# ifdef EPIPE
- if (EPIPE==errno) close_port(port);
-# endif
-#endif
return UNSPECIFIED;
}
SCM newline(port)
@@ -571,13 +640,7 @@ SCM newline(port)
if UNBNDP(port) port = cur_outp;
else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_newline);
lputc('\n', port);
-#ifdef HAVE_PIPE
-# ifdef EPIPE
- if (EPIPE==errno) close_port(port);
- else
-# endif
-#endif
- if (port==cur_outp) lfflush(port);
+ if (port==cur_outp) lfflush(port);
return UNSPECIFIED;
}
SCM write_char(chr, port)
@@ -587,11 +650,6 @@ SCM write_char(chr, port)
else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write_char);
ASSERT(ICHRP(chr), chr, ARG1, s_write_char);
lputc((int)ICHR(chr), port);
-#ifdef HAVE_PIPE
-# ifdef EPIPE
- if (EPIPE==errno) close_port(port);
-# endif
-#endif
return UNSPECIFIED;
}
SCM scm_freshline(port)
@@ -601,13 +659,7 @@ SCM scm_freshline(port)
else ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_freshline);
if (INUM0==scm_port_col(port)) return UNSPECIFIED;
lputc('\n', port);
-#ifdef HAVE_PIPE
-# ifdef EPIPE
- if (EPIPE==errno) close_port(port);
- else
-# endif
-#endif
- if (port==cur_outp) lfflush(port);
+ if (port==cur_outp) lfflush(port);
return UNSPECIFIED;
}
@@ -616,13 +668,15 @@ void lputc(c, port)
SCM port;
{
sizet i = PTOBNUM(port);
- SYSCALL((ptobs[i].fputc)(c, STREAM(port)););
+ while (EOF==(ptobs[i].fputc)(c, STREAM(port)) &&
+ scm_io_error(port, "fputc"))
+ ;
if (CRDY & CAR(port)) {
i = SCM_PORTNUM(port);
switch (c) {
case LINE_INCREMENTORS:
scm_port_table[i].line++;
- scm_port_table[i].col = 0;
+ scm_port_table[i].col = 1;
break;
default:
scm_port_table[i].col++;
@@ -635,7 +689,9 @@ void lputs(s, port)
{
sizet i = PTOBNUM(port);
ASSERT(s, INUM0, ARG1, "lputs");
- SYSCALL((ptobs[i].fputs)(s, STREAM(port)););
+ while (EOF==(ptobs[i].fputs)(s, STREAM(port)) &&
+ scm_io_error(port, "fputs"))
+ ;
if (CRDY & CAR(port)) {
sizet j;
i = SCM_PORTNUM(port);
@@ -643,7 +699,7 @@ void lputs(s, port)
switch (s[j]) {
case LINE_INCREMENTORS:
scm_port_table[i].line++;
- scm_port_table[i].col = 0;
+ scm_port_table[i].col = 1;
break;
default:
scm_port_table[i].col++;
@@ -658,8 +714,9 @@ sizet lfwrite(ptr, size, nitems, port)
SCM port;
{
sizet ret, i = PTOBNUM(port);
- SYSCALL(ret = (ptobs[i].fwrite)
- (ptr, size, nitems, STREAM(port)););
+ do {
+ ret = (ptobs[i].fwrite)(ptr, size, nitems, STREAM(port));
+ } while(nitems != ret && scm_io_error(port, "fwrite"));
if (CRDY & CAR(port)) {
sizet j;
i = SCM_PORTNUM(port);
@@ -667,7 +724,7 @@ sizet lfwrite(ptr, size, nitems, port)
switch (ptr[j]) {
case LINE_INCREMENTORS:
scm_port_table[i].line++;
- scm_port_table[i].col = 0;
+ scm_port_table[i].col = 1;
break;
default:
scm_port_table[i].col++;
@@ -682,7 +739,7 @@ int lgetc(port)
{
FILE *f;
int c;
- sizet i, j;
+ int i, j = -1;
if (CRDY & CAR(port)) {
j = SCM_PORTNUM(port);
c = scm_port_table[j].unread;
@@ -699,12 +756,13 @@ int lgetc(port)
#else
SYSCALL(c = (ptobs[i].fgetc)(f););
#endif
- if (CRDY & CAR(port)) { /* CRDY overloaded !!*/
+ if (j > -1) {
+ /* This means that CRDY is set, note that CRDY is overloaded */
switch (c) {
case LINE_INCREMENTORS:
scm_port_table[j].line++;
scm_port_table[j].colprev = scm_port_table[j].col;
- scm_port_table[j].col = 0;
+ scm_port_table[j].col = 1;
break;
default:
scm_port_table[j].col++;
@@ -716,9 +774,14 @@ void lungetc(c, port)
int c;
SCM port;
{
+ int i = PTOBNUM(port);
/* ASSERT(!CRDYP(port), port, ARG2, "too many lungetc");*/
- scm_port_table[SCM_PORTNUM(port)].unread = c;
- CAR(port) |= CRDY;
+ if (ptobs[i].ungetc)
+ (ptobs[i].ungetc)(c, port);
+ else {
+ scm_port_table[SCM_PORTNUM(port)].unread = c;
+ CAR(port) |= CRDY;
+ }
}
SCM scm_read_char(port)
@@ -726,7 +789,7 @@ SCM scm_read_char(port)
{
int c;
if UNBNDP(port) port = cur_inp;
- else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char);
+ ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read_char);
c = lgetc(port);
if (EOF==c) return EOF_VAL;
return MAKICHR(c);
@@ -772,26 +835,36 @@ static int flush_ws(port)
SCM lread(port)
SCM port;
{
+ return lread1(port, 0, s_read);
+}
+static SCM lread1(port, nump, what)
+ SCM port;
+ int nump;
+ char *what;
+{
int c;
SCM tok_buf;
if UNBNDP(port) port = cur_inp;
- else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_read);
+ ASSERT(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)));
+ } while (EOF_VAL==(tok_buf = lreadr(tok_buf, port, nump)));
return tok_buf;
}
static SCM *loc_readsharp = 0, *loc_readsharpc = 0;
-static SCM lreadpr(tok_buf, port)
+static SCM lreadpr(tok_buf, port, nump)
SCM tok_buf;
SCM port;
+ int nump;
{
int c;
sizet j;
SCM p;
+ if (2==nump)
+ return lread_rec(tok_buf, port);
tryagain:
c = flush_ws(port);
switch (c) {
@@ -800,13 +873,15 @@ tryagain:
case '[':
#endif
case '(':
- return lreadparen(tok_buf, port, s_list);
+ return lreadparen(tok_buf, port, nump, s_list);
#ifdef BRACKETS_AS_PARENS
case ']':
#endif
case ')': return UNDEFINED; /* goto tryagain; */
- case '\'': return cons2(i_quote, lreadr(tok_buf, port), EOL);
- case '`': return cons2(i_quasiquote, lreadr(tok_buf, port), EOL);
+ 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;
@@ -814,7 +889,7 @@ tryagain:
lungetc(c, port);
p = i_unquote;
}
- return cons2(p, lreadr(tok_buf, port), EOL);
+ return cons2(p, lreadr(tok_buf, port, nump), EOL);
case '#':
c = lgetc(port);
switch (c) {
@@ -822,7 +897,7 @@ tryagain:
case '[':
#endif
case '(':
- p = lreadparen(tok_buf, port, s_vector);
+ 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;
@@ -928,18 +1003,42 @@ tok:
return CAR(p);
}
}
-static SCM lreadr(tok_buf, port)
+static SCM lreadr(tok_buf, port, nump)
SCM tok_buf;
SCM port;
+ int nump;
{
- SCM ans = lreadpr(tok_buf, port);
+ SCM ans = lreadpr(tok_buf, port, nump);
switch (ans) {
case UNDEFINED:
- scm_warn("unexpected \")\"", "");
- return lreadpr(tok_buf, port);
+ scm_warn("unexpected \")\"", "", port);
+ return lreadpr(tok_buf, port, nump);
}
return ans;
}
+static SCM lread_rec(tok_buf, port)
+ SCM tok_buf;
+ SCM port;
+{
+ SCM line, form;
+ int c = flush_ws(port);
+ switch(c) {
+ default:
+ lungetc(c, port);
+ line = scm_port_line(port);
+ form = lreadpr(tok_buf, port, 1);
+ if (NFALSEP(line) && NIMP(form) &&
+ (CONSP(form) || VECTORP(form))) {
+ return cons(SCM_MAKE_LINUM(INUM(line)), form);
+ }
+ return form;
+#ifdef BRACKETS_AS_PARENS
+ case ']':
+#endif
+ case ')': return UNDEFINED;
+ case EOF: return EOF_VAL;
+ }
+}
#ifdef _UNICOS
_Pragma("noopt"); /* # pragma _CRI noopt */
@@ -977,25 +1076,26 @@ static sizet read_token(ic, tok_buf, port)
_Pragma("opt"); /* # pragma _CRI opt */
#endif
-static SCM lreadparen(tok_buf, port, name)
+static SCM lreadparen(tok_buf, port, nump, name)
SCM tok_buf;
SCM port;
+ int nump;
char *name;
{
- SCM lst, fst, tmp = lreadpr(tok_buf, port);
+ SCM lst, fst, tmp = lreadpr(tok_buf, port, nump ? 2 : 0);
if (UNDEFINED==tmp) return EOL;
if (i_dot==tmp) {
- fst = lreadr(tok_buf, port);
+ fst = lreadr(tok_buf, port, nump ? 1 : 0);
closeit:
- tmp = lreadpr(tok_buf, port);
+ 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))) {
+ while (UNDEFINED != (tmp = lreadpr(tok_buf, port, nump ? 2 : 0))) {
if (EOF_VAL==tmp) wta(lst, s_eofin, s_list);
if (i_dot==tmp) {
- CDR(lst) = lreadr(tok_buf, port);
+ CDR(lst) = lreadr(tok_buf, port, nump ? 1 : 0);
goto closeit;
}
lst = (CDR(lst) = cons(tmp, EOL));
@@ -1006,6 +1106,18 @@ static SCM lreadparen(tok_buf, port, name)
/* These procedures implement synchronization primitives. Processors
with an atomic test-and-set instruction can use it here (and not
DEFER_INTS). */
+char s_swapcar[] = "swap-car!";
+SCM swapcar(pair, value)
+ SCM pair, value;
+{
+ SCM ret;
+ ASSERT(NIMP(pair) && CONSP(pair), pair, ARG1, s_swapcar);
+ DEFER_INTS;
+ ret = CAR(pair);
+ CAR(pair) = value;
+ ALLOW_INTS;
+ return ret;
+}
char s_tryarb[] = "try-arbiter";
char s_relarb[] = "release-arbiter";
long tc16_arbiter;
@@ -1074,16 +1186,17 @@ struct errdesc errmsgs[] = {
void (* deferred_proc) P((void)) = 0;
char *errjmp_bad = "init";
int ints_disabled = 1;
-static int errjmp_recursive = 0;
unsigned long SIG_deferred = 0;
-SCM err_exp, err_env;
-char *err_pos, *err_s_subr;
-cell tmp_errobj = {(SCM)UNDEFINED, (SCM)EOL};
-cell tmp_loadpath = {(SCM)BOOL_F, (SCM)EOL};
-SCM *loc_errobj = (SCM *)&tmp_errobj;
-SCM *loc_loadpath = (SCM *)&tmp_loadpath;
int scm_verbose = 1; /* Low so that monitor info won't be */
/* printed while in init_storage. (BOOM) */
+static int errjmp_recursive = 0;
+static int errobj_codep;
+static SCM err_exp, err_env;
+static char *err_pos, *err_s_subr;
+static cell tmp_errobj = {(SCM)UNDEFINED, (SCM)EOL};
+static cell tmp_loadpath = {(SCM)BOOL_F, (SCM)EOL};
+SCM *loc_errobj = (SCM *)&tmp_errobj;
+SCM *loc_loadpath = (SCM *)&tmp_loadpath;
long cells_allocated = 0, lcells_allocated = 0,
mallocated = 0, lmallocated = 0,
rt = 0, gc_rt, gc_time_taken;
@@ -1113,6 +1226,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
@@ -1142,23 +1256,35 @@ int handle_it(i)
}
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, (SCM)EOL);
+ 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, EOL);
+ SIDEVAL(form, env, EOL);
}
return BOOL_T;
}
@@ -1191,10 +1317,10 @@ SCM scm_top_level(initpath, toplvl_fun)
SCM proc = CDR(intern(name, (sizet)strlen(name)));
if NIMP(proc) apply(proc, EOL, EOL);
}}
- if ((i = errmsgs[i-WNA].parent_err)) goto drloop;
+ i = errmsgs[i-WNA].parent_err;
+ if (i) goto drloop;
case 1: /* from everr() */
def_err_response();
- dowinds(EOL);
goto reset_toplvl;
case 0:
exitval = MAKINUM(EXIT_SUCCESS);
@@ -1205,6 +1331,7 @@ SCM scm_top_level(initpath, toplvl_fun)
SIG_deferred = 0;
deferred_proc = 0;
ints_disabled = 0;
+ scm_init_INITS();
if (dumped) {
lcells_allocated = cells_allocated;
lmallocated = mallocated;
@@ -1224,13 +1351,13 @@ SCM scm_top_level(initpath, toplvl_fun)
}
case -2: /* abrt */
reset_toplvl:
- dowinds(EOL);
ints_disabled = 1;
errjmp_bad = (char *)0;
errjmp_recursive = 0;
lflush(sys_errp);
SIG_deferred = 0;
deferred_proc = 0;
+ gc_hook_active = 0;
scm_estk_reset(0);
/* Closing the loading file turned out to be a bad idea. */
@@ -1249,12 +1376,12 @@ SCM scm_top_level(initpath, toplvl_fun)
*loc_loadpath = BOOL_F;
loadports = EOL;
ints_disabled = 0;
+ dowinds(EOL);
ret = toplvl_fun(); /* typically repl() */
if INUMP(ret) exitval = ret;
err_pos = (char *)EXIT;
i = EXIT;
goto drloop; /* encountered EOF on stdin */
- def_err_response();
case -1: /* quit */
dowinds(EOL);
if (MAKINUM(EXIT_SUCCESS) != exitval) {
@@ -1301,6 +1428,7 @@ SCM scm_port_line(port)
lnum = scm_port_table[SCM_PORTNUM(port)].line;
switch (CGETUN(port)) {
default:
+ case EOF: /* no ungetted char */
break;
case LINE_INCREMENTORS:
lnum--;
@@ -1312,7 +1440,7 @@ static char s_port_col[] = "port-column";
SCM scm_port_col(port)
SCM port;
{
- short col;
+ long col;
ASSERT(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;
@@ -1320,6 +1448,8 @@ SCM scm_port_col(port)
default:
col--;
break;
+ case EOF: /* no ungetted char */
+ break;
case LINE_INCREMENTORS:
col = scm_port_table[SCM_PORTNUM(port)].colprev;
break;
@@ -1344,15 +1474,13 @@ SCM prog_args()
}
extern char s_heap[];
-extern sizet hplim_ind;
-extern CELLPTR *hplims;
void growth_mon(obj, size, units, grewp)
char *obj;
long size;
char *units;
int grewp;
{
- if (verbose>2)
+ if (verbose > 2)
{
lputs((grewp ? "; grew " : "; shrank "), sys_errp);
lputs(obj, sys_errp);
@@ -1360,18 +1488,18 @@ void growth_mon(obj, size, units, grewp)
intprint(size, -10, sys_errp);
lputc(' ', sys_errp);
lputs(units, sys_errp);
- if ((verbose>4) && (obj==s_heap)) heap_report();
- lputs("\n", sys_errp);
+ if ((verbose > 4) && (obj==s_heap)) heap_report();
+ lputs("\n; ", sys_errp);
}
}
void gc_start(what)
char *what;
{
- if (verbose>3 && FPORTP(cur_errp)) {
+ if (verbose > 4) {
lputs(";GC(", sys_errp);
lputs(what, sys_errp);
- lputs(")", sys_errp);
+ lputs(") ", sys_errp);
}
scm_gcs++;
gc_rt = INUM(my_time());
@@ -1384,10 +1512,9 @@ void gc_end()
{
gc_rt = INUM(my_time()) - gc_rt;
gc_time_taken = gc_time_taken + gc_rt;
- if (verbose>3) {
- if (!FPORTP(cur_errp)) lputs(";GC ", sys_errp);
+ if (verbose > 4) {
intprint(time_in_msec(gc_rt), -10, sys_errp);
- lputs(" cpu mSec, ", sys_errp);
+ lputs(".ms cpu, ", sys_errp);
intprint(gc_cells_collected, -10, sys_errp);
lputs(" cells, ", sys_errp);
intprint(gc_malloc_collected, -10, sys_errp);
@@ -1410,21 +1537,21 @@ void scm_egc_end()
}
void repl_report()
{
- if (verbose>1) {
+ if (verbose > 2) {
lfflush(cur_outp);
lputs(";Evaluation took ", cur_errp);
intprint(time_in_msec(INUM(my_time())-rt), -10, cur_errp);
- lputs(" mSec (", cur_errp);
+ lputs(".ms (", cur_errp);
intprint(time_in_msec(gc_time_taken), -10, cur_errp);
- lputs(" in gc) ", cur_errp);
+ lputs(".ms in gc) ", cur_errp);
intprint(cells_allocated - lcells_allocated, -10, cur_errp);
lputs(" cells work, ", cur_errp);
scm_env_work += scm_ecache_len - scm_ecache_index;
intprint(scm_env_work, -10, cur_errp);
lputs(" env, ", cur_errp);
intprint(mallocated - lmallocated, -10, cur_errp);
- lputs(" bytes other\n", cur_errp);
- if (verbose>2) {
+ lputs(".B other\n", cur_errp);
+ if (verbose > 3) {
lputc(';', cur_errp);
intprint(scm_gcs, -10, cur_errp);
lputs( " gc, ", cur_errp);
@@ -1449,7 +1576,7 @@ void init_sbrk()
}
void scm_brk_report()
{
- unsigned long scm_curbrk = sbrk(0),
+ unsigned long scm_curbrk = (unsigned long)sbrk(0),
dif1 = ((dumped ? scm_dumped_brk : scm_curbrk) - scm_init_brk)/1024,
dif2 = (scm_curbrk - scm_dumped_brk)/1024;
@@ -1464,10 +1591,10 @@ void scm_brk_report()
lputs("; ", cur_errp);
intprint(dif1, 10, cur_errp);
if (dumped) {
- lputs(dif2<0 ? " - " : " + ", cur_errp);
- intprint(dif2<0 ? -dif2 : dif2, 10, cur_errp);
+ lputs(dif2 < 0 ? " - " : " + ", cur_errp);
+ intprint(dif2 < 0 ? -dif2 : dif2, 10, cur_errp);
}
- lputs(" kb\n", cur_errp);
+ lputs(".kiB\n", cur_errp);
}
#endif
SCM lroom(opt)
@@ -1478,7 +1605,7 @@ SCM lroom(opt)
intprint(heap_cells, -10, cur_errp);
lputs(" cells in use, ", cur_errp);
intprint(mallocated, -10, cur_errp);
- lputs(" bytes allocated (of ", cur_errp);
+ lputs(".B allocated (of ", cur_errp);
intprint(mtrigger, 10, cur_errp);
lputs(")\n", cur_errp);
if (!UNBNDP(opt)) {
@@ -1486,30 +1613,12 @@ SCM lroom(opt)
if (scm_init_brk) scm_brk_report();
#endif
scm_ecache_report();
- heap_report();
- lputc('\n', cur_errp);
+ heap_report(); lputc('\n', cur_errp);
+ gra_report();
stack_report();
}
return UNSPECIFIED;
}
-void heap_report()
-{
- sizet i = 0;
- lputs(";; heap segments:", sys_errp);
- while(i < hplim_ind) {
- {
- long seg_cells = CELL_DN(hplims[i+1]) - CELL_UP(hplims[i]);
- lputs("\n; 0x", sys_errp);
- intprint((long)hplims[i++], -16, sys_errp);
- lputs(" - 0x", sys_errp);
- intprint((long)hplims[i++], -16, sys_errp);
- lputs("; ", sys_errp);
- intprint(seg_cells, 10, sys_errp);
- lputs(" cells; ", sys_errp);
- intprint(seg_cells / (1024 / sizeof(CELLPTR)), 10, sys_errp);
- lputs(" kb", sys_errp);
- }}
-}
void scm_ecache_report()
{
intprint(scm_estk_size, 10 , cur_errp);
@@ -1521,12 +1630,12 @@ void scm_ecache_report()
}
void exit_report()
{
- if (verbose>2) {
+ if (verbose > 2) {
lputs(";Totals: ", cur_errp);
intprint(time_in_msec(INUM(my_time())), -10, cur_errp);
- lputs(" mSec my time, ", cur_errp);
+ lputs(".ms my time, ", cur_errp);
intprint(time_in_msec(INUM(your_time())), -10, cur_errp);
- lputs(" mSec your time\n", cur_errp);
+ lputs(".ms your time\n", cur_errp);
}
}
@@ -1541,11 +1650,13 @@ SCM prolixity(arg)
return MAKINUM(old);
}
+static SCM i_repl;
SCM repl()
{
SCM x;
+ SCM env = EOL; /* scm_env_addprop(SCM_ENV_FILENAME, i_repl, EOL); */
int c;
- if OPINPORTP(cur_inp) {
+ if (OPINPORTP(cur_inp) && OPOUTPORTP(cur_outp)) {
repl_report();
while(1) {
if OPOUTPORTP(cur_inp) { /* This case for curses window */
@@ -1579,10 +1690,27 @@ SCM repl()
{lfflush(cur_outp); newline(cur_inp);}
else newline(cur_outp);
#endif
- x = EVAL(x, (SCM)EOL);
+ if (NIMP(x)) {
+ x = CONSP(x) ?
+ scm_eval_values(x, env, (SCM)EOL) :
+ cons(EVAL(x, env, (SCM)EOL), EOL);
+ }
+ else
+ x = cons(x, EOL);
repl_report();
- iprin1(x, cur_outp, 1);
- lputc('\n', cur_outp);
+ if (IMP(x))
+ {if (verbose > 2) lputs(";;no values\n", cur_outp);}
+ else if (IMP(CDR(x))) {
+ iprin1(CAR(x), cur_outp, 1);
+ lputc('\n', cur_outp);
+ }
+ else
+ while (NIMP(x)) {
+ lputc(' ', cur_outp);
+ iprin1(CAR(x), cur_outp, 1);
+ lputc('\n', cur_outp);
+ x = CDR(x);
+ }
}
}
return UNSPECIFIED;
@@ -1623,10 +1751,10 @@ SCM scm_unexec(newpath)
#ifdef CAREFUL_INTS
ints_infot *ints_info = 0;
static void ints_viol_iprin(num)
- long num;
+ int num;
{
char num_buf[INTBUFLEN];
- sizet i = iint2str(num, 10, num_buf);
+ sizet i = iint2str(num+0L, 10, num_buf);
num_buf[i] = 0;
fputs(num_buf, stderr);
}
@@ -1640,7 +1768,7 @@ void ints_viol(info, sense)
fputs(": ints already ", stderr);
fputs(sense ? "dis" : "en", stderr);
fputs("abled (", stderr);
- ints_viol_iprin((long)ints_disabled);
+ ints_viol_iprin(ints_disabled);
fputs(")\n", stderr);
if (ints_info) {
fputs(ints_info->fname, stderr);
@@ -1657,7 +1785,7 @@ void ints_warn(str1, str2, fname, linum)
fputs(fname, stderr);
fputc(':', stderr);
ints_viol_iprin(linum);
- fputs(" :uprotected call to ", stderr);
+ fputs(": unprotected call to ", stderr);
fputs(str1, stderr);
if (str2) {
fputs(" (", stderr);
@@ -1668,22 +1796,43 @@ void ints_warn(str1, str2, fname, linum)
}
#endif
-SCM tryload(filename)
- SCM filename;
+#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);
+ if (FALSEP(reader)) reader = UNDEFINED;
+#ifndef RECKLESS
+ if (!UNBNDP(reader)) scm_arity_check(reader, 1L, s_load);
+#endif
{
SCM oloadpath = *loc_loadpath;
SCM oloadports = loadports;
SCM form, port;
+ SCM env = EOL;
port = open_file(filename, makfromstr("r?", (sizet)2*sizeof(char)));
if FALSEP(port) return port;
*loc_loadpath = filename;
loadports = cons(port, loadports);
+#ifdef SCM_ENV_FILENAME
+ env = scm_env_addprop(SCM_ENV_FILENAME, filename, env);
+#endif
while(1) {
- form = lread(port);
+ if (UNBNDP(reader))
+ form = lread(port);
+ else
+ form = scm_cvapply(reader, 1L, &port);
if (EOF_VAL==form) break;
- SIDEVAL(form, EOL);
+ SIDEVAL(form, env, EOL);
}
close_port(port);
loadports = oloadports;
@@ -1692,68 +1841,34 @@ SCM tryload(filename)
return BOOL_T;
}
-#ifdef CAUTIOUS
-static long num_frames(estk, i)
- SCM estk;
- int i;
+void scm_line_msg(file, linum, port)
+ SCM file, linum, port;
{
- long n = 0;
- while NIMP(estk) {
- n += (i - SCM_ESTK_BASE)/SCM_ESTK_FRLEN;
- i = INUM(SCM_ESTK_PARENT_INDEX(estk));
- estk = SCM_ESTK_PARENT(estk);
+ iprin1(file, port, 1);
+ if (SCM_LINUMP(linum)) {
+ lputs(", line ", port);
+ intprint(SCM_LINUM(linum), -10, port);
}
- return n;
-}
-
-extern SCM scm_trace;
-SCM scm_stack_trace()
-{
- SCM ste, lste, estk = scm_estk;
- int i = (scm_estk_ptr - VELTS(scm_estk));
- int n, nf = num_frames(estk, i);
- int ellip = 0, nbrk1 = 7, nbrk2 = nf - 5;
- if (nf <= 0) return BOOL_F;
- nf = 0;
- lputs("\n;STACK TRACE", cur_errp);
- if (NIMP(scm_trace) && (scm_trace != scm_estk_ptr[2]))
- if (reset_safeport(sys_safep, 65, cur_errp)) {
- /* The usual C setjmp, not SCM's setjump. */
- if (0==setjmp(SAFEP_JMPBUF(sys_safep))) {
- lputs("\n+; ", sys_safep);
- iprin1(scm_trace, sys_safep, 1);
- }
- }
- lste = UNDEFINED;
- while NIMP(estk) {
- n = (i - SCM_ESTK_BASE)/SCM_ESTK_FRLEN;
- for (; n > 0; n--) {
- if (nf <= nbrk1 || nf >= nbrk2) {
- ste = VELTS(estk)[SCM_ESTK_BASE + n*SCM_ESTK_FRLEN + 2];
- if (ste != lste) {
- lste = ste;
- if (reset_safeport(sys_safep, 65, cur_errp)) {
- /* The usual C setjmp, not SCM's setjump. */
- if (0==setjmp(SAFEP_JMPBUF(sys_safep))) {
- lputc('\n', cur_errp);
- intprint(nf, -10, sys_safep);
- lputs("; ", sys_safep);
- iprin1(ste, sys_safep, 1);
- }
- }
- else if (! ellip++)
- lputs("\n...", cur_errp);
- }
- }
- nf++;
+ lputs(": ", port);
+}
+void scm_err_line(what, file, linum, port)
+ char *what;
+ SCM file, linum, port;
+{
+ lputs(what, port);
+ if (NIMP(file) && STRINGP(file))
+ scm_line_msg(file, linum, port);
+#ifdef CAUTIOUS
+ else {
+ SCM env = scm_env_getprop(SCM_ENV_FILENAME, scm_trace_env);
+ if (NIMP(env)) {
+ file = CAR(env);
+ scm_check_linum(scm_trace, &linum);
+ scm_line_msg(file, linum, port);
}
- i = INUM(SCM_ESTK_PARENT_INDEX(estk));
- estk = SCM_ESTK_PARENT(estk);
}
- lputc('\n', cur_errp);
- return BOOL_T;
-}
#endif
+}
static void err_head(str)
char *str;
@@ -1761,11 +1876,10 @@ static void err_head(str)
SCM lps;
int oerrno = errno;
exitval = MAKINUM(EXIT_FAILURE);
- if NIMP(cur_outp) lfflush(cur_outp);
- lputc('\n', cur_errp);
+ if (NIMP(cur_outp) && OPOUTPORTP(cur_outp)) lfflush(cur_outp);
for (lps = loadports; NIMP(lps); lps = CDR(lps)) {
- if (lps != loadports)
- lputs("\n ;loaded from ", cur_errp);
+ lputs(lps==loadports ? "\n;While loading " : "\n ;loaded from ",
+ cur_errp);
iprin1(scm_port_filename(CAR(lps)), cur_errp, 1);
lputs(", line ", cur_errp);
iprin1(scm_port_line(CAR(lps)), cur_errp, 1);
@@ -1779,17 +1893,22 @@ static void err_head(str)
if (errno>0) perror(str);
fflush(stderr);
}
-void scm_warn(str1, str2)
+void scm_warn(str1, str2, obj)
char *str1, *str2;
+ SCM obj;
{
err_head("WARNING");
- lputs("WARNING: ", cur_errp);
+ scm_err_line("WARNING: ", UNDEFINED, UNDEFINED, cur_errp);
lputs(str1, cur_errp);
- if (str2) {
+ if (str2 && *str2) {
lputs(str2, cur_errp);
lputc('\n', cur_errp);
- lfflush(cur_errp);
}
+ if (!UNBNDP(obj)) {
+ iprin1(obj, cur_errp, 1);
+ lputc('\n', cur_errp);
+ }
+ lfflush(cur_errp);
}
SCM lerrno(arg)
@@ -1812,25 +1931,41 @@ SCM lperror(arg)
}
static void def_err_response()
{
- SCM env = err_env, obj = *loc_errobj;
+ SCM file, env = err_env, obj = *loc_errobj;
+ SCM linum = UNDEFINED;
+ int badport = IMP(cur_errp) || !OPOUTPORTP(cur_errp);
+ int writing = 2; /* Value of 2 used only for printing error messages */
+ int codep = errobj_codep;
DEFER_INTS;
- if (errjmp_recursive++) {
+ if (badport || (errjmp_recursive++)) {
+ if (IMP(def_errp) || !OPOUTPORTP(def_errp)) exit(EXIT_FAILURE);
lputs("RECURSIVE ERROR: ", def_errp);
- if (TYP16(cur_errp)==tc16_sfport) {
+ if (badport || TYP16(cur_errp)==tc16_sfport) {
+ lputs("reverting from ", def_errp);
+ iprin1(cur_errp, def_errp, 2);
+ lputs("to default error port\n", def_errp);
cur_errp = def_errp;
errjmp_recursive = 0;
- lputs("reverting to default error port\n", def_errp);
}
else exit(EXIT_FAILURE);
}
+#ifdef SCM_ENV_FILENAME
+ file = scm_env_getprop(SCM_ENV_FILENAME, env);
+ if (NIMP(file)) file = CAR(file);
+ else file = UNDEFINED;
+#else
+ file = BOOL_F;
+#endif
+ if (codep) obj = scm_check_linum(obj, &linum);
+ err_exp = scm_check_linum(err_exp, UNBNDP(linum) ? &linum : 0L);
err_head("ERROR");
+ scm_err_line("ERROR: ", file, linum, cur_errp);
if (err_s_subr && *err_s_subr) {
- lputs("ERROR: ", cur_errp);
lputs(err_s_subr, cur_errp);
lputs(": ", cur_errp);
}
if (!err_pos) return; /* Already been printed */
- if (err_pos==(char *)ARG1 && UNBNDP(*loc_errobj)) err_pos = (char *)WNA;
+ if (err_pos==(char *)ARG1 && UNBNDP(obj)) err_pos = (char *)WNA;
#ifdef nosve
if ((~0x1fL) & (short)err_pos) lputs(err_pos, cur_errp);
else if (WNA > (short)err_pos) {
@@ -1850,40 +1985,26 @@ static void def_err_response()
if (!UNBNDP(obj))
if (reset_safeport(sys_safep, 55, cur_errp))
if (0==setjmp(SAFEP_JMPBUF(sys_safep)))
- iprin1(obj, sys_safep, 1);
+ 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))
if (0==setjmp(SAFEP_JMPBUF(sys_safep))) {
lputs("\n; in expression: ", cur_errp);
- if NCONSP(err_exp)
- iprin1(err_exp, sys_safep, 1);
+ if (NCONSP(err_exp)) scm_princode(err_exp, env, sys_safep, writing);
else if (UNDEFINED==CDR(err_exp))
- iprin1(CAR(err_exp), sys_safep, 1);
- else iprlist("(... ", err_exp, ')', sys_safep, 1);
+ iprin1(CAR(err_exp), sys_safep, writing);
+ else {
+ if (UNBNDP(env)) iprlist("(... ", err_exp, ')', sys_safep, writing);
+ else scm_princode(err_exp, env, sys_safep, writing);
+ }
}
}
- if (NIMP(env) && ENVP(env)) {
- if (scm_env==env) {
- lputs("\n; in expand-time environment: ", cur_errp);
- iprin1(env, cur_errp, 1);
- }
- env = CDR(env);
- }
- if (NULLP(env))
- lputs("\n; in top level environment.", cur_errp);
- else {
- lputs("\n; in scope:", cur_errp);
- while NNULLP(env) {
- lputc('\n', cur_errp);
- lputs("; ", cur_errp);
- iprin1(CAR(CAR(env)), cur_errp, 1);
- env = CDR(env);
- }
- }
+ scm_scope_trace(env);
getout:
#ifdef CAUTIOUS
- scm_stack_trace();
+ scm_stack_trace(UNDEFINED);
#endif
lputc('\n', cur_errp);
lfflush(cur_errp);
@@ -1902,15 +2023,17 @@ static void def_err_response()
errno = 0;
ALLOW_INTS;
}
-void everr(exp, env, arg, pos, s_subr)
+void everr(exp, env, arg, pos, s_subr, codep)
SCM exp, env, arg;
char *pos, *s_subr;
+ int codep;
{
err_exp = exp;
err_env = env;
*loc_errobj = arg;
err_pos = pos;
err_s_subr = s_subr;
+ errobj_codep = codep;
if (errjmp_bad || errjmp_recursive) def_err_response();
longjump(CONT(rootcont)->jmpbuf,
(~0x1fL) & (long)pos || (WNA > (long)pos) ?
@@ -1919,9 +2042,23 @@ void everr(exp, env, arg, pos, s_subr)
}
void wta(arg, pos, s_subr)
SCM arg;
-char *pos, *s_subr;
+ char *pos, *s_subr;
{
- everr(UNDEFINED, EOL, arg, pos, s_subr);
+#ifndef RECKLESS
+ everr(scm_trace, scm_trace_env, arg, pos, s_subr, 0);
+#else
+ everr(UNDEFINED, EOL, arg, pos, s_subr, 0);
+#endif
+}
+void scm_experr(arg, pos, s_subr)
+ SCM arg;
+ char *pos, *s_subr;
+{
+#ifndef RECKLESS
+ everr(scm_trace, scm_trace_env, arg, pos, s_subr, !0);
+#else
+ everr(UNDEFINED, EOL, arg, pos, s_subr, !0);
+#endif
}
SCM cur_input_port()
{
@@ -1988,16 +2125,12 @@ static iproc subr0s[] = {
{"line-number", line_num},
{"abort", abrt},
{s_restart, restart},
-#ifdef CAUTIOUS
- {"stack-trace", scm_stack_trace},
-#endif
{0, 0}};
static iproc subr1s[] = {
{s_cur_inp, set_inp},
{s_cur_outp, set_outp},
{s_cur_errp, set_errp},
- {s_tryload, tryload},
{s_load_string, scm_load_string},
{s_eval_string, scm_eval_string},
{s_perror, lperror},
@@ -2028,6 +2161,7 @@ static iproc subr2os[] = {
{s_write, lwrite},
{s_display, display},
{s_write_char, write_char},
+ {s_tryload, tryload},
#ifdef CAN_DUMP
{s_unexec, scm_unexec},
#endif
@@ -2040,17 +2174,26 @@ void init_repl( iverbose )
int iverbose;
{
sysintern(s_ccl, MAKINUM(CHAR_CODE_LIMIT));
+ i_repl = CAR(sysintern("repl", UNDEFINED));
loc_errobj = &CDR(sysintern("errobj", UNDEFINED));
loc_loadpath = &CDR(sysintern("*load-pathname*", BOOL_F));
loc_readsharp = &CDR(sysintern("read:sharp", UNDEFINED));
loc_readsharpc = &CDR(sysintern("read:sharp-char", 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);
+ i_eval_string = CAR(sysintern(s_eval_string, UNDEFINED));
+ i_load_string = CAR(sysintern(s_load_string, UNDEFINED));
#ifdef CAN_DUMP
add_feature("dump");
scm_ldstr("\
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-16 10:18:21 +0000