Import Upstream version 5d2upstream/5d2

1 files changed, 533 insertions, 323 deletions

diff --git a/repl.c b/repl.c
index a60d7e8..20be8b1 100644
--- a/repl.c
+++ b/repl.c
@@ -1,18 +1,18 @@
-/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997, 1998 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1990-1999 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
  * the Free Software Foundation; either version 2, or (at your option)
  * any later version.
- * 
+ *
  * This program is distributed in the hope that it will be useful,
  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  * GNU General Public License for more details.
- * 
+ *
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ * 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.
@@ -36,7 +36,7 @@
  *
  * If you write modifications of your own for GUILE, it is your choice
  * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  
+ * If you do not wish that, delete this exception notice.
  */
 
 /* "repl.c" error, read-eval-print loop, read, write and load code.
@@ -47,6 +47,11 @@
 void	igc P((char *what, STACKITEM *stackbase));
 void	unexec P((char *new_name, char *a_name, unsigned data_start,
 		  unsigned bss_start, unsigned entry_address));
+void	scm_fill_freelist P((void));
+
+#ifdef __CYGWIN32__
+# include <sys/types.h>
+#endif
 
 #ifdef ARM_ULIB
 # include <termio.h>
@@ -74,8 +79,6 @@ void init_tables()
     upcase[lowers[i]] = uppers[i];
     downcase[uppers[i]] = lowers[i];
   }
-  scm_verbose = 1;		/* Here so that monitor info won't be */
-				/* printed while in init_storage. (BOOM) */
 }
 
 #ifdef EBCDIC
@@ -130,6 +133,7 @@ char *isymnames[] = {
 static char	s_read_char[] = "read-char", s_peek_char[] = "peek-char";
 char	s_read[] = "read", 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";
@@ -282,16 +286,13 @@ taloop:
       lputc(')', port);
       break;
     case tc7_bvect:
-    case tc7_ivect:
-    case tc7_uvect:
-    case tc7_fvect:
-    case tc7_dvect:
-    case tc7_cvect:
+    case tc7_ivect: case tc7_uvect: case tc7_svect:
+    case tc7_fvect: case tc7_dvect: case tc7_cvect:
       raprin1(exp, port, writing);
       break;
     case tcs_subrs:
       lputs("#<primitive-procedure ", port);
-      lputs(CHARS(SNAME(exp)), port);
+      lputs(SNAME(exp), port);
       lputc('>', port);
       break;
     case tc7_specfun:
@@ -299,6 +300,8 @@ taloop:
       if (tc16_cclo==TYP16(exp)) {
 	lputs("#<compiled-closure ", port);
 	iprin1(CCLO_SUBR(exp), port, writing);
+	lputc(' ', port);
+	iprin1(VELTS(exp)[1], port, writing);
 	lputc('>', port);
 	break;
       }
@@ -316,8 +319,13 @@ taloop:
       break;
     case tc7_port:
       i = PTOBNUM(exp);
-      if (i<numptob && ptobs[i].print && (ptobs[i].print)(exp, port, writing))
+      if (i<numptob) {
+	if (ptobs[i].print && (ptobs[i].print)(exp, port, writing))
+	  ;
+	else
+	  prinport(exp, port, ptobs[i].name ? ptobs[i].name : "unknown");
 	break;
+      }
       goto punk;
     case tc7_smob:
       i = SMOBNUM(exp);
@@ -329,17 +337,14 @@ taloop:
   }
 }
 
-#ifndef GO32
 static char s_char_readyp[]="char-ready?";
-#endif
 
 #ifdef __IBMC__
 # define MSDOS
 #endif
 #ifdef MSDOS
-# ifndef GO32
-#  include <io.h>
-#  include <conio.h>
+# include <io.h>
+# include <conio.h>
 static int input_waiting(f)
      FILE *f;
 {
@@ -347,7 +352,6 @@ static int input_waiting(f)
   if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin)))) return kbhit();
   return -1;
 }
-# endif
 #else
 # ifdef _DCC
 #  include <ioctl.h>
@@ -367,10 +371,8 @@ static int input_waiting(f)
 #  endif
 # endif
 
-# ifdef HAVE_SELECT
-#  ifdef HAVE_SYS_TIME_H
-#   include <sys/time.h>
-#  endif
+# ifdef HAVE_SYS_TIME_H
+#  include <sys/time.h>
 # endif
 
 static int input_waiting(f)
@@ -402,16 +404,115 @@ static int input_waiting(f)
 }
 #endif
 /* perhaps should undefine MSDOS from __IBMC__ here */
-#ifndef GO32
 SCM char_readyp(port)
      SCM port;
 {
   if UNBNDP(port) port = cur_inp;
   else ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_char_readyp);
-  if (CRDYP(port) || !(BUF0 & CAR(port))) return BOOL_T;
+  if (CRDYP(port) || !(BUF0 & SCM_PORTFLAGS(port))) return BOOL_T;
   return input_waiting(STREAM(port)) ? BOOL_T : BOOL_F;
 }
