emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/src/lread.c,v


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/src/lread.c,v
Date: Fri, 01 Feb 2008 16:01:51 +0000

CVSROOT:        /cvsroot/emacs
Module name:    emacs
Changes by:     Miles Bader <miles>     08/02/01 16:01:31

Index: src/lread.c
===================================================================
RCS file: /cvsroot/emacs/emacs/src/lread.c,v
retrieving revision 1.385
retrieving revision 1.386
diff -u -b -r1.385 -r1.386
--- src/lread.c 13 Jan 2008 00:43:53 -0000      1.385
+++ src/lread.c 1 Feb 2008 16:00:42 -0000       1.386
@@ -31,7 +31,9 @@
 #include "lisp.h"
 #include "intervals.h"
 #include "buffer.h"
+#include "character.h"
 #include "charset.h"
+#include "coding.h"
 #include <epaths.h>
 #include "commands.h"
 #include "keyboard.h"
@@ -92,6 +94,12 @@
 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
 
+/* Used instead of Qget_file_char while loading *.elc files compiled
+   by Emacs 21 or older.  */
+static Lisp_Object Qget_emacs_mule_file_char;
+
+static Lisp_Object Qload_force_doc_strings;
+
 extern Lisp_Object Qevent_symbol_element_mask;
 extern Lisp_Object Qfile_exists_p;
 
@@ -135,6 +143,11 @@
 /* Nonzero means read should convert strings to unibyte.  */
 static int load_convert_to_unibyte;
 
+/* Nonzero means READCHAR should read bytes one by one (not character)
+   when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
+   This is set to 1 by read1 temporarily while handling address@hidden  */
+static int load_each_byte;
+
 /* Function to use for loading an Emacs Lisp source file (not
    compiled) instead of readevalloop.  */
 Lisp_Object Vload_source_file_function;
@@ -163,9 +176,6 @@
 static int read_from_string_index_byte;
 static int read_from_string_limit;
 
-/* Number of bytes left to read in the buffer character
-   that `readchar' has already advanced over.  */
-static int readchar_backlog;
 /* Number of characters read in the current call to Fread or
    Fread_from_string. */
 static int readchar_count;
@@ -210,7 +220,9 @@
 
 static Lisp_Object Vbytecomp_version_regexp;
 
-static void to_multibyte P_ ((char **, char **, int *));
+static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
+                                    Lisp_Object));
+
 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
                              Lisp_Object (*) (), int,
                              Lisp_Object, Lisp_Object,
@@ -222,29 +234,48 @@
 static void end_of_file_error P_ (()) NO_RETURN;
 
 
+/* Functions that read one byte from the current source READCHARFUN
+   or unreads one byte.  If the integer argument C is -1, it returns
+   one read byte, or -1 when there's no more byte in the source.  If C
+   is 0 or positive, it unreads C, and the return value is not
+   interesting.  */
+
+static int readbyte_for_lambda P_ ((int, Lisp_Object));
+static int readbyte_from_file P_ ((int, Lisp_Object));
+static int readbyte_from_string P_ ((int, Lisp_Object));
+
 /* Handle unreading and rereading of characters.
    Write READCHAR to read a character,
    UNREAD(c) to unread c to be read again.
 
-   The READCHAR and UNREAD macros are meant for reading/unreading a
-   byte code; they do not handle multibyte characters.  The caller
-   should manage them if necessary.
-
-   [ Actually that seems to be a lie; READCHAR will definitely read
-     multibyte characters from buffer sources, at least.  Is the
-     comment just out of date?
-     -- Colin Walters <address@hidden>, 22 May 2002 16:36:50 -0400 ]
- */
+   These macros correctly read/unread multibyte characters.  */
 
-#define READCHAR readchar (readcharfun)
+#define READCHAR readchar (readcharfun, NULL)
 #define UNREAD(c) unreadchar (readcharfun, c)
 
+/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
+#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
+
+/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
+   Qlambda, or a cons, we use this to keep an unread character because
+   a file stream can't handle multibyte-char unreading.  The value -1
+   means that there's no unread character. */
+static int unread_char;
+
 static int
-readchar (readcharfun)
+readchar (readcharfun, multibyte)
      Lisp_Object readcharfun;
+     int *multibyte;
 {
   Lisp_Object tem;
   register int c;
+  int (*readbyte) P_ ((int, Lisp_Object));
+  unsigned char buf[MAX_MULTIBYTE_LENGTH];
+  int i, len;
+  int emacs_mule_encoding = 0;
+
+  if (multibyte)
+    *multibyte = 0;
 
   readchar_count++;
 
@@ -253,31 +284,24 @@
       register struct buffer *inbuffer = XBUFFER (readcharfun);
 
       int pt_byte = BUF_PT_BYTE (inbuffer);
-      int orig_pt_byte = pt_byte;
-
-      if (readchar_backlog > 0)
-       /* We get the address of the byte just passed,
-          which is the last byte of the character.
-          The other bytes in this character are consecutive with it,
-          because the gap can't be in the middle of a character.  */
-       return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1)
-                - --readchar_backlog);
 
       if (pt_byte >= BUF_ZV_BYTE (inbuffer))
        return -1;
 
