diff src/lread.c @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents ee648375d8d6
children 54cc21c15cbb
line wrap: on
line diff
--- a/src/lread.c	Mon Aug 13 09:00:04 2007 +0200
+++ b/src/lread.c	Mon Aug 13 09:02:59 2007 +0200
@@ -36,6 +36,9 @@
 #include "opaque.h"
 #include "paths.h"
 #endif
+#ifdef MULE
+#include "mule-coding.h"
+#endif
 
 #include "sysfile.h"
 
@@ -70,13 +73,6 @@
 
 int puke_on_fsf_keys;
 
-/* This symbol is also used in fns.c */
-#define FEATUREP_SYNTAX
-
-#ifdef FEATUREP_SYNTAX
-static Lisp_Object Qfeaturep;
-#endif
-
 /* non-zero if inside `load' */
 int load_in_progress;
 
@@ -375,6 +371,53 @@
 }
 
 static Lisp_Object
+load_byte_code_version_unwind (Lisp_Object oldval)
+{
+  load_byte_code_version = XINT (oldval);
+  return Qnil;
+}
+
+/* The plague is coming.
+
+   Ring around the rosy, pocket full of posy,
+   Ashes ashes, they all fall down.
+   */
+void
+ebolify_bytecode_constants (Lisp_Object vector)
+{
+  int len = vector_length (XVECTOR (vector));
+  int i;
+
+  for (i = 0; i < len; i++)
+    {
+      Lisp_Object el = vector_data (XVECTOR (vector))[i];
+
+      /* We don't check for `eq', `equal', and the others that have
+	 bytecode opcodes.  This might lose if someone passes #'eq or
+	 something to `funcall', but who would really do that?  As
+	 they say in law, we've made a "good-faith effort" to
+	 unfuckify ourselves.  And doing it this way avoids screwing
+	 up args to `make-hashtable' and such.  As it is, we have to
+	 add an extra Ebola check in decode_weak_list_type(). --ben */
+      if (EQ (el, Qassoc))
+	el = Qold_assoc;
+      if (EQ (el, Qdelq))
+	el = Qold_delq;
+#if 0
+      /* I think this is a bad idea because it will probably mess
+	 with keymap code. */
+      if (EQ (el, Qdelete))
+	el = Qold_delete;
+#endif
+      if (EQ (el, Qrassq))
+	el = Qold_rassq;
+      if (EQ (el, Qrassoc))
+	el = Qold_rassoc;
+      vector_data (XVECTOR (vector))[i] = el;
+    }
+}
+
+static Lisp_Object
 pas_de_lache_ici (int fd, Lisp_Object victim)
 {
   Lisp_Object tem;
@@ -436,6 +479,10 @@
 		signal_simple_error ("invalid lazy-loaded byte code", ivan);
 	      /* Remember to purecopy; see above. */
 	      XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan));
+	      /* v18 or v19 bytecode file.  Need to Ebolify. */
+	      if (XCOMPILED_FUNCTION (john)->flags.ebolified
+		  && VECTORP (XCDR (ivan)))
+		ebolify_bytecode_constants (XCDR (ivan));
 	      XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
 	      NUNGCPRO;
 	    }
@@ -480,20 +527,21 @@
 }
 #endif /* I18N3 */
 
-DEFUN ("load-internal", Fload_internal, 1, 4, 0, /*
-Execute a file of Lisp code named FILE.
-First try FILE with `.elc' appended, then try with `.el',
- then try FILE unmodified.
-This function searches the directories in `load-path'.
-If optional second arg NOERROR is non-nil,
- report no error if FILE doesn't exist.
-Print messages at start and end of loading unless
- optional third arg NOMESSAGE is non-nil (ignored in -batch mode).
-If optional fourth arg NOSUFFIX is non-nil, don't try adding
- suffixes `.elc' or `.el' to the specified name FILE.
-Return t if file exists.
+DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
+Execute a file of Lisp code named FILE; no coding-system frobbing.
+This function is identical to `load' except for the handling of the
+CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
+support is not present, both functions are identical and ignore the
+CODESYS and USED-CODESYS arguments.)
+
+If support for Mule exists in this Emacs, the file is decoded
+according to CODESYS; if omitted, no conversion happens.  If
+USED-CODESYS is non-nil, it should be a symbol, and the actual coding
+system that was used for the decoding is stored into it.  It will in
+general be different from CODESYS if CODESYS specifies automatic
+encoding detection or end-of-line detection.
 */
-       (file, no_error, nomessage, nosuffix))
+       (file, no_error, nomessage, nosuffix, codesys, used_codesys))
 {
   /* This function can GC */
   int fd = -1;
@@ -528,14 +576,18 @@
   /* If file name is magic, call the handler.  */
   handler = Ffind_file_name_handler (file, Qload);
   if (!NILP (handler))
-    RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
-			  nomessage, nosuffix));
+    RETURN_UNGCPRO (call7 (handler, Qload, file, no_error, nomessage,
+			   nosuffix, codesys, used_codesys));
 
   /* Do this after the handler to avoid
      the need to gcpro noerror, nomessage and nosuffix.
      (Below here, we care only whether they are nil or not.)  */
   file = Fsubstitute_in_file_name (file);
 
