Import Upstream version 5d9upstream/5d9

1 files changed, 296 insertions, 255 deletions

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