-      readchar_backlog = -1;
-
       if (! NILP (inbuffer->enable_multibyte_characters))
        {
          /* Fetch the character code from the buffer.  */
          unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
          BUF_INC_POS (inbuffer, pt_byte);
          c = STRING_CHAR (p, pt_byte - orig_pt_byte);
+         if (multibyte)
+           *multibyte = 1;
        }
       else
        {
          c = BUF_FETCH_BYTE (inbuffer, pt_byte);
+         if (! ASCII_BYTE_P (c))
+           c = BYTE8_TO_CHAR (c);
          pt_byte++;
        }
       SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
@@ -289,31 +313,24 @@
       register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
 
       int bytepos = marker_byte_position (readcharfun);
-      int orig_bytepos = bytepos;
-
-      if (readchar_backlog > 0)
-       /* We get the address of the byte just passed,
-          which is the last byte of the character.
-          The other bytes in this character are consecutive with it,
-          because the gap can't be in the middle of a character.  */
-       return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1)
-                - --readchar_backlog);
 
       if (bytepos >= BUF_ZV_BYTE (inbuffer))
        return -1;
 
-      readchar_backlog = -1;
-
       if (! NILP (inbuffer->enable_multibyte_characters))
        {
          /* Fetch the character code from the buffer.  */
          unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
          BUF_INC_POS (inbuffer, bytepos);
          c = STRING_CHAR (p, bytepos - orig_bytepos);
+         if (multibyte)
+           *multibyte = 1;
        }
       else
        {
          c = BUF_FETCH_BYTE (inbuffer, bytepos);
+         if (! ASCII_BYTE_P (c))
+           c = BYTE8_TO_CHAR (c);
          bytepos++;
        }
 
@@ -324,44 +341,95 @@
     }
 
   if (EQ (readcharfun, Qlambda))
-    return read_bytecode_char (0);
+    {
+      readbyte = readbyte_for_lambda;
+      goto read_multibyte;
+    }
 
   if (EQ (readcharfun, Qget_file_char))
     {
-      BLOCK_INPUT;
-      c = getc (instream);
-#ifdef EINTR
-      /* Interrupted reads have been observed while reading over the network */
-      while (c == EOF && ferror (instream) && errno == EINTR)
-       {
-         UNBLOCK_INPUT;
-         QUIT;
-         BLOCK_INPUT;
-         clearerr (instream);
-         c = getc (instream);
-       }
-#endif
-      UNBLOCK_INPUT;
-      return c;
+      readbyte = readbyte_from_file;
+      goto read_multibyte;
     }
 
   if (STRINGP (readcharfun))
     {
       if (read_from_string_index >= read_from_string_limit)
        c = -1;
-      else
-       FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
+      else if (STRING_MULTIBYTE (readcharfun))
+       {
+         if (multibyte)
+           *multibyte = 1;
+         FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
                                   read_from_string_index,
                                   read_from_string_index_byte);
-
+       }
+      else
+       {
+         c = SREF (readcharfun, read_from_string_index_byte);
+         read_from_string_index++;
+         read_from_string_index_byte++;
+       }
       return c;
     }
 
+  if (CONSP (readcharfun))
+    {
+      /* This is the case that read_vector is reading from a unibyte
+        string that contains a byte sequence previously skipped
+        because of address@hidden  The car part of readcharfun is that
+        string, and the cdr part is a value of readcharfun given to
+        read_vector.  */
+      readbyte = readbyte_from_string;
+      if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
+       emacs_mule_encoding = 1;
+      goto read_multibyte;
+    }
+
+  if (EQ (readcharfun, Qget_emacs_mule_file_char))
+    {
+      readbyte = readbyte_from_file;
+      emacs_mule_encoding = 1;
+      goto read_multibyte;
+    }
+
   tem = call0 (readcharfun);
 
   if (NILP (tem))
     return -1;
   return XINT (tem);
