deprecated eval-when situations
[bpt/guile.git] / libguile / read.c
index eead368..ecf27ff 100644 (file)
@@ -1,5 +1,5 @@
-/* Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2003, 2004, 2006,
- *   2007, 2008, 2009, 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
+/* Copyright (C) 1995-1997, 1999-2001, 2003, 2004, 2006-2012, 2014
+ *   Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
 #endif
 
 #include <stdio.h>
-#include <ctype.h>
 #include <string.h>
 #include <unistd.h>
 #include <unicase.h>
 #include <unictype.h>
 #include <c-strcase.h>
+#include <c-ctype.h>
 
 #include "libguile/_scm.h"
 #include "libguile/bytevectors.h"
@@ -44,6 +44,7 @@
 #include "libguile/hashtab.h"
 #include "libguile/hash.h"
 #include "libguile/ports.h"
+#include "libguile/ports-internal.h"
 #include "libguile/fports.h"
 #include "libguile/root.h"
 #include "libguile/strings.h"
@@ -87,6 +88,8 @@ scm_t_option scm_read_opts[] =
       "In strings, consume leading whitespace after an escaped end-of-line."},
     { SCM_OPTION_BOOLEAN, "curly-infix", 0,
       "Support SRFI-105 curly infix expressions."},
+    { SCM_OPTION_BOOLEAN, "r7rs-symbols", 0,
+      "Support R7RS |...| symbol notation."},
     { 0, },
   };
  
@@ -112,6 +115,7 @@ struct t_read_opts
   unsigned int hungry_eol_escapes_p : 1;
   unsigned int curly_infix_p        : 1;
   unsigned int neoteric_p           : 1;
+  unsigned int r7rs_symbols_p       : 1;
 };
 
 typedef struct t_read_opts scm_t_read_opts;
@@ -259,13 +263,13 @@ read_token (SCM port, scm_t_read_opts *opts,
      {
        int chr;
 
-       chr = scm_get_byte_or_eof (port);
+       chr = scm_get_byte_or_eof_unlocked (port);
 
        if (chr == EOF)
         return 0;
       else if (CHAR_IS_DELIMITER (chr))
         {
-          scm_unget_byte (chr, port);
+          scm_unget_byte_unlocked (chr, port);
           return 0;
         }
       else
@@ -331,7 +335,7 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
 {
   scm_t_wchar c;
   while (1)
-    switch (c = scm_getc (port))
+    switch (c = scm_getc_unlocked (port))
       {
       case EOF:
       goteof:
@@ -346,7 +350,7 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
 
       case ';':
       lp:
-       switch (c = scm_getc (port))
+       switch (c = scm_getc_unlocked (port))
          {
          case EOF:
            goto goteof;
@@ -358,7 +362,7 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
        break;
 
       case '#':
-       switch (c = scm_getc (port))
+       switch (c = scm_getc_unlocked (port))
          {
          case EOF:
            eoferr = "read_sharp";
@@ -377,7 +381,7 @@ flush_ws (SCM port, scm_t_read_opts *opts, const char *eoferr)
              }
            /* fall through */
          default:
-           scm_ungetc (c, port);
+           scm_ungetc_unlocked (c, port);
            return '#';
          }
        break;
