Import Upstream version 5e4upstream/5e4

1 files changed, 242 insertions, 190 deletions

diff --git a/repl.c b/repl.c
index b6d2602..5fa98d9 100644
--- a/repl.c
+++ b/repl.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1990-2002 Free Software Foundation, Inc.
+/* Copyright (C) 1990-2006 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
@@ -67,6 +67,10 @@ void	scm_fill_freelist P((void));
 # include <ctype.h>
 #endif
 
+#ifdef linux
+# include <ctype.h>
+#endif
+
 #ifdef ARM_ULIB
 # include <termio.h>
 int set_erase()
@@ -88,8 +92,8 @@ unsigned char uppers[] = "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
 void init_tables()
 {
   int i;
-  for(i = 0;i<CHAR_CODE_LIMIT;i++) upcase[i] = downcase[i] = i;
-  for(i = 0;i<sizeof lowers/sizeof(char);i++) {
+  for (i = 0;i<CHAR_CODE_LIMIT;i++) upcase[i] = downcase[i] = i;
+  for (i = 0;i<sizeof lowers/sizeof(char);i++) {
     upcase[lowers[i]] = uppers[i];
     downcase[uppers[i]] = lowers[i];
   }
@@ -155,15 +159,16 @@ 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 flgs, const 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 SCM scm_lread1 P((SCM port, int flgs, const char *what));
+static SCM scm_lreadr P((SCM tok_buf, SCM port, int flgs));
+static SCM scm_lreadpr P((SCM tok_buf, SCM port, int flgs));
+static SCM scm_lreadparen P((SCM tok_buf, SCM port, int flgs, char *name));
+static SCM scm_lread_rec P((SCM tok_buf, SCM port));
+static sizet scm_read_token P((int ic, SCM tok_buf, SCM port, int flgs));
 static void err_head P((char *str));
+extern int case_sensitize_symbols; /* 0 or 8 */
 
-void intprint(n, radix, port)
+void scm_intprint(n, radix, port)
      long n;
      int radix;
      SCM port;
@@ -172,7 +177,7 @@ void intprint(n, radix, port)
   lfwrite(num_buf, (sizet)sizeof(char), iint2str(n, radix, num_buf), port);
 }
 
-void ipruk(hdr, ptr, port)
+void scm_ipruk(hdr, ptr, port)
      char *hdr;
      SCM ptr;
      SCM port;
@@ -181,17 +186,17 @@ void ipruk(hdr, ptr, port)
   lputs(hdr, port);
   if (scm_cell_p(ptr)) {
     lputs(" (0x", port);
-    intprint(CAR(ptr), -16, port);
+    scm_intprint(CAR(ptr), -16, port);
     lputs(" . 0x", port);
-    intprint(CDR(ptr), -16, port);
+    scm_intprint(CDR(ptr), -16, port);
     lputs(") @", port);
   }
   lputs(" 0x", port);
-  intprint(ptr, -16, port);
+  scm_intprint(ptr, -16, port);
   lputc('>', port);
 }
 
-void iprlist(hdr, exp, tlr, port, writing)
+void scm_iprlist(hdr, exp, tlr, port, writing)
      char *hdr, tlr;
      SCM exp;
      SCM port;