+
+ read_multibyte:
+  if (unread_char >= 0)
+    {
+      c = unread_char;
+      unread_char = -1;
+      return c;
+    }
+  c = (*readbyte) (-1, readcharfun);
+  if (c < 0 || load_each_byte)
+    return c;
+  if (multibyte)
+    *multibyte = 1;
+  if (ASCII_BYTE_P (c))
+    return c;
+  if (emacs_mule_encoding)
+    return read_emacs_mule_char (c, readbyte, readcharfun);
+  i = 0;
+  buf[i++] = c;
+  len = BYTES_BY_CHAR_HEAD (c);
+  while (i < len)
+    {
+      c = (*readbyte) (-1, readcharfun);
+      if (c < 0 || ! TRAILING_CODE_P (c))
+       {
+         while (--i > 1)
+           (*readbyte) (buf[i], readcharfun);
+         return BYTE8_TO_CHAR (buf[0]);
+       }
+      buf[i++] = c;
+    }
+  return STRING_CHAR (buf, i);
 }
 
 /* Unread the character C in the way appropriate for the stream READCHARFUN.
@@ -382,10 +450,6 @@
       struct buffer *b = XBUFFER (readcharfun);
       int bytepos = BUF_PT_BYTE (b);
 
-      if (readchar_backlog >= 0)
-       readchar_backlog++;
-      else
-       {
          BUF_PT (b)--;
          if (! NILP (b->enable_multibyte_characters))
            BUF_DEC_POS (b, bytepos);
@@ -394,16 +458,11 @@
 
          BUF_PT_BYTE (b) = bytepos;
        }
-    }
   else if (MARKERP (readcharfun))
     {
       struct buffer *b = XMARKER (readcharfun)->buffer;
       int bytepos = XMARKER (readcharfun)->bytepos;
 
-      if (readchar_backlog >= 0)
-       readchar_backlog++;
-      else
-       {
          XMARKER (readcharfun)->charpos--;
          if (! NILP (b->enable_multibyte_characters))
            BUF_DEC_POS (b, bytepos);
@@ -412,25 +471,171 @@
 
          XMARKER (readcharfun)->bytepos = bytepos;
        }
-    }
   else if (STRINGP (readcharfun))
     {
       read_from_string_index--;
       read_from_string_index_byte
        = string_char_to_byte (readcharfun, read_from_string_index);
     }
+  else if (CONSP (readcharfun))
+    {
+      unread_char = c;
+    }
   else if (EQ (readcharfun, Qlambda))
-    read_bytecode_char (1);
-  else if (EQ (readcharfun, Qget_file_char))
+    {
+      unread_char = c;
+    }
+  else if (EQ (readcharfun, Qget_file_char)
+          || EQ (readcharfun, Qget_emacs_mule_file_char))
+    {
+      if (load_each_byte)
     {
       BLOCK_INPUT;
       ungetc (c, instream);
       UNBLOCK_INPUT;
     }
   else
+       unread_char = c;
+    }
+  else
     call1 (readcharfun, make_number (c));
 }
 
+static int
+readbyte_for_lambda (c, readcharfun)
+     int c;
+     Lisp_Object readcharfun;
+{
+  return read_bytecode_char (c >= 0);
+}
+
+
+static int
+readbyte_from_file (c, readcharfun)
+     int c;
+     Lisp_Object readcharfun;
+{
+  if (c >= 0)
+    {
+      BLOCK_INPUT;
+      ungetc (c, instream);
+      UNBLOCK_INPUT;
+      return 0;
+    }
+
+  BLOCK_INPUT;
+  c = getc (instream);
+
+#ifdef EINTR
+  /* Interrupted reads have been observed while reading over the network */
+  while (c == EOF && ferror (instream) && errno == EINTR)
+    {
+      UNBLOCK_INPUT;
+      QUIT;
+      BLOCK_INPUT;
+      clearerr (instream);
+      c = getc (instream);
+    }
+#endif
+
+  UNBLOCK_INPUT;
+
+  return (c == EOF ? -1 : c);
+}
+
+static int
+readbyte_from_string (c, readcharfun)
+     int c;
+     Lisp_Object readcharfun;
+{
+  Lisp_Object string = XCAR (readcharfun);
+
+  if (c >= 0)
+    {
+      read_from_string_index--;
+      read_from_string_index_byte
+       = string_char_to_byte (string, read_from_string_index);
+    }
+
+  if (read_from_string_index >= read_from_string_limit)
+    c = -1;
+  else
+    FETCH_STRING_CHAR_ADVANCE (c, string,
+                              read_from_string_index,
+                              read_from_string_index_byte);
+  return c;
+}
+
+
+/* Read one non-ASCII character from INSTREAM.  The character is
+   encoded in `emacs-mule' and the first byte is already read in
+   C.  */
+
+extern char emacs_mule_bytes[256];
+
+static int
+read_emacs_mule_char (c, readbyte, readcharfun)
+     int c;
+     int (*readbyte) P_ ((int, Lisp_Object));
+     Lisp_Object readcharfun;
+{
+  /* Emacs-mule coding uses at most 4-byte for one character.  */
+  unsigned char buf[4];
+  int len = emacs_mule_bytes[c];
+  struct charset *charset;
+  int i;
+  unsigned code;
+
+  if (len == 1)
+    /* C is not a valid leading-code of `emacs-mule'.  */
+    return BYTE8_TO_CHAR (c);
+
+  i = 0;
+  buf[i++] = c;
+  while (i < len)
+    {
+      c = (*readbyte) (-1, readcharfun);
+      if (c < 0xA0)
+       {
+         while (--i > 1)
+           (*readbyte) (buf[i], readcharfun);
+         return BYTE8_TO_CHAR (buf[0]);
+       }
+      buf[i++] = c;
+    }
+
+  if (len == 2)
+    {
+      charset = emacs_mule_charset[buf[0]];
+      code = buf[1] & 0x7F;
+    }
+  else if (len == 3)
+    {
+      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
+         || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
+       {
+         charset = emacs_mule_charset[buf[1]];
+         code = buf[2] & 0x7F;
+       }
+      else
+       {
+         charset = emacs_mule_charset[buf[0]];
+         code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
+       }
+    }
+  else
+    {
+      charset = emacs_mule_charset[buf[1]];
+      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
+    }
+  c = DECODE_CHAR (charset, code);
+  if (c < 0)
+    Fsignal (Qinvalid_read_syntax,
+            Fcons (build_string ("invalid multibyte form"), Qnil));
+  return c;
+}
+
+
 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
                                            Lisp_Object));
 static Lisp_Object read0 P_ ((Lisp_Object));