+
+#ifdef GO32
+# include <pc.h>
+#endif
+#ifndef HAVE_SELECT
+# include <time.h>
+#endif
+#ifdef __STDC__
+# define timet time_t
+#else
+# define timet long
+#endif
+static char s_wfi[] = "wait-for-input";
+SCM wait_for_input(args)
+     SCM args;
+{
+  SCM how_long, port1, port, ports, ans = EOL;
+  int timeout, pos = ARG2;
+  ASSERT(!NULLP(args), INUM0, WNA, s_wfi);
+  how_long = CAR(args);
+  args = CDR(args);
+  if NULLP(args) port1 = cur_inp;
+  else {
+    port1 = CAR(args);
+    args = CDR(args);
+  }
+  timeout = num2long(how_long, (char *)ARG1, s_wfi);
+  ASSERT(timeout >= 0, how_long, ARG1, s_wfi);
+  port = port1;
+  ports = args;
+  while (1) {
+    ASSERT(NIMP(port) && OPINPORTP(port) && (BUF0 & SCM_PORTFLAGS(port)),
+	   port, pos, s_wfi);
+    if (CRDYP(port) || feof(STREAM(port))) timeout = 0;
+    if (NULLP(ports)) break;
+    if (ARG5 <= pos) pos = ARGn;
+    else if (ARG1 < pos) pos = 1 + pos;
+    port = CAR(ports);
+    ports = CDR(ports);
+  }
+  {
+#ifdef HAVE_SELECT
+    fd_set ifds;
+    struct timeval tv;
+    int ret, fd_max = 0;
+
+    tv.tv_sec = timeout;
+    tv.tv_usec = 0;
+
+    FD_ZERO(&ifds);
+    port = port1;
+    ports = args;
+    while (1) {
+      int fd = fileno(STREAM(port));
+      FD_SET(fd, &ifds);
+      if (fd_max < fd) fd_max = fd;
+
+      if (NULLP(ports)) break;
+      port = CAR(ports);
+      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);
+
+    port = port1;
+    ports = args;
+    while (1) {
+      if (FD_ISSET(fileno(STREAM(port)), &ifds)
+	  || CRDYP(port) || feof(STREAM(port)))
+	ans = cons(port, ans);
+      if (NULLP(ports)) break;
+      port = CAR(ports);
+      ports = CDR(ports);
+    }
+#else
+    timet start = 0;
+    time(&start);
+    start = start + timeout;
+    port = port1;
+    ports = args;
+    do {
+      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);
+# else
+	if (fileno(f)==fileno(stdin) && (isatty(fileno(stdin))) && kbhit())
+	  ans = cons(port, ans);
+# endif
+	if (NULLP(ports)) break;
+	port = CAR(ports);
+	ports = CDR(ports);
+      }
+    } while (time((timet*)0L) < start);
 #endif
+    return NULLP(ans) ? BOOL_F : ans;
+  }
+}
 
 SCM eof_objectp(x)
      SCM x;
@@ -493,22 +594,21 @@ SCM write_char(chr, port)
 #endif
 	return UNSPECIFIED;
 }
-
-FILE *trans = 0;
-SCM trans_on(fil)
-     SCM fil;
-{
-  transcript = try_open_file(fil, makfromstr("w", (sizet)sizeof(char)));
-  if FALSEP(transcript) trans = 0;
-  else trans = STREAM(transcript);
-  return UNSPECIFIED;
-}
-SCM trans_off()
+SCM scm_freshline(port)
+     SCM port;
 {
-  if (!FALSEP(transcript)) close_port(transcript);
-  transcript = BOOL_F;
-  trans = 0;
-  return UNSPECIFIED;
+	if UNBNDP(port) port = cur_outp;
+	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);
+	return UNSPECIFIED;
 }
 
 void lputc(c, port)
@@ -517,8 +617,17 @@ void lputc(c, port)
 {
   sizet i = PTOBNUM(port);
   SYSCALL((ptobs[i].fputc)(c, STREAM(port)););
-  if (trans && (port==def_outp || port==cur_errp))
-    SYSCALL(fputc(c, trans););
+  if (CRDY & CAR(port)) {
+    i = SCM_PORTNUM(port);
+    switch (c) {
+    case LINE_INCREMENTORS:
+      scm_port_table[i].line++;
+      scm_port_table[i].col = 0;
+      break;
+    default:
+      scm_port_table[i].col++;
+    }
+  }
 }
 void lputs(s, port)
      char *s;
@@ -527,21 +636,44 @@ void lputs(s, port)
   sizet i = PTOBNUM(port);
   ASSERT(s, INUM0, ARG1, "lputs");
   SYSCALL((ptobs[i].fputs)(s, STREAM(port)););
-  if (trans && (port==def_outp || port==cur_errp))
-    SYSCALL(fputs(s, trans););
+  if (CRDY & CAR(port)) {
+    sizet j;
+    i = SCM_PORTNUM(port);
+    for (j = 0; s[j]; j++) {
+      switch (s[j]) {
+      case LINE_INCREMENTORS:
+	scm_port_table[i].line++;
+	scm_port_table[i].col = 0;
+	break;
+      default:
+	scm_port_table[i].col++;
+      }
+    }
+  }
 }
-int lfwrite(ptr, size, nitems, port)
+sizet lfwrite(ptr, size, nitems, port)
      char *ptr;
      sizet size;
      sizet nitems;
      SCM port;
 {
-  int ret;
-  sizet i = PTOBNUM(port);
+  sizet ret, i = PTOBNUM(port);
   SYSCALL(ret = (ptobs[i].fwrite)
 	  (ptr, size, nitems, STREAM(port)););
-  if (trans && (port==def_outp || port==cur_errp))
-    SYSCALL(fwrite(ptr, size, nitems, trans););
+  if (CRDY & CAR(port)) {
+    sizet j;
+    i = SCM_PORTNUM(port);
+    for (j = 0; j < ret*size; j++) {
+      switch (ptr[j]) {
+      case LINE_INCREMENTORS:
+	scm_port_table[i].line++;
+	scm_port_table[i].col = 0;
+	break;
+      default:
+	scm_port_table[i].col++;
+      }
+    }
+  }
   return ret;
 }
 