@@ -199,32 +204,32 @@ void iprlist(hdr, exp, tlr, port, writing)
 {
   lputs(hdr, port);
   /* CHECK_INTS; */
-  iprin1(CAR(exp), port, writing);
+  scm_iprin1(CAR(exp), port, writing);
   exp = GCCDR(exp); /* CDR(exp); */
-  for(;NIMP(exp);exp = GCCDR(exp) /* CDR(exp)*/) {
+  for (;NIMP(exp);exp = GCCDR(exp) /* CDR(exp)*/) {
     if (!scm_cell_p(~1L & exp)) break;
     if (NECONSP(exp)) break;
     lputc(' ', port);
     /* CHECK_INTS; */
-    iprin1(CAR(exp), port, writing);
+    scm_iprin1(CAR(exp), port, writing);
   }
   if (NNULLP(exp)) {
     lputs(" . ", port);
-    iprin1(exp, port, writing);
+    scm_iprin1(exp, port, writing);
   }
   lputc(tlr, port);
 }
-void iprin1(exp, port, writing)
+void scm_iprin1(exp, port, writing)
      SCM exp;
      SCM port;
      int writing;
 {
   register long i;
 taloop:
-  switch (7 & (int)exp) {
+  switch (7 & PTR2INT(exp)) {
   case 2:
   case 6:
-    intprint(INUM(exp), 10, port);
+    scm_intprint(INUM(exp), 10, port);
     break;
   case 4:
     if (ICHRP(exp)) {
@@ -237,27 +242,27 @@ taloop:
 	lputs(charnames[(sizeof charnames/sizeof(char *))-1], port);
 #endif /* ndef EBCDIC */
       else if (i > '\177')
-	intprint(i, -8, port);
+	scm_intprint(i, -8, port);
       else lputc((int)i, port);
     }
     else if (SCM_LINUMP(exp)) {
       lputs("#<line ", port);
-      intprint(SCM_LINUM(exp), -10, port);
+      scm_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)) {
       lputs("#@", port);
-      intprint((long)IFRAME(exp), -10, port);
+      scm_intprint((long)IFRAME(exp), -10, port);
       lputc(ICDRP(exp)?'-':'+', port);
-      intprint((long)IDIST(exp), -10, port);
+      scm_intprint((long)IDIST(exp), -10, port);
     }
     else goto idef;
     break;
   case 1:			/* gloc */
     if (!scm_cell_p(exp-1)) {
-      ipruk("gloc", exp, port);
+      scm_ipruk("gloc", exp, port);
       break;
     }
     lputs("#@", port);
@@ -270,11 +275,11 @@ taloop:
     goto taloop;
   default:
   idef:
-    ipruk("immediate", exp, port);
+    scm_ipruk("immediate", exp, port);
     break;
   case 0:
     if (!scm_cell_p(exp)) {
-      ipruk("heap", exp, port);
+      scm_ipruk("heap", exp, port);
       break;
     }
     switch TYP7(exp) {
@@ -282,8 +287,8 @@ taloop:
       if (CAR(exp) != IM_LET) {
 	lputs("(#@call ", port);
 	exp = CDR(exp);
-	iprin1(CAR(exp), port, writing);
-	iprlist(" ", CAR(CDR(exp)), ')', port, writing);
+	scm_iprin1(CAR(exp), port, writing);
+	scm_iprlist(" ", CAR(CDR(exp)), ')', port, writing);
 	break;
       }
       /* else fall through */
@@ -297,7 +302,7 @@ taloop:
     case tcs_cons_chflag:
     case tcs_cons_gloc:
     case tcs_cons_nimcar:
-      iprlist("(", exp, ')', port, writing);
+      scm_iprlist("(", exp, ')', port, writing);
       break;
     case tcs_closures:
       scm_princlosure(exp, port, writing);
@@ -305,7 +310,7 @@ taloop:
     case tc7_string:
       if (writing) {
 	lputc('\"', port);
-	for(i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) {
+	for (i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) {
 	case '\"':
 	case '\\':
 	  lputc('\\', port);
@@ -317,14 +322,16 @@ taloop:
       }
     case tcs_symbols:
       if (writing) {		/* slashified symbol */
-	for(i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) {
-	case '\\': case '\"': case '\'': case '(': case ')': case '#':
+	for (i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) {
 	case 'A': case 'B': case 'C': case 'D': case 'E':
 	case 'F': case 'G': case 'H': case 'I': case 'J':
 	case 'K': case 'L': case 'M': case 'N': case 'O':
 	case 'P': case 'Q': case 'R': case 'S': case 'T':
 	case 'U': case 'V': case 'W': case 'X': case 'Y': case 'Z':
+	  if (case_sensitize_symbols) goto skipit;
+	case '\\': case '\"': case '\'': case '(': case ')': case '#':
 	  lputc('\\', port);
+	skipit:
 	default:
 	  lputc(CHARS(exp)[i], port);
 	}
@@ -335,14 +342,14 @@ taloop:
       break;
     case tc7_vector:
       lputs("#(", port);
-      for(i = 0;i+1<LENGTH(exp);++i) {
+      for (i = 0;i+1<LENGTH(exp);++i) {
 	/* CHECK_INTS; */
-	iprin1(VELTS(exp)[i], port, writing);
+	scm_iprin1(VELTS(exp)[i], port, writing);
 	lputc(' ', port);
       }
       if (i<LENGTH(exp)) {
 	/* CHECK_INTS; */
-	iprin1(VELTS(exp)[i], port, writing);
+	scm_iprin1(VELTS(exp)[i], port, writing);
       }
       lputc(')', port);
       break;
@@ -360,9 +367,9 @@ taloop:
 #ifdef CCLO
       if (tc16_cclo==TYP16(exp)) {
 	lputs("#<compiled-closure ", port);
-	iprin1(CCLO_SUBR(exp), port, writing);
+	scm_iprin1(CCLO_SUBR(exp), port, writing);
 	lputc(' ', port);
-	iprin1(VELTS(exp)[1], port, writing);
+	scm_iprin1(VELTS(exp)[1], port, writing);
 	lputc('>', port);
 	break;
       }
@@ -373,9 +380,9 @@ taloop:
       break;
     case tc7_contin:
       lputs("#<continuation ", port);
-      intprint(LENGTH(exp), -10, port);
+      scm_intprint(LENGTH(exp), -10, port);
       lputs(" @ ", port);
-      intprint((long)CHARS(exp), -16, port);
+      scm_intprint((long)CHARS(exp), -16, port);
       lputc('>', port);
       break;
     case tc7_port:
@@ -393,7 +400,7 @@ taloop:
       if (i<numsmob && smobs[i].print && (smobs[i].print)(exp, port, writing))
 	break;
       goto punk;
-    default: punk: ipruk("type", exp, port);
+    default: punk: scm_ipruk("type", exp, port);
     }
   }
 }
@@ -605,8 +612,8 @@ int scm_io_error(port, what)
       lputs(";;", cur_errp);
       lputs(what, cur_errp);
       lputs(": closing pipe ", cur_errp);
-      iprin1(port, cur_errp, 1);
-      newline(cur_errp);
+      scm_iprin1(port, cur_errp, 1);
+      scm_newline(cur_errp);
     }
     close_port(port);
     if (*loc_broken_pipe && NIMP(*loc_broken_pipe))
@@ -623,47 +630,41 @@ int scm_io_error(port, what)
   return 0;			/* squelch warning */
 }
 
-static char s_fflush[] = "fflush";
 void lfflush(port)		/* internal SCM call */
      SCM port;
 {
   sizet i = PTOBNUM(port);
   while ((ptobs[i].fflush)(STREAM(port)) &&
-	 scm_io_error(port, s_fflush))
+	 scm_io_error(port, "lfflush"))
     ;
 }
-static char	s_flush[] = "force-output";
-SCM lflush(port)		/* user accessible as force-output */
+static char	s_force_output[] = "force-output";
+SCM scm_force_output(port)
      SCM port;
 {
-	if (UNBNDP(port)) port = cur_outp;
-	else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_flush);
-	{
-	  sizet i = PTOBNUM(port);
-	  while ((ptobs[i].fflush)(STREAM(port)) &&
-		 scm_io_error(port, s_fflush))
-	    ;
-	  return UNSPECIFIED;
-	}
+  if (UNBNDP(port)) port = cur_outp;
+  else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG1, s_force_output);
+  lfflush(port);
+  return UNSPECIFIED;
 }
 
-SCM lwrite(obj, port)
+SCM scm_write(obj, port)
      SCM obj, port;
 {
 	if (UNBNDP(port)) port = cur_outp;
 	else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_write);
-	iprin1(obj, port, 1);
+	scm_iprin1(obj, port, 1);
 	return UNSPECIFIED;
 }