@@ -438,7 +643,6 @@
 
 static Lisp_Object read_list P_ ((int, Lisp_Object));
 static Lisp_Object read_vector P_ ((Lisp_Object, int));
-static int read_multibyte P_ ((int, Lisp_Object));
 
 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
                                                  Lisp_Object));
@@ -645,11 +849,11 @@
 
 
 
-/* Value is non-zero if the file associated with file descriptor FD
-   is a compiled Lisp file that's safe to load.  Only files compiled
-   with Emacs are safe to load.  Files compiled with XEmacs can lead
-   to a crash in Fbyte_code because of an incompatible change in the
-   byte compiler.  */
+/* Value is a version number of byte compiled code if the file
+   associated with file descriptor FD is a compiled Lisp file that's
+   safe to load.  Only files compiled with Emacs are safe to load.
+   Files compiled with XEmacs can lead to a crash in Fbyte_code
+   because of an incompatible change in the byte compiler.  */
 
 static int
 safe_to_load_p (fd)
@@ -658,6 +862,7 @@
   char buf[512];
   int nbytes, i;
   int safe_p = 1;
+  int version = 1;
 
   /* Read the first few bytes from the file, and look for a line
      specifying the byte compiler version used.  */
@@ -667,15 +872,18 @@
       buf[nbytes] = '\0';
 
       /* Skip to the next newline, skipping over the initial `ELC'
-        with NUL bytes following it.  */
+        with NUL bytes following it, but note the version.  */
       for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
-       ;
+       if (i == 4)
+         version = buf[i];
 
-      if (i < nbytes
-         && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
+      if (i == nbytes
+         || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
                                              buf + i) < 0)
        safe_p = 0;
     }
+  if (safe_p)
+    safe_p = version;
 
   lseek (fd, 0, SEEK_SET);
   return safe_p;
@@ -789,6 +997,8 @@
   int safe_p = 1;
   char *fmode = "r";
   Lisp_Object tmp[2];
+  int version;
+
 #ifdef DOS_NT
   fmode = "rt";
 #endif /* DOS_NT */
@@ -912,12 +1122,15 @@
                                    tmp))
                     : found) ;
 
+  version = -1;
+
   /* Check for the presence of old-style quotes and warn about them.  */
   specbind (Qold_style_backquotes, Qnil);
   record_unwind_protect (load_warn_old_style_backquotes, file);
 
   if (!bcmp (SDATA (found) + SBYTES (found) - 4,
-            ".elc", 4))
+            ".elc", 4)
+      || (version = safe_to_load_p (fd)) > 0)
     /* Load .elc files directly, but not when they are
        remote and have no handler!  */
     {
@@ -928,7 +1141,8 @@
 
          GCPRO3 (file, found, hist_file_name);
 
-         if (!safe_to_load_p (fd))
+         if (version < 0
+             && ! (version = safe_to_load_p (fd)))
            {
              safe_p = 0;
              if (!load_dangerous_libraries)
@@ -1026,8 +1240,17 @@
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
+  if (! version || version >= 22)
   readevalloop (Qget_file_char, stream, hist_file_name,
                Feval, 0, Qnil, Qnil, Qnil, Qnil);
+  else
+    {
+      /* We can't handle a file which was compiled with
+        byte-compile-dynamic by older version of Emacs.  */
+      specbind (Qload_force_doc_strings, Qt);
+      readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
+                   0, Qnil, Qnil, Qnil, Qnil);
+    }
   unbind_to (count, Qnil);
 
   /* Run any eval-after-load forms for this file */
@@ -1453,8 +1676,6 @@
   record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
   load_convert_to_unibyte = !NILP (unibyte);
 
-  readchar_backlog = -1;
-
   GCPRO4 (sourcename, readfun, start, end);
 
   /* Try to ensure sourcename is a truename, except whilst preloading. */
@@ -1711,7 +1932,6 @@
 {
   Lisp_Object retval;
 
-  readchar_backlog = -1;
   readchar_count = 0;
   new_backquote_flag = 0;
   read_objects = Qnil;
@@ -1719,17 +1939,25 @@
       || EQ (Vread_with_symbol_positions, stream))
     Vread_symbol_positions_list = Qnil;
 
-  if (STRINGP (stream))
+  if (STRINGP (stream)
+      || ((CONSP (stream) && STRINGP (XCAR (stream)))))
     {
       int startval, endval;
+      Lisp_Object string;
+
+      if (STRINGP (stream))
+       string = stream;
+      else
+       string = XCAR (stream);
+
       if (NILP (end))
-       endval = SCHARS (stream);
+       endval = SCHARS (string);
       else
        {
          CHECK_NUMBER (end);
          endval = XINT (end);
-         if (endval < 0 || endval > SCHARS (stream))
-           args_out_of_range (stream, end);
+         if (endval < 0 || endval > SCHARS (string))
+           args_out_of_range (string, end);
        }
 
       if (NILP (start))
@@ -1739,10 +1967,10 @@
          CHECK_NUMBER (start);
          startval = XINT (start);
          if (startval < 0 || startval > endval)
-           args_out_of_range (stream, start);
+           args_out_of_range (string, start);
        }
       read_from_string_index = startval;
-      read_from_string_index_byte = string_char_to_byte (stream, startval);
+      read_from_string_index_byte = string_char_to_byte (string, startval);
       read_from_string_limit = endval;
     }
 