+#ifdef MULE
+  if (!NILP (used_codesys))
+    CHECK_SYMBOL (used_codesys);
+#endif
 
   /* Avoid weird lossage with null string as arg,
      since it would try to load a directory as a Lisp file.
@@ -620,22 +672,22 @@
     fd = open (foundstr, O_RDONLY | O_TEXT);
 #endif /* DOS_NT */
 
-#define PRINT_LOADING_MESSAGE(done) do {				\
-  if (load_ignore_elc_files)						\
-    {									\
-      if (message_p)							\
-	message ("Loading %s..." done, XSTRING_DATA (newer));		\
-    }									\
-  else if (!NILP (newer))						\
-    message ("Loading %s..." done " (file %s is newer)",		\
-	     XSTRING_DATA (file),					\
-	     XSTRING_DATA (newer));					\
-  else if (source_only)							\
+#define PRINT_LOADING_MESSAGE(done) do {			\
+  if (load_ignore_elc_files)					\
+    {								\
+      if (message_p)						\
+	message ("Loading %s..." done, XSTRING_DATA (newer));	\
+    }								\
+  else if (!NILP (newer))					\
+    message ("Loading %s..." done " (file %s is newer)",	\
+	     XSTRING_DATA (file),				\
+	     XSTRING_DATA (newer));				\
+  else if (source_only)						\
     message ("Loading %s..." done " (file %s.elc does not exist)",	\
-	     XSTRING_DATA (file),					\
-	     XSTRING_DATA (Ffile_name_nondirectory (file)));		\
-  else if (message_p)							\
-    message ("Loading %s..." done, XSTRING_DATA (file));		\
+	     XSTRING_DATA (file),				\
+	     XSTRING_DATA (Ffile_name_nondirectory (file)));	\
+  else if (message_p)						\
+    message ("Loading %s..." done, XSTRING_DATA (file));	\
   } while (0)
 
   PRINT_LOADING_MESSAGE ("");
@@ -652,6 +704,12 @@
        files aren't really all that big. */
     Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
 			   block_size);
+#ifdef MULE
+    lispstream = make_decoding_input_stream
+      (XLSTREAM (lispstream), Fget_coding_system (codesys));
+    Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
+			   block_size);
+#endif /* MULE */
 
     /* NOTE: Order of these is very important.  Don't rearrange them. */
     record_unwind_protect (load_unwind, lispstream);
@@ -672,7 +730,36 @@
     Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
 #endif
     load_in_progress++;
+
+    /* Now determine what sort of ELC file we're reading in. */
+    record_unwind_protect (load_byte_code_version_unwind,
+			   make_int (load_byte_code_version));
+    if (reading_elc)
+      {
+	char elc_header[8];
+	int num_read;
+
+	num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
+	if (num_read < 8
+	    || strncmp (elc_header, ";ELC", 4))
+	  {
+	    /* Huh?  Probably not a valid ELC file. */
+	    load_byte_code_version = 100; /* no Ebolification needed */
+	    Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
+	  }
+	else
+	  load_byte_code_version = elc_header[4];
+      }
+    else
+      load_byte_code_version = 100; /* no Ebolification needed */
+	    
     readevalloop (lispstream, file, Feval, 0);
+#ifdef MULE
+    if (!NILP (used_codesys))
+      Fset (used_codesys,
+	    XCODING_SYSTEM_NAME
+	    (decoding_stream_coding_system (XLSTREAM (lispstream))));
+#endif /* MULE */
     unbind_to (speccount, Qnil);
 
     NUNGCPRO;
@@ -701,14 +788,14 @@
       if (EQ (last_file_loaded, file))
 	message_append (" (%d)", purespace_usage() - pure_usage);
       else
-	message ("Loading %s ...done (%d)", XSTRING_DATA (file),
+	message ("Loading %s...done (%d)", XSTRING_DATA (file),
 		 purespace_usage() - pure_usage);
     }
-#endif
+#endif /* DEBUG_XEMACS */
 
   if (!noninteractive)
     PRINT_LOADING_MESSAGE ("done");
-  
+    
   UNGCPRO;
   return Qt;
 }