-SCM display(obj, port)
+SCM scm_display(obj, port)
      SCM obj, port;
 {
 	if (UNBNDP(port)) port = cur_outp;
 	else ASRTER(NIMP(port) && OPOUTPORTP(port), port, ARG2, s_display);
-	iprin1(obj, port, 0);
+	scm_iprin1(obj, port, 0);
 	return UNSPECIFIED;
 }
-SCM newline(port)
+SCM scm_newline(port)
      SCM port;
 {
 	if (UNBNDP(port)) port = cur_outp;
@@ -672,7 +673,7 @@ SCM newline(port)
 	if (port==cur_outp) lfflush(port);
 	return UNSPECIFIED;
 }
-SCM write_char(chr, port)
+SCM scm_write_char(chr, port)
      SCM chr, port;
 {
 	if (UNBNDP(port)) port = cur_outp;
@@ -745,7 +746,7 @@ sizet lfwrite(ptr, size, nitems, port)
   sizet ret, i = PTOBNUM(port);
   do {
     ret = (ptobs[i].fwrite)(ptr, size, nitems, STREAM(port));
-  }  while(nitems != ret && scm_io_error(port, "fwrite"));
+  } while(nitems != ret && scm_io_error(port, "fwrite"));
   if (CRDY & CAR(port)) {
     sizet j;
     i = SCM_PORTNUM(port);
@@ -823,7 +824,7 @@ SCM scm_read_char(port)
   if (EOF==c) return EOF_VAL;
   return MAKICHR(c);
 }
-SCM peek_char(port)
+SCM scm_peek_char(port)
   SCM port;
 {
 	int c;
@@ -873,42 +874,42 @@ static char s_read_numbered[] = "read-numbered";
 SCM scm_read(port)
      SCM port;
 {
-  return lread1(port, 0, s_read);
+  return scm_lread1(port, case_sensitize_symbols, s_read);
 }
 
 SCM scm_read_for_load(port)
      SCM port;
 {
-  return lread1(port, 4, s_read_for_load);
+  return scm_lread1(port, 4 | case_sensitize_symbols, s_read_for_load);
 }
 
 #ifndef MEMOIZE_LOCALS
 SCM scm_read_numbered(port)
      SCM port;
 {
-  return lread1(port, 6, s_read_numbered);
+  return scm_lread1(port, 6 | case_sensitize_symbols, s_read_numbered);
 }
 #endif
 
-static SCM lread1(port, flgs, what)
+static SCM scm_lread1(port, flgs, what)
      SCM port;
      int flgs;
      const char *what;
 {
-	int c;
-	SCM tok_buf;
-	if (UNBNDP(port)) port = cur_inp;
-	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, flgs)));
-	return tok_buf;
+  int c;
+  SCM tok_buf;
+  if (UNBNDP(port)) port = cur_inp;
+  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 = scm_lreadr(tok_buf, port, flgs)));
+  return tok_buf;
 }
 static SCM *loc_loadsharp = 0, *loc_readsharp = 0, *loc_charsharp = 0;
-static SCM lreadpr(tok_buf, port, flgs)
+static SCM scm_lreadpr(tok_buf, port, flgs)
      SCM tok_buf;
      SCM port;
      int flgs;
@@ -916,7 +917,7 @@ static SCM lreadpr(tok_buf, port, flgs)
   int c;
   sizet j;
   SCM p;