@@ -550,22 +682,34 @@ int lgetc(port)
 {
   FILE *f;
   int c;
-  sizet i;
-  /* One char may be stored in the high bits of (car port) orre@nada.kth.se. */
-  if CRDYP(port)
-    {
-      c = CGETUN(port);
-      CLRDY(port);		/* Clear ungetted char */
+  sizet i, j;
+  if (CRDY & CAR(port)) {
+    j = SCM_PORTNUM(port);
+    c = scm_port_table[j].unread;
+    if (c != EOF) {
+      scm_port_table[j].unread = EOF;
+      CAR(port) &= (scm_port_table[j].flags | (~0xf0000)); /* CLRDY(port) */
       return c;
     }
-  f=STREAM(port);
+  }
+  f = STREAM(port);
   i = PTOBNUM(port);
 #ifdef linux
   c = (ptobs[i].fgetc)(f);
 #else
   SYSCALL(c = (ptobs[i].fgetc)(f););
 #endif
-  if (trans && (f==stdin)) SYSCALL(fputc(c, trans););
+  if (CRDY & CAR(port)) {	/* CRDY 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;
+      break;
+    default:
+      scm_port_table[j].col++;
+    }
+  }
   return c;
 }
 void lungetc(c, port)
@@ -573,7 +717,8 @@ void lungetc(c, port)
   SCM port;
 {
 /*	ASSERT(!CRDYP(port), port, ARG2, "too many lungetc");*/
-	CUNGET(c, port);
+  scm_port_table[SCM_PORTNUM(port)].unread = c;
+  CAR(port) |= CRDY;
 }
 
 SCM scm_read_char(port)
@@ -617,7 +762,7 @@ static int flush_ws(port)
       case EOF: return c;
       case LINE_INCREMENTORS: break;
     }
-    case LINE_INCREMENTORS: if (port==loadport) linum++;
+    case LINE_INCREMENTORS:
     case WHITE_SPACES: break;
     case EOF:
     default:
@@ -639,6 +784,7 @@ SCM lread(port)
 	} while (EOF_VAL==(tok_buf = lreadr(tok_buf, port)));
 	return tok_buf;
 }
+static SCM *loc_readsharp = 0, *loc_readsharpc = 0;
 static SCM lreadpr(tok_buf, port)
      SCM tok_buf;
      SCM port;
@@ -653,7 +799,8 @@ tryagain:
 #ifdef BRACKETS_AS_PARENS
 	case '[':
 #endif
-	case '(': return lreadparen(tok_buf, port, s_list);
+	case '(':
+	  return lreadparen(tok_buf, port, s_list);
 #ifdef BRACKETS_AS_PARENS
 	case ']':
 #endif
@@ -702,6 +849,11 @@ tryagain:
 			  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 */
