Import Upstream version 5d6upstream/5d6

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("\