-  if (2==(3&flgs)) return lread_rec(tok_buf, port);
+  if (2==(3 & flgs)) return scm_lread_rec(tok_buf, port);
  tryagain:
   c = flush_ws(port);
   switch (c) {
@@ -924,15 +925,15 @@ static SCM lreadpr(tok_buf, port, flgs)
 #ifdef BRACKETS_AS_PARENS
   case '[':
 #endif
-  case '(': return lreadparen(tok_buf, port, flgs, s_list);
+  case '(': return scm_lreadparen(tok_buf, port, flgs, s_list);
 #ifdef BRACKETS_AS_PARENS
   case ']':
 #endif
   case ')': return UNDEFINED; /* goto tryagain; */
   case '\'': return cons2(i_quote,
-			  lreadr(tok_buf, port, flgs), EOL);
+			  scm_lreadr(tok_buf, port, flgs), EOL);
   case '`': return cons2(i_quasiquote,
-			 lreadr(tok_buf, port, flgs), EOL);
+			 scm_lreadr(tok_buf, port, flgs), EOL);
   case ',':
     c = lgetc(port);
     if ('@'==c) p = i_uq_splicing;
@@ -940,7 +941,7 @@ static SCM lreadpr(tok_buf, port, flgs)
       lungetc(c, port);
       p = i_unquote;
     }
-    return cons2(p, lreadr(tok_buf, port, flgs), EOL);
+    return cons2(p, scm_lreadr(tok_buf, port, flgs), EOL);
   case '#':
     c = lgetc(port);
     switch (c) {
@@ -948,7 +949,7 @@ static SCM lreadpr(tok_buf, port, flgs)
     case '[':
 #endif
     case '(':
-      p = lreadparen(tok_buf, port, flgs, s_vector);
+      p = scm_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;
@@ -959,7 +960,7 @@ static SCM lreadpr(tok_buf, port, flgs)
       c = '#';
       goto num;
     case '*':
-      j = read_token(c, tok_buf, port);
+      j = scm_read_token(c, tok_buf, port, flgs);
       p = istr2bve(CHARS(tok_buf)+1, (long)(j-1));
       if (NFALSEP(p)) return p;
       else goto unkshrp;
@@ -968,11 +969,11 @@ static SCM lreadpr(tok_buf, port, flgs)
       if ('\\'==c) {
 	CHARS(tok_buf)[0] = c;
 	j = 1;
-      } else j = read_token(c, tok_buf, port);
+      } else j = scm_read_token(c, tok_buf, port, flgs);
       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))))