@@ -710,7 +862,6 @@ lpc:			switch (c) {
 			case EOF:
 			  wta(UNDEFINED, s_eofin, "balanced comment");
 			case LINE_INCREMENTORS:
-			  if (port==loadport) linum++;
 			default:
 			  goto lp;
 			case '|':
@@ -723,10 +874,8 @@ lpc:			switch (c) {
 			}
 			goto tryagain;
 		default: callshrp:
-			p = CDR(intern("read:sharp", (sizeof "read:sharp")-1));
-			if NIMP(p) {
-			  p = apply(p, cons2(MAKICHR(c), port, EOL), EOL);
-		      /*  p = apply(p, MAKICHR(c), acons(port, EOL, EOL)); */
+			if (loc_readsharp && NIMP(*loc_readsharp)) {
+			  p = apply(*loc_readsharp, cons2(MAKICHR(c), port, EOL), EOL);
 			  if (UNSPECIFIED==p) goto tryagain;
 			  return p;
 			}
@@ -735,20 +884,24 @@ lpc:			switch (c) {
 	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);
-			if (c=='\\') switch (c = lgetc(port)) {
-			case '\n': 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;
+		  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;
@@ -782,7 +935,7 @@ static SCM lreadr(tok_buf, port)
   SCM ans = lreadpr(tok_buf, port);
   switch (ans) {
   case UNDEFINED:
-    warn("unexpected \")\"", "");
+    scm_warn("unexpected \")\"", "");
     return lreadpr(tok_buf, port);
   }
   return ans;
@@ -835,7 +988,7 @@ static SCM lreadparen(tok_buf, port, name)
     fst = lreadr(tok_buf, port);
   closeit:
     tmp = lreadpr(tok_buf, port);
-    if (UNDEFINED != tmp) wta(UNDEFINED, "missing close paren", "");
+    if (UNDEFINED != tmp) wta(UNDEFINED, "missing close paren", name);
     return fst;
   }
   fst = lst = cons(tmp, EOL);
@@ -914,11 +1067,14 @@ struct errdesc errmsgs[] = {
   {"bus error", 0, 0},
   {"segment violation", 0, 0},
   {"alarm", "alarm-interrupt", 0},
-  {"profile interrupt", "profile-interrupt", 0},
+  {"virtual alarm", "virtual-alarm-interrupt", 0},
+  {"profile interrupt", "profile-alarm-interrupt", 0},
 };
 
 void (* deferred_proc) P((void)) = 0;
-int errjmp_bad = 1, ints_disabled = 1;
+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;
@@ -926,9 +1082,8 @@ 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;
-SCM loadport = UNDEFINED;
-long linum = 1;
-int scm_verbose = 1;
+int scm_verbose = 1;		/* Low so that monitor info won't be */
+				/* printed while in init_storage. (BOOM) */
 long cells_allocated = 0, lcells_allocated = 0,
   mallocated = 0, lmallocated = 0,
   rt = 0, gc_rt, gc_time_taken;
@@ -941,17 +1096,19 @@ static void def_err_response P((void));
 int handle_it(i)
      int i;
 {
-  char *name = errmsgs[i-WNA].s_response;
   SCM proc;
-  if (errjmp_bad)
+  char *name = errmsgs[i-WNA].s_response;
+  if (errjmp_bad || errjmp_recursive)
     wta(UNDEFINED, (char *)i, ""); /* sends it to def_err_response */
   if (name) {
     SCM n[2];
     int j;
+    DEFER_INTS;
     for (j=0; j<2; j++) {
       NEWCELL(n[j]);		/* discard 2 possibly-used cells */
     }
     CDR(n[1]) = EOL;
+    ALLOW_INTS;
     proc = CDR(intern(name, (sizet)strlen(name)));
     if NIMP(proc) {	  /* Save environment stack, in case it
 			     moves when applying proc.  Do an ecache gc
@@ -966,7 +1123,9 @@ int handle_it(i)
       env = scm_env;
       env_tmp = scm_env_tmp;
       scm_estk = BOOL_F;
-      scm_estk_reset();
+      scm_estk_reset(0);
+      SCM_ESTK_PARENT(scm_estk) = estk;
+      SCM_ESTK_PARENT_INDEX(scm_estk) = MAKINUM(estk_ptr - VELTS(estk));
       ALLOW_INTS;
       apply(proc, EOL, EOL);
       DEFER_INTS;
@@ -1006,9 +1165,11 @@ SCM scm_load_string(str)
 
 SCM exitval = MAKINUM(EXIT_FAILURE); /* INUM return value */
 extern char s_unexec[];
-SCM repl_driver(initpath)
+SCM scm_top_level(initpath, toplvl_fun)
      char *initpath;
+     SCM (*toplvl_fun)();
 {
+  SCM ret;
 #ifdef _UNICOS
   int i;
 #else
@@ -1019,22 +1180,26 @@ SCM repl_driver(initpath)
 #ifndef SHORT_INT
   if (i) i = UNCOOK(i);
 #endif
-  /* printf("repl_driver got %d\n", i); */
+  if (!toplvl_fun) toplvl_fun = repl;
+  /* printf("scm_top_level got %d\n", i); */
  drloop:
   switch ((int)i) {
-  default: {
-    char *name = errmsgs[i-WNA].s_response;
-    if (name) {
-      SCM proc = CDR(intern(name, (sizet)strlen(name)));
-      if NIMP(proc) apply(proc, EOL, EOL);
-    }
+  default:
+    {
+      char *name = errmsgs[i-WNA].s_response;
+      if (name) {
+	SCM proc = CDR(intern(name, (sizet)strlen(name)));
+	if NIMP(proc) apply(proc, EOL, EOL);
+      }}
     if ((i = errmsgs[i-WNA].parent_err)) goto drloop;
+  case 1:			/* from everr() */
     def_err_response();
+    dowinds(EOL);
     goto reset_toplvl;
-  }
   case 0:
     exitval = MAKINUM(EXIT_SUCCESS);
-    errjmp_bad = 0;
+    errjmp_bad = (char *)0;
+    errjmp_recursive = 0;
     lflush(sys_errp);
     errno = 0;
     SIG_deferred = 0;
@@ -1046,58 +1211,73 @@ SCM repl_driver(initpath)
       rt = INUM(my_time());
       gc_time_taken = 0;
     }
-    else if (scm_ldfile(initpath)) /* load Scheme init files */
+    else if (initpath &&
+	     (isspace(initpath[0]) || ';'==initpath[0] || '('==initpath[0]))
+      scm_ldstr(initpath);
+    else if (scm_ldfile(initpath ? initpath : "")) /* load Scheme init files */
       wta(*loc_errobj, "Could not open file", s_load);
     {
       SCM boot_tail = scm_evstr("boot-tail");
       /* initialization tail-call */
-      apply(boot_tail, (dumped ? BOOL_T : BOOL_F), listofnull);
+      if NIMP(boot_tail)
+        apply(boot_tail, (dumped ? makfrom0str(initpath) : BOOL_F), listofnull);
     }
   case -2:			/* abrt */
   reset_toplvl:
+    dowinds(EOL);
     ints_disabled = 1;
-    errjmp_bad = 0;
+    errjmp_bad = (char *)0;
+    errjmp_recursive = 0;
     lflush(sys_errp);
     SIG_deferred = 0;
     deferred_proc = 0;
-    scm_estk_reset();
+    scm_estk_reset(0);
 
     /* Closing the loading file turned out to be a bad idea. */
     /* But I will leave the code here in case someone wants it. */
 #ifdef CLOSE_LOADING_PORTS_ON_ABORT
-    if (NIMP(loadport) && OPINPORTP(loadport)) {
+    if (NIMP(loadports) && OPINPORTP(CAR(loadports))) {
       if (scm_verbose > 1) {
 	lputs("; Aborting load (closing): ", cur_errp);
 	display(*loc_loadpath, cur_errp);
 	newline(cur_errp);
       }
-      close_port(loadport);	/* close loading file. */
+      close_port(CAR(loadports)); /* close loading file. */
     }
 #endif
+
     *loc_loadpath = BOOL_F;
-    loadport = UNDEFINED;
+    loadports = EOL;
     ints_disabled = 0;
-    repl();
+    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) {
+      lputs("; program args: ", cur_errp);
+      lwrite(progargs, cur_errp);
+      newline(cur_errp);
+    }
     return exitval;
   case -3:			/* restart. */
+    dowinds(EOL);
     return 0;
 #ifdef CAN_DUMP
   case -4:			/* dump */
     DEFER_INTS;
-    scm_estk_reset();
+    scm_estk_reset(0);
     scm_egc();
     igc(s_unexec, (STACKITEM *)0);
     ALLOW_INTS;
     dumped = 1;
-# ifdef linux    
-				/* The last few words of the .data segment
+# ifdef linux
+    sbrk(getpagesize());	/* The last few words of the .data segment
 				   were not being mapped in for dumped
 				   executables. */
-    sbrk(getpagesize());
 # endif
     unexec(CHARS(*loc_errobj), execpath, 0, 0, 0);
     goto reset_toplvl;
@@ -1107,8 +1287,57 @@ SCM repl_driver(initpath)
 
 SCM line_num()
 {
-  return MAKINUM(linum);
+  if (IMP(loadports))
+    return INUM0;
+  return scm_port_line(CAR(loadports));
+}
+static char s_port_line[] = "port-line";
+SCM scm_port_line(port)
+     SCM port;
+{
+  sizet lnum;
+  ASSERT(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)) {
+  default:
+    break;
+  case LINE_INCREMENTORS:
+    lnum--;
+    break;
+  }
+  return MAKINUM(lnum);
 }
+static char s_port_col[] = "port-column";
+SCM scm_port_col(port)
+     SCM port;
+{
+  short 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;
+  switch (CGETUN(port)) {
+  default:
+    col--;
+    break;
+  case LINE_INCREMENTORS:
+    col = scm_port_table[SCM_PORTNUM(port)].colprev;
+    break;
+  }
+  return MAKINUM(col);
+}
+static char s_port_filename[] = "port-filename";
+SCM scm_port_filename(port)
+     SCM port;
+{
+  SCM x;
+  ASSERT(NIMP(port) && PORTP(port), port, ARG1, s_port_filename);
+  x = SCM_PORTDATA(port);
+  if (NIMP(x) && STRINGP(x))
+    return SCM_PORTDATA(port);
+  return BOOL_F;
+}
+
 SCM prog_args()
 {
   return progargs;
@@ -1210,13 +1439,20 @@ void repl_report()
   }
 }
 #ifndef LACK_SBRK
-extern long scm_init_brk, scm_dumped_brk;
+unsigned long scm_init_brk = 0, scm_dumped_brk = 0;
+void init_sbrk()
+{
+  if (dumped)
+    scm_dumped_brk = (unsigned long)sbrk(0);
+  else
+    scm_init_brk = (unsigned long)sbrk(0);
+}
 void scm_brk_report()
 {
-  long scm_curbrk = sbrk(0),
+  unsigned long scm_curbrk = sbrk(0),
     dif1 = ((dumped ? scm_dumped_brk : scm_curbrk) - scm_init_brk)/1024,
     dif2 = (scm_curbrk - scm_dumped_brk)/1024;
-    
+
   lputs("initial brk = 0x", cur_errp);
   intprint(scm_init_brk, -16, cur_errp);
   if (dumped) {
@@ -1234,9 +1470,6 @@ void scm_brk_report()
   lputs(" kb\n", cur_errp);
 }
 #endif
-#ifdef NUM_HP
-extern long num_hp_total;
-#endif
 SCM lroom(opt)
      SCM opt;
 {
@@ -1249,12 +1482,8 @@ SCM lroom(opt)
   intprint(mtrigger, 10, cur_errp);
   lputs(")\n", cur_errp);
   if (!UNBNDP(opt)) {
-#ifdef NUM_HP
-    intprint(num_hp_total, 10, cur_errp);
-    lputs(" bytes allocated for flonums/bignums\n", cur_errp);
-#endif
 #ifndef LACK_SBRK
-    scm_brk_report();
+    if (scm_init_brk) scm_brk_report();
 #endif
     scm_ecache_report();
     heap_report();
@@ -1283,13 +1512,8 @@ void heap_report()
 }
 void scm_ecache_report()
 {
-  long n = LENGTH(scm_estk) - 1;
-  while (n-- && VELTS(scm_estk)[n]==UNSPECIFIED)
-    ;
-  intprint(n + 1L, 10 , cur_errp);
-  lputs(" out of ", cur_errp);
-  intprint(LENGTH(scm_estk), 10, cur_errp);
-  lputs(" env stack items touched, ", cur_errp);
+  intprint(scm_estk_size, 10 , cur_errp);
+  lputs(" env stack items, ", cur_errp);
   intprint(scm_ecache_len - scm_ecache_index, 10, cur_errp);
   lputs(" out of ", cur_errp);
   intprint(scm_ecache_len, 10, cur_errp);
@@ -1317,48 +1541,51 @@ SCM prolixity(arg)
   return MAKINUM(old);
 }
 
-void repl()
+SCM repl()
 {
   SCM x;
   int c;
-  repl_report();
-  while(1) {
-    if OPOUTPORTP(cur_inp) {	/* This case for curses window */
-      lfflush(cur_outp);
-      if (verbose) lputs(PROMPT, cur_inp);
-      lfflush(cur_inp);
-    }
-    else {
-      if (verbose) lputs(PROMPT, cur_outp);
-      lfflush(cur_outp);
-    }
-    lcells_allocated = cells_allocated;
-    scm_env_work = scm_ecache_index - scm_ecache_len;
-    scm_egcs = scm_clo_moved = scm_stk_moved = 0;
-    lmallocated = mallocated;
-    x = lread(cur_inp);
-    rt = INUM(my_time());
-    scm_gcs = 0;
-    gc_time_taken = 0;
-    if (EOF_VAL==x) break;
-    if (!CRDYP(cur_inp)) {	/* assure newline read (and transcripted) */
-      if (EOF==(c = lgetc(cur_inp))) break;
-      lungetc(c, cur_inp);
-    }
+  if OPINPORTP(cur_inp) {
+    repl_report();
+    while(1) {
+      if OPOUTPORTP(cur_inp) {	/* This case for curses window */
+	lfflush(cur_outp);
+	if (verbose) lputs(PROMPT, cur_inp);
+	lfflush(cur_inp);
+      }
+      else {
+	if (verbose) lputs(PROMPT, cur_outp);
+	lfflush(cur_outp);
+      }
+      lcells_allocated = cells_allocated;
+      scm_env_work = scm_ecache_index - scm_ecache_len;
+      scm_egcs = scm_clo_moved = scm_stk_moved = 0;
+      lmallocated = mallocated;
+      x = lread(cur_inp);
+      rt = INUM(my_time());
+      scm_gcs = 0;
+      gc_time_taken = 0;
+      if (EOF_VAL==x) return MAKINUM(EXIT_SUCCESS);
+      if (!CRDYP(cur_inp)) {	/* assure newline read (and transcripted) */
+	if (EOF==(c = lgetc(cur_inp))) break;
+	lungetc(c, cur_inp);
+      }
 #ifdef __HIGHC__
 # define __MSDOS__
 #endif
 #ifdef __MSDOS__
-    if ('\n' != CGETUN(cur_inp))
-      if OPOUTPORTP(cur_inp)	/* This case for curses window */
-	{lfflush(cur_outp); newline(cur_inp);}
-      else newline(cur_outp);
+      if ('\n' != CGETUN(cur_inp))
+	if OPOUTPORTP(cur_inp)	/* This case for curses window */
+	  {lfflush(cur_outp); newline(cur_inp);}
+	else newline(cur_outp);
 #endif
-    x = EVAL(x, (SCM)EOL);
-    repl_report();
-    iprin1(x, cur_outp, 1);
-    lputc('\n', cur_outp);
+      x = EVAL(x, (SCM)EOL);
+      repl_report();
+      iprin1(x, cur_outp, 1);
+      lputc('\n', cur_outp);
+    }
   }
+  return UNSPECIFIED;
 }
 SCM quit(n)
      SCM n;
@@ -1367,55 +1594,27 @@ SCM quit(n)
   if INUMP(n) exitval = n;
   else exitval = MAKINUM(EXIT_FAILURE);
   if (errjmp_bad) exit(INUM(exitval));
-  dowinds(EOL, ilength(dynwinds));
   longjump(CONT(rootcont)->jmpbuf, COOKIE(-1));
 }
 SCM abrt()
 {
   if (errjmp_bad) exit(EXIT_FAILURE);
-  dowinds(EOL, ilength(dynwinds));
   longjump(CONT(rootcont)->jmpbuf, COOKIE(-2));
 }
 char s_restart[] = "restart";
 SCM restart()
 {
   /* ASSERT(!dumped, UNDEFINED, "dumped can't", s_restart); */
-  dowinds(EOL, ilength(dynwinds));
   longjump(CONT(rootcont)->jmpbuf, COOKIE(-3));
 }
 
-char s_no_ep[] = "no execpath";
-#define s_execpath (s_no_ep+3)
-SCM scm_execpath(newpath)
-     SCM newpath;
-{
-  SCM retval = execpath ? makfrom0str(execpath) : BOOL_F;
-  if (UNBNDP(newpath))
-    return retval;
-  if (FALSEP(newpath) || BOOL_T==newpath) {
-    if (execpath) free(execpath);
-    execpath = 0;
-    if (BOOL_T==newpath) {
-      execpath = scm_find_executable();
-      return execpath ? makfrom0str(execpath) : BOOL_F;
-    }
-    else return retval;
-  }
-  ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_execpath);
-  if (execpath) free(execpath);
-  execpath = (char *)malloc((sizet)(LENGTH(newpath) + 1));
-  ASSERT(execpath, newpath, NALLOC, s_execpath);
-  strncpy(execpath, CHARS(newpath), LENGTH(newpath) + 1);
-  return retval;
-}
-
 #ifdef CAN_DUMP
 char s_unexec[] = "unexec";
 SCM scm_unexec(newpath)
      SCM newpath;
 {
   ASSERT(NIMP(newpath) && STRINGP(newpath), newpath, ARG1, s_unexec);
-  ASSERT(execpath, UNSPECIFIED, s_no_ep, s_unexec);
+  ASSERT(execpath, UNSPECIFIED, s_no_execpath, s_unexec);
   *loc_errobj = newpath;
   longjump(CONT(rootcont)->jmpbuf, COOKIE(-4));
 }
@@ -1469,93 +1668,89 @@ void ints_warn(str1, str2, fname, linum)
 }
 #endif
 
-#ifdef TAIL_RECURSIVE_LOAD
 SCM tryload(filename)
      SCM filename;
 {
   ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load);
   {
     SCM oloadpath = *loc_loadpath;
-    SCM oloadport = loadport;
-    long olninum = linum;
-    SCM port, newform = BOOL_F;
-    port = open_file(filename, makfromstr("r", (sizet)sizeof(char)));
-    if FALSEP(port) return port;
-    *loc_loadpath = filename;
-    loadport = port;
-    linum = 1;
-    while(1) {
-      SCM form = newform;
-      newform = lread(port);
-      if (EOF_VAL==newform) {
-	close_port(port);
-	linum = olninum;
-	loadport = oloadport;
-	*loc_loadpath = oloadpath;
-	SIDEVAL(form, EOL);
-	return BOOL_T;
-      }
-      SIDEVAL(form, EOL);
-    }
-  }
-}
-#else
-SCM tryload(filename)
-     SCM filename;
-{
-  ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_load);
-  {
-    SCM oloadpath = *loc_loadpath;
-    SCM oloadport = loadport;
-    long olninum = linum;
+    SCM oloadports = loadports;
     SCM form, port;
-    port = open_file(filename, makfromstr("r", (sizet)sizeof(char)));
+    port = open_file(filename, makfromstr("r?", (sizet)2*sizeof(char)));
     if FALSEP(port) return port;
     *loc_loadpath = filename;
-    loadport = port;
-    linum = 1;
+    loadports = cons(port, loadports);
     while(1) {
       form = lread(port);
       if (EOF_VAL==form) break;
       SIDEVAL(form, EOL);
     }
     close_port(port);
-    linum = olninum;
-    loadport = oloadport;
+    loadports = oloadports;
     *loc_loadpath = oloadpath;
   }
   return BOOL_T;
 }
-#endif
 
 #ifdef CAUTIOUS
-static void trace1(estk, n)
+static long num_frames(estk, i)
      SCM estk;
-     int n;
+     int i;
 {
-  SCM ste = VELTS(estk)[SCM_ESTK_BASE + n*SCM_ESTK_FRLEN + 2];
-  lputs("\n\n", cur_errp);
-  intprint(n, -10, cur_errp);
-  lputs(": ", cur_errp);
-  iprin1(ste, cur_errp, 1);
+  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);
+  }
+  return n;
 }
 