@@ -407,6 +411,11 @@ static SCM
 maybe_annotate_source (SCM x, SCM port, scm_t_read_opts *opts,
                        long line, int column)
 {
+  /* This condition can be caused by a user calling
+     set-port-column!.  */
+  if (line < 0 || column < 0)
+    return x;
+
   if (opts->record_positions_p)
     scm_i_set_source_properties_x (x, line, column, SCM_FILENAME (port));
   return x;
@@ -431,7 +440,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   if (terminating_char == c)
     return SCM_EOL;
 
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
   tmp = scm_read_expression (port, opts);
 
   /* Note that it is possible for scm_read_expression to return
@@ -459,7 +468,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
                            "in pair: mismatched close paren: ~A",
                            scm_list_1 (SCM_MAKE_CHAR (c)));
 
-      scm_ungetc (c, port);
+      scm_ungetc_unlocked (c, port);
       tmp = scm_read_expression (port, opts);
 
       /* See above note about scm_sym_dot.  */
@@ -548,7 +557,7 @@ scm_read_sexp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
       c = 0;                                                       \
       while (i < ndigits)                                          \
         {                                                          \
-          a = scm_getc (port);                                     \
+          a = scm_getc_unlocked (port);                                     \
           if (a == EOF)                                            \
             goto str_eof;                                          \
           if (terminator                                           \
@@ -578,17 +587,20 @@ skip_intraline_whitespace (SCM port)
   
   do
     {
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
       if (c == EOF)
         return;
     }
   while (c == '\t' || uc_is_general_category (c, UC_SPACE_SEPARATOR));
 
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
 }                                         
 
+/* Read either a double-quoted string or an R7RS-style symbol delimited
+   by vertical lines, depending on the value of 'chr' ('"' or '|').
+   Regardless, the result is always returned as a string.  */
 static SCM
-scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+scm_read_string_like_syntax (int chr, SCM port, scm_t_read_opts *opts)
 #define FUNC_NAME "scm_lreadr"
 {
   /* For strings smaller than C_STR, this function creates only one Scheme
@@ -602,13 +614,16 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-  while ('"' != (c = scm_getc (port)))
+  while (chr != (c = scm_getc_unlocked (port)))
     {
       if (c == EOF)
         {
         str_eof:
           scm_i_input_error (FUNC_NAME, port,
-                             "end of file in string constant", SCM_EOL);
+                             (chr == '|'
+                              ? "end of file in symbol"
+                              : "end of file in string constant"),
+                             SCM_EOL);
         }
 
       if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
@@ -619,13 +634,15 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
 
       if (c == '\\')
         {
-          switch (c = scm_getc (port))
+          switch (c = scm_getc_unlocked (port))
             {
             case EOF:
               goto str_eof;
-            case '"':
             case '|':
             case '\\':
+            case '(':  /* Accept "\(" for use at the beginning of lines
+                         in multiline strings to avoid confusing emacs
+                         lisp modes.  */
               break;
             case '\n':
               if (opts->hungry_eol_escapes_p)
@@ -656,7 +673,7 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
               c = '\010';
               break;
             case 'x':
-              if (opts->r6rs_escapes_p)
+              if (opts->r6rs_escapes_p || chr == '|')
                 SCM_READ_HEX_ESCAPE (10, ';');
               else
                 SCM_READ_HEX_ESCAPE (2, '\0');
@@ -674,6 +691,8 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
                   break;
                 }
             default:
+              if (c == chr)
+                break;
             bad_escaped:
               scm_i_input_error (FUNC_NAME, port,
                                  "illegal character in escape sequence: ~S",
@@ -699,6 +718,17 @@ scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
 }
 #undef FUNC_NAME
 
+static SCM
+scm_read_string (int chr, SCM port, scm_t_read_opts *opts)
+{
+  return scm_read_string_like_syntax (chr, port, opts);
+}
+
+static SCM
+scm_read_r7rs_symbol (int chr, SCM port, scm_t_read_opts *opts)
+{
+  return scm_string_to_symbol (scm_read_string_like_syntax (chr, port, opts));
+}
 
 static SCM
 scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
@@ -706,17 +736,16 @@ scm_read_number (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   SCM result, str = SCM_EOL;
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   size_t bytes_read;
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
 
   /* Need to capture line and column numbers here. */
   long line = SCM_LINUM (port);
   int column = SCM_COL (port) - 1;
 
-  scm_ungetc (chr, port);
+  scm_ungetc_unlocked (chr, port);
   buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
                                &bytes_read);
 
-  str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
+  str = scm_from_port_stringn (buffer, bytes_read, port);
 
   result = scm_string_to_number (str, SCM_UNDEFINED);
   if (scm_is_false (result))
@@ -741,10 +770,9 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   size_t bytes_read;
   int postfix = (opts->keyword_style == KEYWORD_STYLE_POSTFIX);
   char local_buffer[READER_BUFFER_SIZE], *buffer;
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   SCM str;
 
-  scm_ungetc (chr, port);
+  scm_ungetc_unlocked (chr, port);
   buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
                                &bytes_read);
   if (bytes_read > 0)
@@ -752,8 +780,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 
   if (postfix && ends_with_colon && (bytes_read > 1))
     {
-      str = scm_from_stringn (buffer, bytes_read - 1,
-                             pt->encoding, pt->ilseq_handler);
+      str = scm_from_port_stringn (buffer, bytes_read - 1, port);
 
       if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
@@ -761,8 +788,7 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
     }
   else
     {
-      str = scm_from_stringn (buffer, bytes_read,
-                             pt->encoding, pt->ilseq_handler);
+      str = scm_from_port_stringn (buffer, bytes_read, port);
 
       if (opts->case_insensitive_p)
         str = scm_string_downcase_x (str);
@@ -782,7 +808,6 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   char local_buffer[READER_BUFFER_SIZE], *buffer;
   unsigned int radix;
   SCM str;
-  scm_t_port *pt;
 
   switch (chr)
     {
@@ -807,16 +832,15 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
       break;
 
     default:
-      scm_ungetc (chr, port);
-      scm_ungetc ('#', port);
+      scm_ungetc_unlocked (chr, port);
+      scm_ungetc_unlocked ('#', port);
       radix = 10;
     }
 
   buffer = read_complete_token (port, opts, local_buffer, sizeof local_buffer,
                                &read);
 
-  pt = SCM_PTAB_ENTRY (port);
-  str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
+  str = scm_from_port_stringn (buffer, read, port);
 
   result = scm_string_to_number (str, scm_from_uint (radix));
 
@@ -852,12 +876,12 @@ scm_read_quote (int chr, SCM port, scm_t_read_opts *opts)
       {
        scm_t_wchar c;
 
-       c = scm_getc (port);
+       c = scm_getc_unlocked (port);
        if ('@' == c)
          p = scm_sym_uq_splicing;
        else
          {
-           scm_ungetc (c, port);
+           scm_ungetc_unlocked (c, port);
            p = scm_sym_unquote;
          }
        break;
@@ -899,12 +923,12 @@ scm_read_syntax (int chr, SCM port, scm_t_read_opts *opts)
       {
        int c;
 
-       c = scm_getc (port);
+       c = scm_getc_unlocked (port);
        if ('@' == c)
          p = sym_unsyntax_splicing;
        else
          {
-           scm_ungetc (c, port);
+           scm_ungetc_unlocked (c, port);
            p = sym_unsyntax;
          }
        break;
@@ -941,9 +965,9 @@ scm_read_semicolon_comment (int chr, SCM port)
   /* We use the get_byte here because there is no need to get the
      locale correct with comment input. This presumes that newline
      always represents itself no matter what the encoding is.  */
-  for (c = scm_get_byte_or_eof (port);
+  for (c = scm_get_byte_or_eof_unlocked (port);
        (c != EOF) && (c != '\n');
-       c = scm_get_byte_or_eof (port));
+       c = scm_get_byte_or_eof_unlocked (port));
 
   return SCM_UNSPECIFIED;
 }
@@ -963,12 +987,12 @@ try_read_ci_chars (SCM port, const char *expected_chars)
 
   while (num_chars_read < num_chars_wanted)
     {
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
       if (c == EOF)
         break;
-      else if (tolower (c) != expected_chars[num_chars_read])
+      else if (c_tolower (c) != expected_chars[num_chars_read])
         {
-          scm_ungetc (c, port);
+          scm_ungetc_unlocked (c, port);
           break;
         }
       else
@@ -980,7 +1004,7 @@ try_read_ci_chars (SCM port, const char *expected_chars)
   else
     {
       while (num_chars_read > 0)
-        scm_ungetc (chars_read[--num_chars_read], port);
+        scm_ungetc_unlocked (chars_read[--num_chars_read], port);
       return 0;
     }
 }
@@ -1016,7 +1040,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
   size_t charname_len, bytes_read;
   scm_t_wchar cp;
   int overflow;
-  scm_t_port *pt;
+  scm_t_port_internal *pti;
 
   overflow = read_token (port, opts, buffer, READER_CHAR_NAME_MAX_SIZE,
                          &bytes_read);
@@ -1025,7 +1049,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 
   if (bytes_read == 0)
     {
-      chr = scm_getc (port);
+      chr = scm_getc_unlocked (port);
       if (chr == EOF)
        scm_i_input_error (FUNC_NAME, port, "unexpected end of file "
                           "while reading character", SCM_EOL);
@@ -1034,12 +1058,14 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
       return (SCM_MAKE_CHAR (chr));
     }
 
-  pt = SCM_PTAB_ENTRY (port);
+  pti = SCM_PORT_GET_INTERNAL (port);
 
   /* Simple ASCII characters can be processed immediately.  Also, simple
      ISO-8859-1 characters can be processed immediately if the encoding for this
      port is ISO-8859-1.  */
-  if (bytes_read == 1 && ((unsigned char) buffer[0] <= 127 || pt->encoding == NULL))
+  if (bytes_read == 1 &&
+      ((unsigned char) buffer[0] <= 127
+       || pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1))
     {
       SCM_COL (port) += 1;
       return SCM_MAKE_CHAR (buffer[0]);
@@ -1047,8 +1073,7 @@ scm_read_character (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 
   /* Otherwise, convert the buffer into a proper scheme string for
      processing.  */
-  charname = scm_from_stringn (buffer, bytes_read, pt->encoding,
-                              pt->ilseq_handler);
+  charname = scm_from_port_stringn (buffer, bytes_read, port);
   charname_len = scm_i_string_length (charname);
   SCM_COL (port) += charname_len;
   cp = scm_i_string_ref (charname, 0);
@@ -1156,7 +1181,7 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
   if (c == '-')
     {
       sign = -1;
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
     }
 
   while ('0' <= c && c <= '9')
@@ -1166,7 +1191,7 @@ read_decimal_integer (SCM port, int c, ssize_t *resp)
                            "number too large", SCM_EOL);
       res = 10*res + c-'0';
       got_it = 1;
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
     }
 
   if (got_it)
@@ -1197,13 +1222,13 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
   /* Disambiguate between '#f' and uniform floating point vectors. */
   if (c == 'f')
     {
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
       if (c != '3' && c != '6')
        {
           if (c == 'a' && try_read_ci_chars (port, "lse"))
             return SCM_BOOL_F;
           else if (c != EOF)
-            scm_ungetc (c, port);
+            scm_ungetc_unlocked (c, port);
          return SCM_BOOL_F;
        }
       rank = 1;
@@ -1226,7 +1251,7 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
          && tag_len < sizeof tag_buf / sizeof tag_buf[0])
     {
       tag_buf[tag_len++] = c;
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
     }
   if (tag_len == 0)
     tag = SCM_BOOL_T;
@@ -1250,7 +1275,7 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
 
          if (c == '@')
            {
-             c = scm_getc (port);
+             c = scm_getc_unlocked (port);
              c = read_decimal_integer (port, c, &lbnd);
            }
 
@@ -1258,7 +1283,7 @@ scm_read_array (int c, SCM port, scm_t_read_opts *opts, long line, int column)
 
          if (c == ':')
            {
-             c = scm_getc (port);
+             c = scm_getc_unlocked (port);
              c = read_decimal_integer (port, c, &len);
              if (len < 0)
                scm_i_input_error (NULL, port,
@@ -1320,15 +1345,15 @@ static SCM
 scm_read_bytevector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
                      long line, int column)
 {
-  chr = scm_getc (port);
+  chr = scm_getc_unlocked (port);
   if (chr != 'u')
     goto syntax;
 
-  chr = scm_getc (port);
+  chr = scm_getc_unlocked (port);
   if (chr != '8')
     goto syntax;
 
-  chr = scm_getc (port);
+  chr = scm_getc_unlocked (port);
   if (chr != '(')
     goto syntax;
 
@@ -1351,15 +1376,15 @@ scm_read_guile_bit_vector (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
      terribly inefficient but who cares?  */
   SCM s_bits = SCM_EOL;
 
-  for (chr = scm_getc (port);
+  for (chr = scm_getc_unlocked (port);
        (chr != EOF) && ((chr == '0') || (chr == '1'));
-       chr = scm_getc (port))
+       chr = scm_getc_unlocked (port))
     {
       s_bits = scm_cons ((chr == '0') ? SCM_BOOL_F : SCM_BOOL_T, s_bits);
     }
 
   if (chr != EOF)
-    scm_ungetc (chr, port);
+    scm_ungetc_unlocked (chr, port);
 
   return maybe_annotate_source
     (scm_bitvector (scm_reverse_x (s_bits, SCM_EOL)),
@@ -1373,7 +1398,7 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
 
   for (;;)
     {
-      int c = scm_getc (port);
+      int c = scm_getc_unlocked (port);
 
       if (c == EOF)
        scm_i_input_error ("skip_block_comment", port,
@@ -1406,7 +1431,7 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 
   while (i <= READER_DIRECTIVE_NAME_MAX_SIZE)
     {
-      c = scm_getc (port);
+      c = scm_getc_unlocked (port);
       if (c == EOF)
        scm_i_input_error ("skip_block_comment", port,
                           "unterminated `#! ... !#' comment", SCM_EOL);
@@ -1414,7 +1439,7 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
         name[i++] = c;
       else if (CHAR_IS_DELIMITER (c))
         {
-          scm_ungetc (c, port);
+          scm_ungetc_unlocked (c, port);
           name[i] = '\0';
           if (0 == strcmp ("r6rs", name))
             ;  /* Silently ignore */
@@ -1436,12 +1461,12 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
         }
       else
         {
-          scm_ungetc (c, port);
+          scm_ungetc_unlocked (c, port);
           break;
         }
     }
   while (i > 0)
-    scm_ungetc (name[--i], port);
+    scm_ungetc_unlocked (name[--i], port);
   return scm_read_scsh_block_comment (chr, port);
 }
 
@@ -1452,7 +1477,7 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port)
      nested.  So care must be taken.  */
   int nesting_level = 1;
 
-  int a = scm_getc (port);
+  int a = scm_getc_unlocked (port);
 
   if (a == EOF)
     scm_i_input_error ("scm_read_r6rs_block_comment", port,
@@ -1460,7 +1485,7 @@ scm_read_r6rs_block_comment (scm_t_wchar chr, SCM port)
 
   while (nesting_level > 0)
     {
-      int b = scm_getc (port);
+      int b = scm_getc_unlocked (port);
 
       if (b == EOF)
        scm_i_input_error ("scm_read_r6rs_block_comment", port,
@@ -1493,7 +1518,7 @@ scm_read_commented_expression (scm_t_wchar chr, SCM port,
   if (EOF == c)
     scm_i_input_error ("read_commented_expression", port,
                        "no expression after #; comment", SCM_EOL);
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
   scm_read_expression (port, opts);
   return SCM_UNSPECIFIED;
 }
@@ -1512,7 +1537,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
 
   buf = scm_i_string_start_writing (buf);
 
-  while ((chr = scm_getc (port)) != EOF)
+  while ((chr = scm_getc_unlocked (port)) != EOF)
     {
       if (saw_brace)
        {
@@ -1539,7 +1564,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port)
              that the extended read syntax would never put a `\' before
              an `x'.  For now, we just ignore other instances of
              backslash in the string.  */
-          switch ((chr = scm_getc (port)))
+          switch ((chr = scm_getc_unlocked (port)))
             {
             case EOF:
               goto done;
@@ -1628,7 +1653,7 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
 {
   SCM result;
 
-  chr = scm_getc (port);
+  chr = scm_getc_unlocked (port);
 
   result = scm_read_sharp_extension (chr, port, opts);
   if (!scm_is_eq (result, SCM_UNSPECIFIED))
@@ -1659,29 +1684,10 @@ scm_read_sharp (scm_t_wchar chr, SCM port, scm_t_read_opts *opts,
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
     case '@':
-#if SCM_ENABLE_DEPRECATED
-      /* See below for 'i' and 'e'. */
-    case 'a':
-    case 'y':
-    case 'h':
-    case 'l':
-#endif
       return (scm_read_array (chr, port, opts, line, column));
 
     case 'i':
     case 'e':
-#if SCM_ENABLE_DEPRECATED
-      {
-       /* When next char is '(', it really is an old-style
-          uniform array. */
-       scm_t_wchar next_c = scm_getc (port);
-       if (next_c != EOF)
-         scm_ungetc (next_c, port);
-       if (next_c == '(')
-         return scm_read_array (chr, port, opts, line, column);
-       /* Fall through. */
-      }
-#endif
     case 'b':
     case 'B':
     case 'o':
@@ -1737,7 +1743,7 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
     {
       scm_t_wchar chr;
 
-      chr = scm_getc (port);
+      chr = scm_getc_unlocked (port);
 
       switch (chr)
        {
@@ -1787,6 +1793,11 @@ read_inner_expression (SCM port, scm_t_read_opts *opts)
          return (scm_read_sexp (chr, port, opts));
        case '"':
          return (scm_read_string (chr, port, opts));
+        case '|':
+          if (opts->r7rs_symbols_p)
+            return scm_read_r7rs_symbol (chr, port, opts);
+          else
+            return scm_read_mixed_case_symbol (chr, port, opts);
        case '\'':
        case '`':
        case ',':
@@ -1857,7 +1868,7 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
           int c = flush_ws (port, opts, (char *) NULL);
           if (c == EOF)
             return SCM_EOF_VAL;
-          scm_ungetc (c, port);
+          scm_ungetc_unlocked (c, port);
           line = SCM_LINUM (port);
           column = SCM_COL (port);
         }
@@ -1870,7 +1881,7 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
          new expression.  For example, f{n - 1}(x) => ((f (- n 1)) x). */
       for (;;)
         {
-          int chr = scm_getc (port);
+          int chr = scm_getc_unlocked (port);
 
           if (chr == '(')
             /* e(...) => (e ...) */
@@ -1892,7 +1903,7 @@ scm_read_expression (SCM port, scm_t_read_opts *opts)
           else
             {
               if (chr != EOF)
-                scm_ungetc (chr, port);
+                scm_ungetc_unlocked (chr, port);
               break;
             }
           maybe_annotate_source (expr, port, opts, line, column);
@@ -1926,7 +1937,7 @@ SCM_DEFINE (scm_read, "read", 0, 1, 0,
   c = flush_ws (port, &opts, (char *) NULL);
   if (EOF == c)
     return SCM_EOF_VAL;
-  scm_ungetc (c, port);
+  scm_ungetc_unlocked (c, port);
 
   return (scm_read_expression (port, &opts));
 }
@@ -2019,11 +2030,29 @@ scm_get_hash_procedure (int c)
     }
 }
 
-#define SCM_ENCODING_SEARCH_SIZE (500)
+static int
+is_encoding_char (char c)
+{
+  if (c >= 'a' && c <= 'z') return 1;
+  if (c >= 'A' && c <= 'Z') return 1;
+  if (c >= '0' && c <= '9') return 1;
+  return strchr ("_-.:/,+=()", c) != NULL;
+}
+
+/* Maximum size of an encoding name.  This is a bit more than the
+   longest name listed at
+   <http://www.iana.org/assignments/character-sets> ("ISO-2022-JP-2", 13
+   characters.)  */
+#define ENCODING_NAME_MAX_SIZE 20
+
+/* Number of bytes at the beginning or end of a file that are scanned
+   for a "coding:" declaration.  */
+#define SCM_ENCODING_SEARCH_SIZE (500 + ENCODING_NAME_MAX_SIZE)
 
-/* Search the first few hundred characters of a file for an Emacs-like coding
-   declaration.  Returns either NULL or a string whose storage has been
-   allocated with `scm_gc_malloc ()'.  */
+
+/* Search the SCM_ENCODING_SEARCH_SIZE bytes of a file for an Emacs-like
+   coding declaration.  Returns either NULL or a string whose storage
+   has been allocated with `scm_gc_malloc'.  */
 char *
 scm_i_scan_for_encoding (SCM port)
 {
@@ -2037,7 +2066,7 @@ scm_i_scan_for_encoding (SCM port)
   pt = SCM_PTAB_ENTRY (port);
 
   if (pt->rw_active == SCM_PORT_WRITE)
-    scm_flush (port);
+    scm_flush_unlocked (port);
 
   if (pt->rw_random)
     pt->rw_active = SCM_PORT_READ;
@@ -2045,7 +2074,7 @@ scm_i_scan_for_encoding (SCM port)
   if (pt->read_pos == pt->read_end)
     {
       /* We can use the read buffer, and thus avoid a seek. */
-      if (scm_fill_input (port) == EOF)
+      if (scm_fill_input_unlocked (port) == EOF)
         return NULL;
 
       bytes_read = pt->read_end - pt->read_pos;
@@ -2070,7 +2099,7 @@ scm_i_scan_for_encoding (SCM port)
       if (SCM_FPORTP (port) && !SCM_FDES_RANDOM_P (SCM_FPORT_FDES (port)))
         return NULL;
 
-      bytes_read = scm_c_read (port, header, SCM_ENCODING_SEARCH_SIZE);
+      bytes_read = scm_c_read_unlocked (port, header, SCM_ENCODING_SEARCH_SIZE);
       header[bytes_read] = '\0';
       scm_seek (port, scm_from_int (0), scm_from_int (SEEK_SET));
     }
@@ -2082,8 +2111,8 @@ scm_i_scan_for_encoding (SCM port)
       if ((pos = strstr(pos, "coding")) == NULL)
         return NULL;
 
-      pos += strlen("coding");
-      if (pos - header >= SCM_ENCODING_SEARCH_SIZE || 
+      pos += strlen ("coding");
+      if (pos - header >= SCM_ENCODING_SEARCH_SIZE ||
           (*pos == ':' || *pos == '='))
         {
           pos ++;
@@ -2092,17 +2121,23 @@ scm_i_scan_for_encoding (SCM port)
     }
 
   /* skip spaces */
-  while (pos - header <= SCM_ENCODING_SEARCH_SIZE && 
+  while (pos - header <= SCM_ENCODING_SEARCH_SIZE &&
         (*pos == ' ' || *pos == '\t'))
     pos ++;
 
+  if (pos - header >= SCM_ENCODING_SEARCH_SIZE - ENCODING_NAME_MAX_SIZE)
+    /* We found the "coding:" string, but there is probably not enough
+       room to store an encoding name in its entirety, so ignore it.
+       This makes sure we do not end up returning a truncated encoding
+       name.  */
+    return NULL;
+
   /* grab the next token */
   encoding_start = pos;
   i = 0;
   while (encoding_start + i - header <= SCM_ENCODING_SEARCH_SIZE
          && encoding_start + i - header < bytes_read
-        && (isalnum ((int) encoding_start[i])
-            || strchr ("_-.:/,+=()", encoding_start[i]) != NULL))
+        && is_encoding_char (encoding_start[i]))
     i++;
 
   encoding_length = i;
@@ -2110,8 +2145,6 @@ scm_i_scan_for_encoding (SCM port)
     return NULL;
 
   encoding = scm_gc_strndup (encoding_start, encoding_length, "encoding");
-  for (i = 0; i < encoding_length; i++)
-    encoding[i] = toupper ((int) encoding[i]);
 
   /* push backwards to make sure we were in a comment */
   in_comment = 0;
@@ -2167,7 +2200,7 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
     return SCM_BOOL_F;
   else
     {
-      s_enc = scm_from_locale_string (enc);
+      s_enc = scm_string_upcase (scm_from_locale_string (enc));
       return s_enc;
     }
 
@@ -2203,9 +2236,10 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options");
 #define READ_OPTION_SQUARE_BRACKETS_P     10
 #define READ_OPTION_HUNGRY_EOL_ESCAPES_P  12
 #define READ_OPTION_CURLY_INFIX_P         14
+#define READ_OPTION_R7RS_SYMBOLS_P        16
 
 /* The total width in bits of the per-port overrides */
-#define READ_OPTIONS_NUM_BITS             16
+#define READ_OPTIONS_NUM_BITS             18
 
 #define READ_OPTIONS_INHERIT_ALL  ((1UL << READ_OPTIONS_NUM_BITS) - 1)
 #define READ_OPTIONS_MAX_VALUE    READ_OPTIONS_INHERIT_ALL
@@ -2220,6 +2254,10 @@ set_port_read_option (SCM port, int option, int new_value)
   unsigned int read_options;
 
   new_value &= READ_OPTION_MASK;
+
+  scm_dynwind_begin (0);
+  scm_dynwind_lock_port (port);
+
   scm_read_options = scm_i_port_property (port, sym_port_read_options);
   if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
     read_options = scm_to_uint (scm_read_options);
@@ -2229,6 +2267,8 @@ set_port_read_option (SCM port, int option, int new_value)
   read_options |= new_value << option;
   scm_read_options = scm_from_uint (read_options);
   scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
+
+  scm_dynwind_end ();
 }
 
 /* Set OPTS and PORT's case-insensitivity according to VALUE. */
@@ -2303,6 +2343,7 @@ init_read_options (SCM port, scm_t_read_opts *opts)
   RESOLVE_BOOLEAN_OPTION (SQUARE_BRACKETS_P,    square_brackets_p);
   RESOLVE_BOOLEAN_OPTION (HUNGRY_EOL_ESCAPES_P, hungry_eol_escapes_p);
   RESOLVE_BOOLEAN_OPTION (CURLY_INFIX_P,        curly_infix_p);
+  RESOLVE_BOOLEAN_OPTION (R7RS_SYMBOLS_P,       r7rs_symbols_p);
 
 #undef RESOLVE_BOOLEAN_OPTION