+	    && (0==strcasecmp(charnames[c], CHARS(tok_buf))))
 	  return MAKICHR(charnums[c]);
       if (loc_charsharp && NIMP(*loc_charsharp)) {
 	resizuve(tok_buf, MAKINUM(j));
@@ -1002,11 +1003,11 @@ static SCM lreadpr(tok_buf, port, flgs)
       {
 	SCM reader =
 #ifndef MEMOIZE_LOCALS
-	  (3&flgs) ? p_read_numbered :
+	  (3 & flgs) ? p_read_numbered :
 #endif
-	  ((4&flgs) ? p_read_for_load : p_read);
+	  ((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)) {
+	if ((4 & flgs) && loc_loadsharp && NIMP(*loc_loadsharp)) {
 	  p = apply(*loc_loadsharp, args, EOL);
 	  if (UNSPECIFIED==p) goto tryagain;
 	  return p;
@@ -1046,7 +1047,7 @@ static SCM lreadpr(tok_buf, port, flgs)
   case DIGITS:
   case '.': case '-': case '+':
   num:
-    j = read_token(c, tok_buf, port);
+    j = scm_read_token(c, tok_buf, port, flgs);
     p = istring2number(CHARS(tok_buf), (long)j, 10L);
     if (NFALSEP(p)) return p;
     if (c=='#') {
@@ -1059,36 +1060,36 @@ static SCM lreadpr(tok_buf, port, flgs)
     }
     goto tok;
   default:
-    j = read_token(c, tok_buf, port);
+    j = scm_read_token(c, tok_buf, port, flgs);
   tok:
     p = intern(CHARS(tok_buf), j);
     return CAR(p);
   }
 }
-static SCM lreadr(tok_buf, port, flgs)
+static SCM scm_lreadr(tok_buf, port, flgs)
      SCM tok_buf;
      SCM port;
      int flgs;
 {
-  SCM ans = lreadpr(tok_buf, port, flgs);
+  SCM ans = scm_lreadpr(tok_buf, port, flgs);
   switch (ans) {
   case UNDEFINED:
     scm_warn("unexpected \")\"", "", port);
-    return lreadpr(tok_buf, port, flgs);
+    return scm_lreadpr(tok_buf, port, flgs);
   }
   return ans;
 }
-static SCM lread_rec(tok_buf, port)
+static SCM scm_lread_rec(tok_buf, port)
      SCM tok_buf;
      SCM port;
 {
   SCM line, form;
   int c = flush_ws(port);
-  switch(c) {
+  switch (c) {
   default:
     lungetc(c, port);
     line = scm_port_line(port);
-    form = lreadpr(tok_buf, port, 5);
+    form = scm_lreadpr(tok_buf, port, 5);
     if (NFALSEP(line) && NIMP(form) &&
 	(CONSP(form) || VECTORP(form))) {
       return cons(SCM_MAKE_LINUM(INUM(line)), form);
@@ -1105,37 +1106,38 @@ static SCM lread_rec(tok_buf, port)
 #ifdef _UNICOS
 _Pragma("noopt");		/* # pragma _CRI noopt */
 #endif
-static sizet read_token(ic, tok_buf, port)
+static sizet scm_read_token(ic, tok_buf, port, flgs)
      int ic;
      SCM tok_buf;
      SCM port;
+     int flgs;
 {
-	register sizet j = 1;
-	register int c = ic;
-	register char *p = CHARS(tok_buf);
-	p[0] = '\\'==c ? lgetc(port) : downcase[c];
-	while(1) {
-		if (j+1 >= LENGTH(tok_buf)) p = grow_tok_buf(tok_buf);
-		switch (c = lgetc(port)) {
+  register sizet j = 1;
+  register int c = ic;
+  register char *p = CHARS(tok_buf);
+  p[0] = '\\'==c ? lgetc(port) : 8 & flgs ? c : downcase[c];
+  while(1) {
+    if (j+1 >= LENGTH(tok_buf)) p = grow_tok_buf(tok_buf);
+    switch (c = lgetc(port)) {
 #ifdef BRACKETS_AS_PARENS
-		case '[': case ']':
+    case '[': case ']':
 #endif
-		case '(': case ')': case '\"': case ';':
-		case ',': case '`':
-		  /* case '#': */
-		case WHITE_SPACES:
-		case LINE_INCREMENTORS:
-			lungetc(c, port);
-		case EOF:
-			p[j] = 0;
-			return j;
-		case '\\':	/* slashified symbol */
-			p[j++] = lgetc(port);
-			break;
-		default:
-			p[j++] = downcase[c];
-		}
-	}
+    case '(': case ')': case '\"': case ';':
+    case ',': case '`':
+      /* case '#': */
+    case WHITE_SPACES:
+    case LINE_INCREMENTORS:
+      lungetc(c, port);
+    case EOF:
+      p[j] = 0;
+      return j;
+    case '\\':	/* slashified symbol */
+      p[j++] = lgetc(port);
+      break;
+    default:
+      p[j++] = 8 & flgs ? c : downcase[c];
+    }
+  }
 }
 #ifdef _UNICOS
 _Pragma("opt");			/* # pragma _CRI opt */
@@ -1150,28 +1152,28 @@ _Pragma("opt");			/* # pragma _CRI opt */
 /* 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)
+static SCM scm_lreadparen(tok_buf, port, flgs, name)
      SCM tok_buf;
      SCM port;
      int flgs;
      char *name;
 {
   SCM lst, fst,
-    tmp = lreadpr(tok_buf, port, (4&flgs) | ((3&flgs) ? 2 : 0));
+    tmp = scm_lreadpr(tok_buf, port, (0xC & flgs) | ((3 & flgs) ? 2 : 0));
   if (UNDEFINED==tmp) return EOL;
   if (i_dot==tmp) {
-    fst = lreadr(tok_buf, port, (4&flgs) | ((3&flgs) ? 1 : 0));
+    fst = scm_lreadr(tok_buf, port, (0xC & flgs) | ((3 & flgs) ? 1 : 0));
   closeit:
-    tmp = lreadpr(tok_buf, port, 0);
+    tmp = scm_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, (4&flgs) | ((3&flgs) ? 2 : 0)))) {
+	 (tmp = scm_lreadpr(tok_buf, port, (0xC & 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, (4&flgs) | ((3&flgs) ? 1 : 0));
+      CDR(lst) = scm_lreadr(tok_buf, port, (0xC & flgs) | ((3 & flgs) ? 1 : 0));
       goto closeit;
     }
     lst = (CDR(lst) = cons(tmp, EOL));
@@ -1233,7 +1235,7 @@ static int prinarb(exp, port, writing)
 {
   lputs("#<arbiter ", port);
   if (CAR(exp) & (1L<<16)) lputs("locked ", port);
-  iprin1(CDR(exp), port, writing);
+  scm_iprin1(CDR(exp), port, writing);
   lputc('>', port);
   return !0;
 }
@@ -1359,7 +1361,7 @@ SCM scm_top_level(initpath, toplvl_fun)
   if (i) i = UNCOOK(i);
 #endif
  drloop:
-  switch ((int)i) {
+  switch (PTR2INT(i)) {
   default:
     {
       char *name = errmsgs[i-WNA].s_response;
@@ -1376,7 +1378,7 @@ SCM scm_top_level(initpath, toplvl_fun)
     exitval = MAKINUM(EXIT_SUCCESS);
     errjmp_bad = (char *)0;
     errjmp_recursive = 0;
-    lflush(sys_errp);
+    if (NIMP(sys_errp) && OPOUTPORTP(sys_errp)) lfflush(sys_errp);
     errno = 0;
     SIG_deferred = 0;
     deferred_proc = 0;
@@ -1404,7 +1406,7 @@ SCM scm_top_level(initpath, toplvl_fun)
     ints_disabled = 1;
     errjmp_bad = (char *)0;
     errjmp_recursive = 0;
-    lflush(sys_errp);
+    if (NIMP(sys_errp) && OPOUTPORTP(sys_errp)) lfflush(sys_errp);
     SIG_deferred = 0;
     deferred_proc = 0;
     gc_hook_active = 0;
@@ -1416,8 +1418,8 @@ SCM scm_top_level(initpath, toplvl_fun)
     if (NIMP(loadports) && OPINPORTP(CAR(loadports))) {
       if (scm_verbose > 1) {
 	lputs("; Aborting load (closing): ", cur_errp);
-	display(*loc_loadpath, cur_errp);
-	newline(cur_errp);
+	scm_display(*loc_loadpath, cur_errp);
+	scm_newline(cur_errp);
       }
       close_port(CAR(loadports)); /* close loading file. */
     }
@@ -1436,8 +1438,8 @@ SCM scm_top_level(initpath, toplvl_fun)
     dowinds(EOL);
     if (MAKINUM(EXIT_SUCCESS) != exitval) {
       lputs("; program args: ", cur_errp);
-      lwrite(progargs, cur_errp);
-      newline(cur_errp);
+      scm_write(progargs, cur_errp);
+      scm_newline(cur_errp);
     }
     return exitval;
   case -3:			/* restart. */
@@ -1506,6 +1508,50 @@ SCM scm_port_col(port)
   }
   return MAKINUM(col);
 }
+
+static char	s_file_position[] = "file-position";
+SCM scm_file_position(port, pos)
+     SCM port, pos;
+{
+  ASRTER(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_position);
+  if (UNBNDP(pos) || FALSEP(pos)) {
+    long ans;
+    SYSCALL(ans = ftell(STREAM(port)););
+    if (ans < 0) return BOOL_F;
+    if (CRDYP(port)) ans--;
+    return MAKINUM(ans);
+  }
+  ASRTER((INUMP(pos) && (INUM(pos) >= 0))
+	 || (NIMP(pos) && (TYP16(pos)==tc16_bigpos)),
+	 port, ARG2, s_file_position);
+#ifndef RECKLESS
+  if (TRACKED & SCM_PORTFLAGS(port)) {
+    if (INUM0==pos) {
+      int i = SCM_PORTNUM(port);
+      scm_port_table[i].line = 1L;
+      scm_port_table[i].col = 1;
+    }
+    else {
+      if (2 <= verbose)
+	scm_warn("Setting file position for tracked port: ", "", port);
+      SCM_PORTFLAGS(port) &= (~TRACKED);
+    }
+  }
+#endif
+  {
+    int ans;
+    CLRDY(port);		/* Clear ungetted char */
+    SYSCALL(ans = fseek(STREAM(port), INUM(pos), 0););
+#ifdef HAVE_PIPE
+# ifdef ESPIPE
+    if (!OPIOPORTP(port))
+      ASRTER(ESPIPE != errno, port, ARG1, s_file_position);
+# endif
+#endif
+    return ans ? BOOL_F : BOOL_T;
+  }
+}
+
 static char s_port_filename[] = "port-filename";
 SCM scm_port_filename(port)
      SCM port;
@@ -1535,7 +1581,7 @@ void growth_mon(obj, size, units, grewp)
       lputs((grewp ? "; grew " : "; shrank "), sys_errp);
       lputs(obj, sys_errp);
       lputs(" to ", sys_errp);
-      intprint(size, -10, sys_errp);
+      scm_intprint(size, -10, sys_errp);
       lputc(' ', sys_errp);
       lputs(units, sys_errp);
       if ((verbose > 4) && (obj==s_heap)) heap_report();
@@ -1563,15 +1609,15 @@ void gc_end()
   gc_rt = INUM(my_time()) - gc_rt;
   gc_time_taken = gc_time_taken + gc_rt;
   if (verbose > 4) {
-    intprint(time_in_msec(gc_rt), -10, sys_errp);
+    scm_intprint(time_in_msec(gc_rt), -10, sys_errp);
     lputs(".ms cpu, ", sys_errp);
-    intprint(gc_cells_collected, -10, sys_errp);
+    scm_intprint(gc_cells_collected, -10, sys_errp);
     lputs(" cells, ", sys_errp);
-    intprint(gc_malloc_collected, -10, sys_errp);
+    scm_intprint(gc_malloc_collected, -10, sys_errp);
     lputs(" malloc, ", sys_errp);
-    intprint(gc_syms_collected, -10, sys_errp);
+    scm_intprint(gc_syms_collected, -10, sys_errp);
     lputs(" syms, ", sys_errp);
-    intprint(gc_ports_collected, -10, sys_errp);
+    scm_intprint(gc_ports_collected, -10, sys_errp);
     lputs(" ports collected\n", sys_errp);
   }
 }
@@ -1590,26 +1636,26 @@ void repl_report()
   if (verbose > 2) {
     lfflush(cur_outp);
     lputs(";Evaluation took ", cur_errp);
-    intprint(time_in_msec(INUM(my_time())-rt), -10, cur_errp);
+    scm_intprint(time_in_msec(INUM(my_time())-rt), -10, cur_errp);
     lputs(".ms (", cur_errp);
-    intprint(time_in_msec(gc_time_taken), -10, cur_errp);
+    scm_intprint(time_in_msec(gc_time_taken), -10, cur_errp);
     lputs(".ms in gc) ", cur_errp);
-    intprint(cells_allocated - lcells_allocated, -10, cur_errp);
+    scm_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);
+    scm_intprint(scm_env_work, -10, cur_errp);
     lputs(" env, ", cur_errp);
-    intprint(mallocated - lmallocated, -10, cur_errp);
+    scm_intprint(mallocated - lmallocated, -10, cur_errp);
     lputs(".B other\n", cur_errp);
     if (verbose > 3) {
       lputc(';', cur_errp);
-      intprint(scm_gcs, -10, cur_errp);
+      scm_intprint(scm_gcs, -10, cur_errp);
       lputs( " gc, ", cur_errp);
-      intprint(scm_egcs, -10, cur_errp);
+      scm_intprint(scm_egcs, -10, cur_errp);
       lputs( " ecache gc, ", cur_errp);
-      intprint(scm_clo_moved, -10, cur_errp);
+      scm_intprint(scm_clo_moved, -10, cur_errp);
       lputs(" env migrated from closures, ", cur_errp);
-      intprint(scm_stk_moved, -10, cur_errp);
+      scm_intprint(scm_stk_moved, -10, cur_errp);
       lputs(" from stack\n", cur_errp);
     }
     lfflush(cur_errp);
@@ -1631,18 +1677,18 @@ void scm_brk_report()
     dif2 = (scm_curbrk - scm_dumped_brk)/1024;
 
   lputs("initial brk = 0x", cur_errp);
-  intprint(scm_init_brk, -16, cur_errp);
+  scm_intprint(scm_init_brk, -16, cur_errp);
   if (dumped) {
     lputs(", dumped = 0x", cur_errp);
-    intprint(scm_dumped_brk, -16, cur_errp);
+    scm_intprint(scm_dumped_brk, -16, cur_errp);
   }
   lputs(", current = 0x", cur_errp);
-  intprint(scm_curbrk, -16, cur_errp);
+  scm_intprint(scm_curbrk, -16, cur_errp);
   lputs("; ", cur_errp);
-  intprint(dif1, 10, cur_errp);
+  scm_intprint(dif1, 10, cur_errp);
   if (dumped) {
     lputs(dif2 < 0 ? " - " : " + ", cur_errp);
-    intprint(dif2 < 0 ? -dif2 : dif2, 10, cur_errp);
+    scm_intprint(dif2 < 0 ? -dif2 : dif2, 10, cur_errp);
   }
   lputs(".kiB\n", cur_errp);
 }
@@ -1650,13 +1696,13 @@ void scm_brk_report()
 SCM lroom(opt)
      SCM opt;
 {
-  intprint(cells_allocated, -10, cur_errp);
+  scm_intprint(cells_allocated, -10, cur_errp);
   lputs(" out of ", cur_errp);
-  intprint(heap_cells, -10, cur_errp);
+  scm_intprint(heap_cells, -10, cur_errp);
   lputs(" cells in use, ", cur_errp);
-  intprint(mallocated, -10, cur_errp);
+  scm_intprint(mallocated, -10, cur_errp);
   lputs(".B allocated (of ", cur_errp);
-  intprint(mtrigger, 10, cur_errp);
+  scm_intprint(mtrigger, 10, cur_errp);
   lputs(")\n", cur_errp);
   if (!UNBNDP(opt)) {
 #ifndef LACK_SBRK
@@ -1671,20 +1717,20 @@ SCM lroom(opt)
 }
 void scm_ecache_report()
 {
-  intprint(scm_estk_size, 10 , cur_errp);
+  scm_intprint(scm_estk_size, 10 , cur_errp);
   lputs(" env stack items, ", cur_errp);
-  intprint(scm_ecache_len - scm_ecache_index, 10, cur_errp);
+  scm_intprint(scm_ecache_len - scm_ecache_index, 10, cur_errp);
   lputs(" out of ", cur_errp);
-  intprint(scm_ecache_len, 10, cur_errp);
+  scm_intprint(scm_ecache_len, 10, cur_errp);
   lputs(" env cells in use.\n", cur_errp);
 }
 void exit_report()
 {
   if (verbose > 2) {
     lputs(";Totals: ", cur_errp);
-    intprint(time_in_msec(INUM(my_time())), -10, cur_errp);
+    scm_intprint(time_in_msec(INUM(my_time())), -10, cur_errp);
     lputs(".ms my time, ", cur_errp);
-    intprint(time_in_msec(INUM(your_time())), -10, cur_errp);
+    scm_intprint(time_in_msec(INUM(your_time())), -10, cur_errp);
     lputs(".ms your time\n", cur_errp);
   }
 }
@@ -1737,8 +1783,8 @@ SCM repl()
 #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);
+	  {lfflush(cur_outp); scm_newline(cur_inp);}
+	else scm_newline(cur_outp);
 #endif
       if (NIMP(x)) {
 	x = CONSP(x) ?
@@ -1751,13 +1797,13 @@ SCM repl()
       if (IMP(x))
 	{if (verbose > 2) lputs(";;no values\n", cur_outp);}
       else if (IMP(CDR(x))) {
-	iprin1(CAR(x), cur_outp, 1);
+	scm_iprin1(CAR(x), cur_outp, 1);
 	lputc('\n', cur_outp);
       }
       else
 	while (NIMP(x)) {
 	  lputc(' ', cur_outp);
-	  iprin1(CAR(x), cur_outp, 1);
+	  scm_iprin1(CAR(x), cur_outp, 1);
 	  lputc('\n', cur_outp);
 	  x = CDR(x);
 	}
@@ -1918,10 +1964,10 @@ SCM scm_load_string(str)
 void scm_line_msg(file, linum, port)
     SCM file, linum, port;
 {
-  iprin1(file, port, 1);
+  scm_iprin1(file, port, 1);
   if (SCM_LINUMP(linum)) {
     lputs(", line ", port);
-    intprint(SCM_LINUM(linum), -10, port);
+    scm_intprint(SCM_LINUM(linum), -10, port);
   }
   lputs(": ", port);
 }
@@ -1955,9 +2001,9 @@ static void err_head(str)
   if (NIMP(lps)) {
     lputs("\n;In file loaded from ", cur_errp);
     for (; NIMP(lps); lps = CDR(lps)) {
-      iprin1(scm_port_filename(CAR(lps)), cur_errp, 0);
+      scm_iprin1(scm_port_filename(CAR(lps)), cur_errp, 0);
       lputs(":", cur_errp);
-      iprin1(scm_port_line(CAR(lps)), cur_errp, 1);
+      scm_iprin1(scm_port_line(CAR(lps)), cur_errp, 1);
       lputs(IMP(CDR(lps)) ? ":" : ",\n;       loaded from ", cur_errp);
     }
   }
@@ -1980,7 +2026,7 @@ void scm_warn(str1, str2, obj)
     lputc('\n', cur_errp);
   }
   if (!UNBNDP(obj)) {
-    iprin1(obj, cur_errp, 1);
+    scm_iprin1(obj, cur_errp, 1);
     lputc('\n', cur_errp);
   }
   lfflush(cur_errp);
@@ -2017,7 +2063,7 @@ static void def_err_response()
     lputs("RECURSIVE ERROR: ", def_errp);
     if (badport || TYP16(cur_errp)==tc16_sfport) {
       lputs("reverting from ", def_errp);
-      iprin1(cur_errp, def_errp, 2);
+      scm_iprin1(cur_errp, def_errp, 2);
       lputs("to default error port\n", def_errp);
       cur_errp = def_errp;
       errjmp_recursive = 0;
@@ -2061,7 +2107,7 @@ static void def_err_response()
     if (reset_safeport(sys_safep, 55, cur_errp))
       if (0==setjmp(SAFEP_JMPBUF(sys_safep))) {
 	if (codep) scm_princode(obj, EOL, sys_safep, writing);
-	else iprin1(obj, sys_safep, writing);
+	else scm_iprin1(obj, sys_safep, writing);
       }
   if (UNBNDP(err_exp)) goto getout;
   if (NIMP(err_exp)) {
@@ -2070,9 +2116,9 @@ static void def_err_response()
 	lputs("\n; in expression: ", cur_errp);
 	if (NCONSP(err_exp)) scm_princode(err_exp, env, sys_safep, writing);
 	else if (UNDEFINED==CDR(err_exp))
-	  iprin1(CAR(err_exp), sys_safep, writing);
+	  scm_iprin1(CAR(err_exp), sys_safep, writing);
 	else {
-	  if (UNBNDP(env)) iprlist("(... ", err_exp, ')', sys_safep, writing);
+	  if (UNBNDP(env)) scm_iprlist("(... ", err_exp, ')', sys_safep, writing);
 	  else scm_princode(err_exp, env, sys_safep, writing);
 	}
       }
@@ -2188,9 +2234,11 @@ static char s_isatty[] = "isatty?";
 SCM l_isatty(port)
      SCM port;
 {
+  int fn;
   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;
+  fn = fileno(STREAM(port));
+  return (fn >= 0 && isatty(fn)) ? BOOL_T : BOOL_F;
 }
 
 static iproc subr0s[] = {
@@ -2221,10 +2269,10 @@ static iproc subr1s[] = {
 
 static iproc subr1os[] = {
 	{s_read_char, scm_read_char},
-	{s_peek_char, peek_char},
-	{s_newline, newline},
+	{s_peek_char, scm_peek_char},
+	{s_newline, scm_newline},
 	{s_freshline, scm_freshline},
-	{s_flush, lflush},
+	{s_force_output, scm_force_output},
 	{s_char_readyp, char_readyp},
 	{"quit", quit},
 	{"verbose", prolixity},
@@ -2233,10 +2281,11 @@ static iproc subr1os[] = {
 	{0, 0}};
 
 static iproc subr2os[] = {
-	{s_write, lwrite},
-	{s_display, display},
-	{s_write_char, write_char},
+	{s_write, scm_write},
+	{s_display, scm_display},
+	{s_write_char, scm_write_char},
 	{s_tryload, tryload},
+	{s_file_position, scm_file_position},
 #ifdef CAN_DUMP
 	{s_unexec, scm_unexec},
 #endif
@@ -2274,6 +2323,9 @@ void init_repl( iverbose )
 	  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));
+	scm_ldstr("\n\
+(define file-set-position file-position)\n\
+");
 #ifdef CAN_DUMP
 	add_feature("dump");
 	scm_ldstr("\