+extern SCM scm_trace;
 SCM scm_stack_trace()
 {
-  long n = (scm_estk_ptr - VELTS(scm_estk));
-  n = (n - SCM_ESTK_BASE)/SCM_ESTK_FRLEN;
-  if (0>=n) return BOOL_F;
+  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);
-  *scm_estk_ptr = scm_env;
-  if (n > 21) {
-    int i;
-    for (i = 0; i < 10; i++) trace1(scm_estk, n-i);
-    lputs("\n\n ...", cur_errp);
-    n = 10;
+  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++;
+    }
+    i = INUM(SCM_ESTK_PARENT_INDEX(estk));
+    estk = SCM_ESTK_PARENT(estk);
   }
-  do {
-    trace1(scm_estk, n);
-  } while (--n > 0);
+  lputc('\n', cur_errp);
   return BOOL_T;
 }
 #endif
@@ -1563,25 +1758,28 @@ SCM scm_stack_trace()
 static void err_head(str)
      char *str;
 {
+  SCM lps;
   int oerrno = errno;
   exitval = MAKINUM(EXIT_FAILURE);
   if NIMP(cur_outp) lfflush(cur_outp);
   lputc('\n', cur_errp);
-  if(BOOL_F != *loc_loadpath) {
-    iprin1(*loc_loadpath, cur_errp, 1);
+  for (lps = loadports; NIMP(lps); lps = CDR(lps)) {
+    if (lps != loadports)
+      lputs("\n  ;loaded from ", cur_errp);
+    iprin1(scm_port_filename(CAR(lps)), cur_errp, 1);
     lputs(", line ", cur_errp);
-    intprint((long)linum, 10, cur_errp);
+    iprin1(scm_port_line(CAR(lps)), cur_errp, 1);
     lputs(": ", cur_errp);
   }
+  if (NIMP(loadports) && NIMP(CDR(loadports)))
+    lputs("\n;", cur_errp);
   lfflush(cur_errp);
   errno = oerrno;
-  if (cur_errp==def_errp) {
-    if (errno>0) perror(str);
-    fflush(stderr);
-    return;
-  }
+  /* if (NIMP(cur_errp) && stderr==STREAM(cur_errp)) { ... } */
+  if (errno>0) perror(str);
+  fflush(stderr);
 }
-void warn(str1, str2)
+void scm_warn(str1, str2)
      char *str1, *str2;
 {
   err_head("WARNING");
@@ -1614,56 +1812,67 @@ SCM lperror(arg)
 }
 static void def_err_response()
 {
-  SCM obj = *loc_errobj;
+  SCM env = err_env, obj = *loc_errobj;
   DEFER_INTS;
+  if (errjmp_recursive++) {
+    lputs("RECURSIVE ERROR: ", def_errp);
+    if (TYP16(cur_errp)==tc16_sfport) {
+      cur_errp = def_errp;
+      errjmp_recursive = 0;
+      lputs("reverting to default error port\n", def_errp);
+    }
+    else exit(EXIT_FAILURE);
+  }
   err_head("ERROR");
-  lputs("ERROR: ", 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;
 #ifdef nosve
   if ((~0x1fL) & (short)err_pos) lputs(err_pos, cur_errp);
-  else if (WNA>(short)err_pos) {
+  else if (WNA > (short)err_pos) {
     lputs("Wrong type in arg", cur_errp);
-    lputc(err_pos ? '0'+(short)err_pos : ' ', cur_errp);
+    lputc((short)err_pos <= ARGn ? ' ' : '1' + (short)err_pos - ARG1, cur_errp);
   }
 #else
   if ((~0x1fL) & (long)err_pos) lputs(err_pos, cur_errp);
-  else if (WNA>(long)err_pos) {
+  else if (WNA > (long)err_pos) {
     lputs("Wrong type in arg", cur_errp);
-    lputc(err_pos ? '0'+(int)err_pos : ' ', cur_errp);
+    lputc((long)err_pos <= ARGn ? ' ' : '1' + (int)err_pos - ARG1, cur_errp);
   }
 #endif
-  else {
-    lputs(errmsgs[((int)err_pos)-WNA].msg, cur_errp);
-    goto outobj;
-  }
-  if (IMP(obj) || SYMBOLP(obj) || (TYP16(obj)==tc7_port)
-      || (NFALSEP(procedurep(obj))) || (NFALSEP(numberp(obj)))) {
-outobj:
-    if (!UNBNDP(obj)) {
-      lputs(((long)err_pos==WNA)?" given ":" ", cur_errp);
-      iprin1(obj, cur_errp, 1);
-    }
-  }
-  else lputs(" (see errobj)", cur_errp);
-#ifdef CAUTIOUS
-  scm_stack_trace();
-#endif
+  else lputs(errmsgs[((int)err_pos)-WNA].msg, cur_errp);
+  lputs(((long)err_pos==WNA)?" given ":" ", cur_errp);
+  err_pos = 0;
+  if (!UNBNDP(obj))
+    if (reset_safeport(sys_safep, 55, cur_errp))
+      if (0==setjmp(SAFEP_JMPBUF(sys_safep)))
+	iprin1(obj, sys_safep, 1);
   if UNBNDP(err_exp) goto getout;
   if NIMP(err_exp) {
-    lputs("\n; in expression: ", cur_errp);
-    if NCONSP(err_exp) iprin1(err_exp, cur_errp, 1);
-    else if (UNDEFINED==CDR(err_exp))
-      iprin1(CAR(err_exp), cur_errp, 1);
-    else iprlist("(... ", err_exp, ')', cur_errp, 1);
+    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);
+	else if (UNDEFINED==CDR(err_exp))
+	  iprin1(CAR(err_exp), sys_safep, 1);
+	else iprlist("(... ", err_exp, ')', sys_safep, 1);
+      }
   }
-  if NULLP(err_env) lputs("\n; in top level environment.", cur_errp);
+  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 {
-    SCM env = err_env;
-    if (NIMP(env) && tc16_env==CAR(env)) env = CDR(env);
     lputs("\n; in scope:", cur_errp);
     while NNULLP(env) {
       lputc('\n', cur_errp);
@@ -1673,15 +1882,17 @@ outobj:
     }
   }
  getout:
+#ifdef CAUTIOUS
+  scm_stack_trace();
+#endif
   lputc('\n', cur_errp);
   lfflush(cur_errp);
   err_exp = err_env = UNDEFINED;
   if (errjmp_bad) {
-    lputs("\nerrobj: ", cur_errp);
-    iprin1(obj, cur_errp, 1);
-    newline(cur_errp);
+    lputs("\nFATAL ERROR DURING CRITICAL CODE SECTION: ", cur_errp);
+    lputs(errjmp_bad, cur_errp);
+    lputc('\n', cur_errp);
     lroom(BOOL_T);
-    lputs("\nFATAL ERROR DURING CRITICAL CODE SECTION\n", cur_errp);
 #ifdef vms
     exit(EXIT_FAILURE);
 #else
@@ -1700,13 +1911,10 @@ void everr(exp, env, arg, pos, s_subr)
   *loc_errobj = arg;
   err_pos = pos;
   err_s_subr = s_subr;
-  if (((~0x1fL) & (long)pos) || (WNA>(long)pos) || errjmp_bad) {
-    def_err_response();
-    abrt();
-  }
-  if IMP(rootcont) exit(INUM(exitval));
-  dowinds(EOL, ilength(dynwinds));
-  longjump(CONT(rootcont)->jmpbuf, COOKIE((int)pos));
+  if (errjmp_bad || errjmp_recursive) def_err_response();
+  longjump(CONT(rootcont)->jmpbuf,
+	   (~0x1fL) & (long)pos || (WNA > (long)pos) ?
+	   COOKIE(1) : COOKIE((int)pos));
   /* will do error processing at stack base */
 }
 void wta(arg, pos, s_subr)
@@ -1733,25 +1941,34 @@ char s_cur_errp[] = "set-current-error-port";
 SCM set_inp(port)
      SCM port;
 {
-  SCM oinp = cur_inp;
-  ASSERT(NIMP(port) && OPINPORTP(port), port, ARG1, s_cur_inp);
+  SCM oinp;
+  ASSERT(NIMP(port) && INPORTP(port), port, ARG1, s_cur_inp);
+  DEFER_INTS;
+  oinp = cur_inp;
   cur_inp = port;
+  ALLOW_INTS;
   return oinp;
 }
 SCM set_outp(port)
      SCM port;
 {
-  SCM ooutp = cur_outp;
-  ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_cur_outp);
+  SCM ooutp;
+  ASSERT(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_outp);
+  DEFER_INTS;
+  ooutp = cur_outp;
   cur_outp = port;
+  ALLOW_INTS;
   return ooutp;
 }
 SCM set_errp(port)
      SCM port;
 {
-  SCM oerrp = cur_errp;
-  ASSERT(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_cur_errp);
+  SCM oerrp;
+  ASSERT(NIMP(port) && OUTPORTP(port), port, ARG1, s_cur_errp);
+  DEFER_INTS;
+  oerrp = cur_errp;
   cur_errp = port;
+  ALLOW_INTS;
   return oerrp;
 }
 static char s_isatty[] = "isatty?";
@@ -1767,7 +1984,6 @@ static iproc subr0s[] = {
 	{&s_cur_inp[4], cur_input_port},
 	{&s_cur_outp[4], cur_output_port},
 	{&s_cur_errp[4], cur_error_port},
-	{"transcript-off", trans_off},
 	{"program-arguments", prog_args},
 	{"line-number", line_num},
 	{"abort", abrt},
@@ -1781,7 +1997,6 @@ static iproc subr1s[] = {
 	{s_cur_inp, set_inp},
 	{s_cur_outp, set_outp},
 	{s_cur_errp, set_errp},
-	{"transcript-on", trans_on},
 	{s_tryload, tryload},
 	{s_load_string, scm_load_string},
 	{s_eval_string, scm_eval_string},
@@ -1790,6 +2005,9 @@ static iproc subr1s[] = {
 	{s_tryarb, tryarb},
 	{s_relarb, relarb},
 	{s_isatty, l_isatty},
+	{s_port_line, scm_port_line},
+	{s_port_col, scm_port_col},
+	{s_port_filename, scm_port_filename},
 	{0, 0}};
 
 static iproc subr1os[] = {
@@ -1797,15 +2015,12 @@ static iproc subr1os[] = {
 	{s_read_char, scm_read_char},
 	{s_peek_char, peek_char},
 	{s_newline, newline},
+	{s_freshline, scm_freshline},
 	{s_flush, lflush},
-#ifndef GO32
 	{s_char_readyp, char_readyp},
-#endif
 	{"quit", quit},
 	{"verbose", prolixity},
 	{"errno", lerrno},
-	{s_execpath, scm_execpath},
-	{"find-init-file", scm_find_impl},
 	{"room", lroom},
 	{0, 0}};
 
@@ -1827,17 +2042,15 @@ void init_repl( iverbose )
 	sysintern(s_ccl, MAKINUM(CHAR_CODE_LIMIT));
 	loc_errobj = &CDR(sysintern("errobj", UNDEFINED));
 	loc_loadpath = &CDR(sysintern("*load-pathname*", BOOL_F));
-	transcript = BOOL_F;
-	trans = 0;
-	linum = 1;
+	loc_readsharp = &CDR(sysintern("read:sharp", UNDEFINED));
+	loc_readsharpc = &CDR(sysintern("read:sharp-char", 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);
-#ifndef GO32
 	add_feature(s_char_readyp);
-#endif
+	make_subr(s_wfi, tc7_lsubr, wait_for_input);
 #ifdef CAN_DUMP
 	add_feature("dump");
 	scm_ldstr("\
@@ -1860,8 +2073,5 @@ void final_repl()
 {
   loc_errobj = (SCM *)&tmp_errobj;
   loc_loadpath = (SCM *)&tmp_loadpath;
-  loadport = UNDEFINED;
-  transcript = BOOL_F;
-  trans = 0;
-  linum = 1;
+  loadports = EOL;
 }