xemacs-beta: src/lread.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 #include "commands.h"
 #include "insdel.h"
 #include "lstream.h"
 #include "opaque.h"
 #include "paths.h"
+#endif
+#ifdef MULE
+#include "mule-coding.h"
 #endif
 #include "sysfile.h"
 #ifdef LISP_FLOAT_TYPE
 Lisp_Object Qload, Qload_file_name;
 Lisp_Object Qlocate_file_hash_table;
 Lisp_Object Qfset;
 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;
 /* Whether Fload_internal() should check whether the .el is newer
 Vload_file_name_internal_the_purecopy = oldval;
 return Qnil;
 }
 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;
 EMACS_INT pos;
 	      ivan = Fread (juan);
 	      if (!CONSP (ivan))
 		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;
 	    }
 	  doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
 	  if (CONSP (doc))
 Vfile_domain = val;
 return Qnil;
 }
 #endif /* I18N3 */
-DEFUN ("load-internal", Fload_internal, 1, 4, 0, /*
+DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
-Execute a file of Lisp code named FILE.
+Execute a file of Lisp code named FILE; no coding-system frobbing.
-First try FILE with `.elc' appended, then try with `.el',
+This function is identical to `load' except for the handling of the
-then try FILE unmodified.
+CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
-This function searches the directories in `load-path'.
+support is not present, both functions are identical and ignore the
-If optional second arg NOERROR is non-nil,
+CODESYS and USED-CODESYS arguments.)
-report no error if FILE doesn't exist.
-Print messages at start and end of loading unless
+If support for Mule exists in this Emacs, the file is decoded
-optional third arg NOMESSAGE is non-nil (ignored in -batch mode).
+according to CODESYS; if omitted, no conversion happens.  If
-If optional fourth arg NOSUFFIX is non-nil, don't try adding
+USED-CODESYS is non-nil, it should be a symbol, and the actual coding
-suffixes `.elc' or `.el' to the specified name FILE.
+system that was used for the decoding is stored into it.  It will in
-Return t if file exists.
+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;
 int speccount = specpdl_depth ();
 int source_only = 0;
 #endif /* DEBUG_XEMACS */
 /* 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,
+RETURN_UNGCPRO (call7 (handler, Qload, file, no_error, nomessage,
-			  nomessage, nosuffix));
+			   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.
 Unix truly sucks. */
 if (XSTRING_LENGTH (file) > 0)
 to reopen it in text mode. */
 if (!reading_elc)
 fd = open (foundstr, O_RDONLY | O_TEXT);
 #endif /* DOS_NT */
-#define PRINT_LOADING_MESSAGE(done) do {				\
+#define PRINT_LOADING_MESSAGE(done) do {			\
-if (load_ignore_elc_files)						\
+if (load_ignore_elc_files)					\
-{									\
+{								\
-if (message_p)							\
+if (message_p)						\
-	message ("Loading %s..." done, XSTRING_DATA (newer));		\
+	message ("Loading %s..." done, XSTRING_DATA (newer));	\
-}									\
+}								\
-else if (!NILP (newer))						\
+else if (!NILP (newer))					\
-message ("Loading %s..." done " (file %s is newer)",		\
+message ("Loading %s..." done " (file %s is newer)",	\
-	     XSTRING_DATA (file),					\
+	     XSTRING_DATA (file),				\
-	     XSTRING_DATA (newer));					\
+	     XSTRING_DATA (newer));				\
-else if (source_only)							\
+else if (source_only)						\
 message ("Loading %s..." done " (file %s.elc does not exist)",	\
-	     XSTRING_DATA (file),					\
+	     XSTRING_DATA (file),				\
-	     XSTRING_DATA (Ffile_name_nondirectory (file)));		\
+	     XSTRING_DATA (Ffile_name_nondirectory (file)));	\
-else if (message_p)							\
+else if (message_p)						\
-message ("Loading %s..." done, XSTRING_DATA (file));		\
+message ("Loading %s..." done, XSTRING_DATA (file));	\
 } while (0)
 PRINT_LOADING_MESSAGE ("");
 {
 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
 /* 64K is used for normal files; 8K should be OK here because Lisp
 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);
 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
 record_unwind_protect (load_file_name_internal_unwind,
 #ifdef I18N3
 record_unwind_protect (restore_file_domain, Vfile_domain);
 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;
 }
 if (purify_flag && noninteractive)
 {
 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;
 }
 `locate-file' will primarily get confused if you add a file that shadows
 (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))
 {
 Lisp_Object pathtail;
 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
 {
 	      }
 	  }
 	return i;
 }
+#ifdef MULE
+/* #### need some way of reading an extended character with
+	 an escape sequence. */
+#endif
 default:
 	return c;
 }
 }
 if (! (saw_a_backslash || uninterned_symbol))
 {
 /* 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;
 if (*p1 == '+' || *p1 == '-') p1++;
 }
 if (p == lim)
 goto loser;
-for (; (p < lim) && (*p != '\0'); p++)
+for (; p < lim; p++)
 {
 int c = *p;
 unsigned EMACS_INT onum;
 if (isdigit (c))
 	    {
 	      unreadchar (readcharfun, c);
 	      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:
 	    {
 	      unreadchar (readcharfun, c);
 	      return Fsignal (Qinvalid_read_syntax,
 if (ch == terminator)
 	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));
 }
 }
 elt = XCDR (elt);
 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)
 	syntax_error ("\".\" in a vector");
 else
 	    {
 	      if (purify_flag)
 		{
 		  if (NILP (Vdoc_file_name))
 		    /* We have not yet called Snarf-documentation, so
-		       assume this file is described in the DOC file
+		       assume this file is described in the DOC-MM.NN
-		       and Snarf-documentation will fill in the right
+		       file and Snarf-documentation will fill in the
-		       value later.  For now, replace the whole list
+		       right value later.  For now, replace the whole
-		       with 0.  */
+		       list with 0.  */
 		    XCAR (holding_cons) = Qzero;
 		  else
 		    /* We have already called Snarf-documentation, so
 		       make a relative file name for this file, so it
 		       can be found properly in the installed Lisp
 free_cons (victim);
 }
 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;
 return stuff;
 }
 #endif
 /* 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
 #ifdef I18N3

Mercurial > hg > xemacs-beta

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