@@ -1789,59 +2017,19 @@
 static int read_buffer_size;
 static char *read_buffer;
 
-/* Read multibyte form and return it as a character.  C is a first
-   byte of multibyte form, and rest of them are read from
-   READCHARFUN.  */
-
-static int
-read_multibyte (c, readcharfun)
-     register int c;
-     Lisp_Object readcharfun;
-{
-  /* We need the actual character code of this multibyte
-     characters.  */
-  unsigned char str[MAX_MULTIBYTE_LENGTH];
-  int len = 0;
-  int bytes;
-
-  if (c < 0)
-    return c;
-
-  str[len++] = c;
-  while ((c = READCHAR) >= 0xA0
-        && len < MAX_MULTIBYTE_LENGTH)
-    {
-      str[len++] = c;
-      readchar_count--;
-    }
-  UNREAD (c);
-  if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
-    return STRING_CHAR (str, len);
-  /* The byte sequence is not valid as multibyte.  Unread all bytes
-     but the first one, and return the first byte.  */
-  while (--len > 0)
-    UNREAD (str[len]);
-  return str[0];
-}
-
 /* Read a \-escape sequence, assuming we already read the `\'.
-   If the escape sequence forces unibyte, store 1 into *BYTEREP.
-   If the escape sequence forces multibyte, store 2 into *BYTEREP.
-   Otherwise store 0 into *BYTEREP.  */
+   If the escape sequence forces unibyte, return eight-bit char.  */
 
 static int
-read_escape (readcharfun, stringp, byterep)
+read_escape (readcharfun, stringp)
      Lisp_Object readcharfun;
      int stringp;
-     int *byterep;
 {
   register int c = READCHAR;
   /* \u allows up to four hex digits, \U up to eight. Default to the
      behaviour for \u, and change this value in the case that \U is seen. */
   int unicode_hex_count = 4;
 
-  *byterep = 0;
-
   switch (c)
     {
     case -1:
@@ -1878,7 +2066,7 @@
        error ("Invalid escape character syntax");
       c = READCHAR;
       if (c == '\\')
-       c = read_escape (readcharfun, 0, byterep);
+       c = read_escape (readcharfun, 0);
       return c | meta_modifier;
 
     case 'S':
@@ -1887,7 +2075,7 @@
        error ("Invalid escape character syntax");
       c = READCHAR;
       if (c == '\\')
-       c = read_escape (readcharfun, 0, byterep);
+       c = read_escape (readcharfun, 0);
       return c | shift_modifier;
 
     case 'H':
@@ -1896,7 +2084,7 @@
        error ("Invalid escape character syntax");
       c = READCHAR;
       if (c == '\\')
-       c = read_escape (readcharfun, 0, byterep);
+       c = read_escape (readcharfun, 0);
       return c | hyper_modifier;
 
     case 'A':
@@ -1905,7 +2093,7 @@
        error ("Invalid escape character syntax");
       c = READCHAR;
       if (c == '\\')
-       c = read_escape (readcharfun, 0, byterep);
+       c = read_escape (readcharfun, 0);
       return c | alt_modifier;
 
     case 's':
@@ -1917,7 +2105,7 @@
        }
       c = READCHAR;
       if (c == '\\')
-       c = read_escape (readcharfun, 0, byterep);
+       c = read_escape (readcharfun, 0);
       return c | super_modifier;
 
     case 'C':
@@ -1927,7 +2115,7 @@
     case '^':
       c = READCHAR;
       if (c == '\\')
-       c = read_escape (readcharfun, 0, byterep);
+       c = read_escape (readcharfun, 0);
       if ((c & ~CHAR_MODIFIER_MASK) == '?')
        return 0177 | (c & CHAR_MODIFIER_MASK);
       else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
@@ -1967,7 +2155,8 @@
              }
          }
 
-       *byterep = 1;
+       if (i >= 0x80 && i < 0x100)
+         i = BYTE8_TO_CHAR (i);
        return i;
       }
 
@@ -1975,6 +2164,7 @@
       /* A hex escape, as in ANSI C.  */
       {
        int i = 0;
+       int count = 0;
        while (1)
          {
            c = READCHAR;
@@ -1997,9 +2187,11 @@
                UNREAD (c);
                break;
              }
+           count++;
          }
 
-       *byterep = 2;
+       if (count < 3 && i >= 0x80)
+         return BYTE8_TO_CHAR (i);
        return i;
       }
 
@@ -2013,8 +2205,6 @@
       {
        int i = 0;
        int count = 0;
-       Lisp_Object lisp_char;
-       struct gcpro gcpro1;
 
        while (++count <= unicode_hex_count)
          {
@@ -2031,22 +2221,10 @@
              }
          }
 
-       GCPRO1 (readcharfun);
-       lisp_char = call2 (intern ("decode-char"), intern ("ucs"),
-                         make_number (i));
-       UNGCPRO;
-
-       if (NILP (lisp_char))
-         {
-           error ("Unsupported Unicode code point: U+%x", (unsigned)i);
-         }
-
-       return XFASTINT (lisp_char);
+       return i;
       }
 
     default:
-      if (BASE_LEADING_CODE_P (c))
-       c = read_multibyte (c, readcharfun);
       return c;
     }
 }