@@ -1077,7 +1164,7 @@
 (i.e. has the same name as) another file further down in the directory list.
 In this case, you must call `locate-file-clear-hashing'.
 */
-       (path))
+(path))
 {
   Lisp_Object pathtail;
 
@@ -1585,6 +1672,10 @@
 	return i;
       }
 
+#ifdef MULE
+      /* #### need some way of reading an extended character with
+	 an escape sequence. */
+#endif
 
     default:
 	return c;
@@ -1652,7 +1743,7 @@
       /* If a token had any backslashes in it, it is disqualified from
 	 being an integer or a float.  This means that 123\456 is a
 	 symbol, as is \123 (which is the way (intern "123") prints).
-	 Also, if token was preceded by #:, it's always a symbol.
+	 Also, if token was preceeded by #:, it's always a symbol.
        */
       char *p = read_ptr + len;
       char *p1 = read_ptr;
@@ -1743,7 +1834,7 @@
   if (p == lim)
     goto loser;
 
-  for (; (p < lim) && (*p != '\0'); p++)
+  for (; p < lim; p++)
     {
       int c = *p;
       unsigned EMACS_INT onum;
@@ -2272,26 +2363,6 @@
 	      return Fsignal (Qinvalid_read_syntax,
 		    list1 (build_string ("Cannot read unreadable object")));
 	    }
-#ifdef FEATUREP_SYNTAX
-         case '+':
-         case '-':
-           {
-             Lisp_Object fexp, obj, tem;
-             struct gcpro gcpro1, gcpro2;
-
-             fexp = read0(readcharfun);
-             obj = read0(readcharfun);
-
-             /* the call to `featurep' may GC. */
-             GCPRO2(fexp, obj);
-             tem = call1(Qfeaturep, fexp);
-             UNGCPRO;
-
-             if (c == '+' && NILP(tem)) goto retry;
-             if (c == '-' && !NILP(tem)) goto retry;
-             return obj;
-           }
-#endif
 
 	  default:
 	    {
@@ -2506,12 +2577,10 @@
 	return (state);
       else
 	unreadchar (readcharfun, ch);
-#ifdef FEATUREP_SYNTAX
       if (ch == ']')
 	syntax_error ("\"]\" in a list");
       else if (ch == ')')
 	syntax_error ("\")\" in a vector");
-#endif
       state = ((conser) (readcharfun, state, len));
     }
 }
@@ -2543,18 +2612,6 @@
       free_cons (XCONS (tem));
       tem = Qnil;
       ch = XCHAR (elt);
-#ifdef FEATUREP_SYNTAX
-      if (ch == s->terminator) /* deal with #+, #- reader macros */
-       {
-         unreadchar (readcharfun, s->terminator);
-         goto done;
-       }
-      else if (ch == ']')
-       syntax_error ("']' in a list");
-      else if (ch == ')')
-       syntax_error ("')' in a vector");
-      else
-#endif
       if (ch != '.')
 	signal_simple_error ("BUG! Internal reader error", elt);
       else if (!s->allow_dotted_lists)
@@ -2679,10 +2736,10 @@
 		{
 		  if (NILP (Vdoc_file_name))
 		    /* We have not yet called Snarf-documentation, so
-		       assume this file is described in the DOC file
-		       and Snarf-documentation will fill in the right
-		       value later.  For now, replace the whole list
-		       with 0.  */
+		       assume this file is described in the DOC-MM.NN
+		       file and Snarf-documentation will fill in the
+		       right value later.  For now, replace the whole
+		       list with 0.  */
 		    XCAR (holding_cons) = Qzero;
 		  else
 		    /* We have already called Snarf-documentation, so
@@ -2812,9 +2869,14 @@
   GCPRO1 (make_byte_code_args[0]);
   gcpro1.nvars = len;
 
+  /* v18 or v19 bytecode file.  Need to Ebolify. */
+  if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
+    ebolify_bytecode_constants (make_byte_code_args[2]);
+
   /* make-byte-code looks at purify_flag, which should have the same
    *  value as our "read-pure" argument */
   stuff = Fmake_byte_code (len, make_byte_code_args);
+  XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
   if (saw_a_doc_ref)
     Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
   UNGCPRO;
@@ -3062,11 +3124,6 @@
   /* So that early-early stuff will work */
   Ffset (Qload, intern ("load-internal"));
 
-#ifdef FEATUREP_SYNTAX
-  Qfeaturep = intern("featurep");
-  staticpro(&Qfeaturep);
-  Fprovide(intern("xemacs"));
-#endif
 #ifdef LISP_BACKQUOTES
   old_backquote_flag = new_backquote_flag = 0;
 #endif