@@ -2117,43 +2295,6 @@
 }
 
 
-/* Convert unibyte text in read_buffer to multibyte.
-
-   Initially, *P is a pointer after the end of the unibyte text, and
-   the pointer *END points after the end of read_buffer.
-
-   If read_buffer doesn't have enough room to hold the result
-   of the conversion, reallocate it and adjust *P and *END.
-
-   At the end, make *P point after the result of the conversion, and
-   return in *NCHARS the number of characters in the converted
-   text.  */
-
-static void
-to_multibyte (p, end, nchars)
-     char **p, **end;
-     int *nchars;
-{
-  int nbytes;
-
-  parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars);
-  if (read_buffer_size < 2 * nbytes)
-    {
-      int offset = *p - read_buffer;
-      read_buffer_size = 2 * max (read_buffer_size, nbytes);
-      read_buffer = (char *) xrealloc (read_buffer, read_buffer_size);
-      *p = read_buffer + offset;
-      *end = read_buffer + read_buffer_size;
-    }
-
-  if (nbytes != *nchars)
-    nbytes = str_as_multibyte (read_buffer, read_buffer_size,
-                              *p - read_buffer, nchars);
-
-  *p = read_buffer + nbytes;
-}
-
-
 /* If the next token is ')' or ']' or '.', we store that character
    in *PCH and the return value is not interesting.  Else, we store
    zero in *PCH and we read and return one lisp object.
@@ -2168,12 +2309,14 @@
 {
   register int c;
   int uninterned_symbol = 0;
+  int multibyte;
 
   *pch = 0;
+  load_each_byte = 0;
 
  retry:
 
-  c = READCHAR;
+  c = READCHAR_REPORT_MULTIBYTE (&multibyte);
   if (c < 0)
     end_of_file_error ();
 
@@ -2201,11 +2344,9 @@
            {
              Lisp_Object tmp;
              tmp = read_vector (readcharfun, 0);
-             if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS
-                 || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10)
+             if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
                error ("Invalid size char-table");
              XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
-             XCHAR_TABLE (tmp)->top = Qt;
              return tmp;
            }
          else if (c == '^')
@@ -2214,11 +2355,18 @@
              if (c == '[')
                {
                  Lisp_Object tmp;
+                 int depth, size;
+
                  tmp = read_vector (readcharfun, 0);
-                 if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS)
+                 if (!INTEGERP (AREF (tmp, 0)))
+                   error ("Invalid depth in char-table");
+                 depth = XINT (AREF (tmp, 0));
+                 if (depth < 1 || depth > 3)
+                   error ("Invalid depth in char-table");
+                 size = XVECTOR (tmp)->size - 2;
+                 if (chartab_size [depth] != size)
                    error ("Invalid size char-table");
-                 XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
-                 XCHAR_TABLE (tmp)->top = Qnil;
+                 XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
                  return tmp;
                }
              invalid_syntax ("#^^", 3);
@@ -2239,12 +2387,14 @@
 
              UNREAD (c);
              tmp = read1 (readcharfun, pch, first_in_list);
-             if (size_in_chars != SCHARS (tmp)
+             if (STRING_MULTIBYTE (tmp)
+                 || (size_in_chars != SCHARS (tmp)
                  /* We used to print 1 char too many
                     when the number of bits was a multiple of 8.
-                    Accept such input in case it came from an old version.  */
+                        Accept such input in case it came from an old
+                        version.  */
                  && ! (XFASTINT (length)
-                       == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
+                           == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
                invalid_syntax ("#&...", 5);
 
              val = Fmake_bool_vector (length, Qnil);
@@ -2306,6 +2456,7 @@
        {
          int i, nskip = 0;
 
+         load_each_byte = 1;
          /* Read a decimal integer.  */
          while ((c = READCHAR) >= 0
                 && c >= '0' && c <= '9')
@@ -2316,7 +2467,9 @@
          if (c >= 0)
            UNREAD (c);
 
-         if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))
+         if (load_force_doc_strings
+             && (EQ (readcharfun, Qget_file_char)
+                 || EQ (readcharfun, Qget_emacs_mule_file_char)))
            {
              /* If we are supposed to force doc strings into core right now,
                 record the last string that we skipped,
@@ -2368,6 +2521,7 @@
                c = READCHAR;
            }
 
+         load_each_byte = 0;
          goto retry;
        }
       if (c == '!')
@@ -2503,7 +2657,7 @@
 
     case '?':
       {
-       int discard;
+       int modifiers;
        int next_char;
        int ok;
 
@@ -2519,9 +2673,12 @@
          return make_number (c);
 
        if (c == '\\')
-         c = read_escape (readcharfun, 0, &discard);
-       else if (BASE_LEADING_CODE_P (c))
-         c = read_multibyte (c, readcharfun);
+         c = read_escape (readcharfun, 0);
+       modifiers = c & CHAR_MODIFIER_MASK;
+       c &= ~CHAR_MODIFIER_MASK;
+       if (CHAR_BYTE8_P (c))
+         c = CHAR_TO_BYTE8 (c);
+       c |= modifiers;
 
        next_char = READCHAR;
        if (next_char == '.')
@@ -2556,14 +2713,12 @@
        char *p = read_buffer;
        char *end = read_buffer + read_buffer_size;
        register int c;
-       /* 1 if we saw an escape sequence specifying
-          a multibyte character, or a multibyte character.  */
+       /* Nonzero if we saw an escape sequence specifying
+          a multibyte character.  */
        int force_multibyte = 0;
-       /* 1 if we saw an escape sequence specifying
+       /* Nonzero if we saw an escape sequence specifying
           a single-byte character.  */
        int force_singlebyte = 0;
-       /* 1 if read_buffer contains multibyte text now.  */
-       int is_multibyte = 0;
        int cancel = 0;
        int nchars = 0;
 
@@ -2581,9 +2736,9 @@
 
            if (c == '\\')
              {
-               int byterep;
+               int modifiers;
 
-               c = read_escape (readcharfun, 1, &byterep);
+               c = read_escape (readcharfun, 1);
 
                /* C is -1 if \ newline has just been seen */
                if (c == -1)
@@ -2593,50 +2748,55 @@
                    continue;
                  }
 
-               if (byterep == 1)
+               modifiers = c & CHAR_MODIFIER_MASK;
+               c = c & ~CHAR_MODIFIER_MASK;
+
+               if (CHAR_BYTE8_P (c))
                  force_singlebyte = 1;
-               else if (byterep == 2)
+               else if (! ASCII_CHAR_P (c))
                  force_multibyte = 1;
+               else            /* i.e. ASCII_CHAR_P (c) */
+                 {
+                   /* Allow `\C- ' and `\C-?'.  */
+                   if (modifiers == CHAR_CTL)
+                     {
+                       if (c == ' ')
+                         c = 0, modifiers = 0;
+                       else if (c == '?')
+                         c = 127, modifiers = 0;
              }
-
-           /* A character that must be multibyte forces multibyte.  */
-           if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK))
-             force_multibyte = 1;
-
-           /* If we just discovered the need to be multibyte,
-              convert the text accumulated thus far.  */
-           if (force_multibyte && ! is_multibyte)
+                   if (modifiers & CHAR_SHIFT)
              {
-               is_multibyte = 1;
-               to_multibyte (&p, &end, &nchars);
+                       /* Shift modifier is valid only with [A-Za-z].  */
+                       if (c >= 'A' && c <= 'Z')
+                         modifiers &= ~CHAR_SHIFT;
+                       else if (c >= 'a' && c <= 'z')
+                         c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
              }
 
-           /* Allow `\C- ' and `\C-?'.  */
-           if (c == (CHAR_CTL | ' '))
-             c = 0;
-           else if (c == (CHAR_CTL | '?'))
-             c = 127;
-
-           if (c & CHAR_SHIFT)
+                   if (modifiers & CHAR_META)
              {
-               /* Shift modifier is valid only with [A-Za-z].  */
-               if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
-                 c &= ~CHAR_SHIFT;
-               else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
-                 c = (c & ~CHAR_SHIFT) - ('a' - 'A');
+                       /* Move the meta bit to the right place for a
+                          string.  */
+                       modifiers &= ~CHAR_META;
+                       c = BYTE8_TO_CHAR (c | 0x80);
+                       force_singlebyte = 1;
+                     }
              }
 
-           if (c & CHAR_META)
-             /* Move the meta bit to the right place for a string.  */
-             c = (c & ~CHAR_META) | 0x80;
-           if (c & CHAR_MODIFIER_MASK)
+               /* Any modifiers remaining are invalid.  */
+               if (modifiers)
              error ("Invalid modifier in string");
-
-           if (is_multibyte)
-             p += CHAR_STRING (c, p);
+               p += CHAR_STRING (c, (unsigned char *) p);
+             }
            else
-             *p++ = c;
-
+             {
+               p += CHAR_STRING (c, (unsigned char *) p);
+               if (CHAR_BYTE8_P (c))
+                 force_singlebyte = 1;
+               else if (! ASCII_CHAR_P (c))
+                 force_multibyte = 1;
+             }
            nchars++;
          }
 
@@ -2649,37 +2809,16 @@
        if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
          return make_number (0);
 
-       if (is_multibyte || force_singlebyte)
+       if (force_multibyte)
+         /* READ_BUFFER already contains valid multibyte forms.  */
          ;
-       else if (load_convert_to_unibyte)
+       else if (force_singlebyte)
          {
-           Lisp_Object string;
-           to_multibyte (&p, &end, &nchars);
-           if (p - read_buffer != nchars)
-             {
-               string = make_multibyte_string (read_buffer, nchars,
-                                               p - read_buffer);
-               return Fstring_make_unibyte (string);
-             }
-           /* We can make a unibyte string directly.  */
-           is_multibyte = 0;
-         }
-       else if (EQ (readcharfun, Qget_file_char)
-                || EQ (readcharfun, Qlambda))
-         {
-           /* Nowadays, reading directly from a file is used only for
-              compiled Emacs Lisp files, and those always use the
-              Emacs internal encoding.  Meanwhile, Qlambda is used
-              for reading dynamic byte code (compiled with
-              byte-compile-dynamic = t).  So make the string multibyte
-              if the string contains any multibyte sequences.
-              (to_multibyte is a no-op if not.)  */
-           to_multibyte (&p, &end, &nchars);
-           is_multibyte = (p - read_buffer) != nchars;
+           nchars = str_as_unibyte (read_buffer, p - read_buffer);
+           p = read_buffer + nchars;
          }
        else
-         /* In all other cases, if we read these bytes as
-            separate characters, treat them as separate characters now.  */
+         /* Otherwise, READ_BUFFER contains only ASCII.  */
          ;
 
        /* We want readchar_count to be the number of characters, not
@@ -2689,9 +2828,11 @@
        /* readchar_count -= (p - read_buffer) - nchars; */
        if (read_pure)
          return make_pure_string (read_buffer, nchars, p - read_buffer,
-                                  is_multibyte);
+                                  (force_multibyte
+                                   || (p - read_buffer != nchars)));
        return make_specified_string (read_buffer, nchars, p - read_buffer,
-                                     is_multibyte);
+                                     (force_multibyte
+                                      || (p - read_buffer != nchars)));
       }
 
     case '.':
@@ -2749,11 +2890,10 @@
                  quoted = 1;
                }
 
-             if (! SINGLE_BYTE_CHAR_P (c))
+             if (multibyte)
                p += CHAR_STRING (c, p);
              else
                *p++ = c;
-
              c = READCHAR;
            }
 
@@ -2787,6 +2927,8 @@
                  {
                    if (p1[-1] == '.')
                      p1[-1] = '\0';
+                   /* Fixme: if we have strtol, use that, and check
+                      for overflow.  */
                    if (sizeof (int) == sizeof (EMACS_INT))
                      XSETINT (val, atoi (read_buffer));
                    else if (sizeof (long) == sizeof (EMACS_INT))
@@ -2847,8 +2989,19 @@
              }
          }
        {
-         Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
-           : intern (read_buffer);
+         Lisp_Object name, result;
+         EMACS_INT nbytes = p - read_buffer;
+         EMACS_INT nchars
+           = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
+              : nbytes);
+
+         if (uninterned_symbol && ! NILP (Vpurify_flag))
+           name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
+         else
+           name = make_specified_string (read_buffer, nchars, 
nbytes,multibyte);
+         result = (uninterned_symbol ? Fmake_symbol (name)
+                   : Fintern (name, Qnil));
+
          if (EQ (Vread_with_symbol_positions, Qt)
              || EQ (Vread_with_symbol_positions, readcharfun))
            Vread_symbol_positions_list =
@@ -3107,7 +3260,7 @@
                  STRING_SET_CHARS (bytestr, SBYTES (bytestr));
                  STRING_SET_UNIBYTE (bytestr);
 
-                 item = Fread (bytestr);
+                 item = Fread (Fcons (bytestr, readcharfun));
                  if (!CONSP (item))
                    error ("Invalid byte code");
 
@@ -3120,6 +3273,15 @@
              /* Now handle the bytecode slot.  */
              ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : 
bytestr;
            }
+         else if (i == COMPILED_DOC_STRING
+                  && STRINGP (item)
+                  && ! STRING_MULTIBYTE (item))
+           {
+             if (EQ (readcharfun, Qget_emacs_mule_file_char))
+               item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
+             else
+               item = Fstring_as_multibyte (item);
+           }
        }
       ptr[i] = read_pure ? Fpurecopy (item) : item;
       otem = XCONS (tem);
@@ -3216,7 +3378,15 @@
                  if (doc_reference == 2)
                    {
                      /* Get a doc string from the file we are loading.
-                        If it's in saved_doc_string, get it from there.  */
+                        If it's in saved_doc_string, get it from there.
+
+                        Here, we don't know if the string is a
+                        bytecode string or a doc string.  As a
+                        bytecode string must be unibyte, we always
+                        return a unibyte string.  If it is actually a
+                        doc string, caller must make it
+                        multibyte.  */
+
                      int pos = XINT (XCDR (val));
                      /* Position is negative for user variables.  */
                      if (pos < 0) pos = -pos;
@@ -3248,7 +3418,7 @@
                                saved_doc_string[to++] = c;
                            }
 
-                         return make_string (saved_doc_string + start,
+                         return make_unibyte_string (saved_doc_string + start,
                                              to - start);
                        }
                      /* Look in prev_saved_doc_string the same way.  */
@@ -3280,11 +3450,12 @@
                                prev_saved_doc_string[to++] = c;
                            }
 
-                         return make_string (prev_saved_doc_string + start,
+                         return make_unibyte_string (prev_saved_doc_string
+                                                     + start,
                                              to - start);
                        }
                      else
-                       return get_doc_string (val, 0, 0);
+                       return get_doc_string (val, 1, 0);
                    }
 
                  return val;
@@ -4205,6 +4376,12 @@
   Qget_file_char = intern ("get-file-char");
   staticpro (&Qget_file_char);
 
+  Qget_emacs_mule_file_char = intern ("get-emacs-mule-file-char");
+  staticpro (&Qget_emacs_mule_file_char);
+
+  Qload_force_doc_strings = intern ("load-force-doc-strings");
+  staticpro (&Qload_force_doc_strings);
+
   Qbackquote = intern ("`");
   staticpro (&Qbackquote);
   Qcomma = intern (",");




reply via email to

[Prev in Thread] Current Thread [Next in Thread]