xemacs-beta: src/lread.c comparison

comparison src/lread.c @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91

author	cvs
date	Mon, 13 Aug 2007 08:49:20 +0200
parents	376386a54a3c
children	859a2309aef8

comparison

equal deleted inserted replaced

-:ad457d5f7d04
+:0293115a14e9
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
 Lisp_Object Vcurrent_compiled_function_annotation;
 #endif
+static int load_byte_code_version;
 /* An array describing all known built-in structure types */
 static Structure_type_dynarr *the_structure_type_dynarr;
 #if 0 /* FSFmacs defun hack */
 /* When nonzero, read conses in pure space */
 return c;
 }
 else if (LSTREAMP (readcharfun))
 {
-return Lstream_get_emchar (XLSTREAM (readcharfun));
+Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
+#ifdef DEBUG_XEMACS /* testing Mule */
+static int testing_mule = 0; /* Change via debugger */
+if (testing_mule) {
+if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
+else if (c == '\n')         fprintf (stderr, "\\n\n");
+else                        fprintf (stderr, "\\%o ", c);
+}
+#endif
+return c;
 }
 else if (MARKERP (readcharfun))
 {
 Emchar c;
 Bufpos mpos = marker_position (readcharfun);
 else if (BUFFERP (readcharfun))
 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
 else if (LSTREAMP (readcharfun))
 {
 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
+#ifdef DEBUG_XEMACS /* testing Mule */
+{
+static int testing_mule = 0; /* Set this using debugger */
+if (testing_mule)
+fprintf (stderr,
+(c >= 0x20 && c <= 0x7E) ? "UU%c" :
+((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
+}
+#endif
 }
 else if (MARKERP (readcharfun))
 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
 else
 call1 (readcharfun, make_char (c));
 int source_only = 0;
 Lisp_Object newer   = Qnil;
 Lisp_Object handler = Qnil;
 Lisp_Object found   = Qnil;
 struct gcpro gcpro1, gcpro2, gcpro3;
+int reading_elc = 0;
+int message_p = NILP (nomessage);
 #ifdef DEBUG_XEMACS
+static Lisp_Object last_file_loaded;
 int pure_usage = 0;
 #endif
 #ifdef DOS_NT
 int dosmode = O_TEXT;
 #endif /* DOS_NT */
 CHECK_STRING (file);
 #ifdef DEBUG_XEMACS
 if (purify_flag && noninteractive)
-pure_usage = purespace_usage ();
+{
-#endif
+message_p = 1;
+last_file_loaded = file;
+pure_usage = purespace_usage ();
+}
+#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 (call5 (handler, Qload, file, no_error, nomessage,
+			  nomessage, nosuffix));
-			     nosuffix));
-}
 /* 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);
 /* Avoid weird lossage with null string as arg,
 since it would try to load a directory as a Lisp file.
 Unix truly sucks. */
-if (string_length (XSTRING (file)) > 0)
+if (XSTRING_LENGTH (file) > 0)
 {
 char *foundstr;
 int foundlen;
 fd = locate_file (Vload_path, file,
 	      UNGCPRO;
 	      return Qnil;
 	    }
 	}
-foundstr = (char *) alloca (string_length (XSTRING (found)) + 1);
+foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
-strcpy (foundstr, (char *) string_data (XSTRING (found)));
+strcpy (foundstr, (char *) XSTRING_DATA (found));
 foundlen = strlen (foundstr);
 /* The omniscient JWZ thinks this is worthless, but I beg to
 	 differ. --ben */
 if (load_ignore_elc_files)
 else if (load_warn_when_source_only &&
 	       /* `found' ends in ".el" */
 	       !memcmp (".el", foundstr + foundlen - 3, 3) &&
 	       /* `file' does not end in ".el" */
 	       memcmp (".el",
-		       string_data (XSTRING (file)) +
+		       XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
-		       string_length (XSTRING (file)) - 3,
 		       3))
 	{
 	  source_only = 1;
 	}
+if (!memcmp (".elc", foundstr + foundlen - 4, 4))
+	reading_elc = 1;
 }
 #ifdef DOS_NT
 /* The file was opened as binary, because that's what we'll
 encounter most of the time.  If we're loading a .el, we need
 to reopen it in text mode. */
-if (!memcmp (".elc", foundstr + foundlen - 4, 4))
+if (!reading_elc)
-;
-else
 fd = open (foundstr, O_RDONLY | O_TEXT);
-#endif /* not DOS_NT */
+#endif /* DOS_NT */
-if (load_ignore_elc_files)
+#define PRINT_LOADING_MESSAGE(done) do {				\
-{
+if (load_ignore_elc_files)						\
-if (noninteractive || NILP (nomessage))
+{									\
-	message ("Loading %s...", string_data (XSTRING (newer)));
+if (message_p)							\
-}
+	message ("Loading %s..." done, XSTRING_DATA (newer));		\
-else if (!NILP (newer))
+}									\
-{
+else if (!NILP (newer))						\
-message ("Loading %s...  (file %s is newer)",
+message ("Loading %s..." done " (file %s is newer)",		\
-	       string_data (XSTRING (file)),
+	     XSTRING_DATA (file),					\
-	       string_data (XSTRING (newer)));
+	     XSTRING_DATA (newer));					\
-nomessage = Qnil; /* we printed the first one, so print "done" too */
+else if (source_only)							\
-}
+message ("Loading %s..." done " (file %s.elc does not exist)",	\
-else if (source_only)
+	     XSTRING_DATA (file),					\
-{
+	     XSTRING_DATA (Ffile_name_nondirectory (file)));		\
-message ("Loading %s...  (file %s.elc does not exist)",
+else if (message_p)							\
-	       string_data (XSTRING (file)),
+message ("Loading %s..." done, XSTRING_DATA (file));		\
-	       string_data (XSTRING (Ffile_name_nondirectory (file))));
+} while (0)
-nomessage = Qnil;
-}
+PRINT_LOADING_MESSAGE ("");
-else if (noninteractive || NILP (nomessage))
-message ("Loading %s...", string_data (XSTRING (file)));
 {
 /* Lisp_Object's must be malloc'ed, not stack-allocated */
 Lisp_Object lispstream = Qnil;
 CONST int block_size = 8192;
 record_unwind_protect (load_force_doc_string_unwind,
 			   Vload_force_doc_string_list);
 Vload_file_name_internal = found;
 Vload_file_name_internal_the_purecopy = Qnil;
 specbind (Qload_file_name, found);
-Vload_descriptor_list
+Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
-= Fcons (make_int (fd), Vload_descriptor_list);
 Vload_force_doc_string_list = Qnil;
 #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
 	NUNGCPRO;
 }
 }
 #ifdef DEBUG_XEMACS
-if (noninteractive && purify_flag)
+if (purify_flag && noninteractive)
 {
-int this_pure_usage = purespace_usage () - pure_usage;
+if (EQ (last_file_loaded, file))
-message_append (" (%d)", this_pure_usage);
+	message_append (" (%d)", purespace_usage() - pure_usage);
-}
+else
-#endif
+	message ("Loading %s ...done (%d)", XSTRING_DATA (file),
+		 purespace_usage() - pure_usage);
-if (noninteractive || !NILP (nomessage))
+}
-;
+#endif
-else if (!NILP (newer))
-message ("Loading %s...done  (file %s is newer)",
+if (!noninteractive)
-	     string_data (XSTRING (file)),
+PRINT_LOADING_MESSAGE ("done");
-	     string_data (XSTRING (newer)));
-else
-message ("Loading %s...done", string_data (XSTRING (file)));
 UNGCPRO;
 return Qt;
 }
 #if 0 /* FSFmacs */
 /* not used */
 static int
 complete_filename_p (Lisp_Object pathname)
 {
-REGISTER unsigned char *s = string_data (XSTRING (pathname));
+REGISTER unsigned char *s = XSTRING_DATA (pathname);
 return (IS_DIRECTORY_SEP (s[0])
-	  || (string_length (XSTRING (pathname)) > 2
+	  || (XSTRING_LENGTH (pathname) > 2
 	      && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
 #ifdef ALTOS
 	  || *s == '@'
 #endif
 #ifdef VMS
 }
 if (!(NILP (mode) || (INTP (mode) && XINT (mode) >= 0)))
 mode = wrong_type_argument (Qnatnump, mode);
 locate_file (path_list, filename,
 ((NILP (suffixes)) ? "" :
-		(char *) (string_data (XSTRING (suffixes)))),
+		(char *) (XSTRING_DATA (suffixes))),
 	       &tp, (NILP (mode) ? R_OK : XINT (mode)));
 return tp;
 }
 /* recalculate the hash table for the given string */
 static Lisp_Object
 locate_file_refresh_hashing (Lisp_Object str)
 {
 Lisp_Object hash =
-make_directory_hash_table ((char *) string_data (XSTRING (str)));
+make_directory_hash_table ((char *) XSTRING_DATA (str));
 Fput (str, Qlocate_file_hash_table, hash);
 return hash;
 }
 /* find the hash table for the given string, recalculating if necessary */
 	  return -1;
 	}
 }
 /* Calculate maximum size of any filename made from
 this path element/specified file name and any possible suffix.  */
-want_size = strlen (suffix) +
+want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
-string_length (XSTRING (filename)) + 1;
 if (fn_size < want_size)
 fn = (char *) alloca (fn_size = 100 + want_size);
 nsuffix = suffix;
 {
 char *esuffix = (char *) strchr (nsuffix, ':');
 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
 /* Concatenate path element/specified name with the suffix.  */
-strncpy (fn, (char *) string_data (XSTRING (filename)),
+strncpy (fn, (char *) XSTRING_DATA (filename),
-	       string_length (XSTRING (filename)));
+	       XSTRING_LENGTH (filename));
-fn[string_length (XSTRING (filename))] = 0;
+fn[XSTRING_LENGTH (filename)] = 0;
 if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */
 	strncat (fn, nsuffix, lsuffix);
 /* Ignore file if it's a directory.  */
 if (stat (fn, &st) >= 0
 CONST char *nsuffix;
 Lisp_Object suffixtab = Qnil;
 /* Calculate maximum size of any filename made from
 this path element/specified file name and any possible suffix.  */
-want_size = strlen (suffix) + string_length (XSTRING (str)) + 1;
+want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1;
 if (fn_size < want_size)
 fn = (char *) alloca (fn_size = 100 + want_size);
 nsuffix = suffix;
 {
 char *esuffix = (char *) strchr (nsuffix, ':');
 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
 /* Concatenate path element/specified name with the suffix.  */
-strncpy (fn, (char *) string_data (XSTRING (str)),
+strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str));
-	       string_length (XSTRING (str)));
+fn[XSTRING_LENGTH (str)] = 0;
-fn[string_length (XSTRING (str))] = 0;
 if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */
 	strncat (fn, nsuffix, lsuffix);
 suffixtab = Fcons (build_string (fn), suffixtab);
 /* Advance to next suffix.  */
 /* Yeah, it's ugly.  Gonna make something of it?
 At least our reader is reentrant ... */
 tem =
 (Fcons (tem, make_int
 	    (bytecount_to_charcount
-	     (string_data (XSTRING (string)),
+	     (XSTRING_DATA (string),
 	      startval + Lstream_byte_count (XLSTREAM (lispstream))))));
 Lstream_delete (XLSTREAM (lispstream));
 UNGCPRO;
 return tem;
 }
 		break;
 	      }
 	  }
 	return i;
 }
 default:
 	return c;
 }
 }
 	    {
 	      if (purify_flag)
 		{
 		  if (NILP (Vdoc_file_name))
 		    /* We have not yet called Snarf-documentation, so
-		       assume this file is described in the DOC-MM.NN
+		       assume this file is described in the DOC file
-		       file and Snarf-documentation will fill in the
+		       and Snarf-documentation will fill in the right
-		       right value later.  For now, replace the whole
+		       value later.  For now, replace the whole list
-		       list with 0.  */
+		       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
 	  Lisp_Object dirfile;
 	  dirfile = Fcar (normal_path);
 	  if (!NILP (dirfile))
 	    {
 	      dirfile = Fdirectory_file_name (dirfile);
-	      if (access ((char *) string_data (XSTRING (dirfile)), 0) < 0)
+	      if (access ((char *) XSTRING_DATA (dirfile), 0) < 0)
 		stdout_out ("Warning: lisp library (%s) does not exist.\n",
-			    string_data (XSTRING (Fcar (normal_path))));
+			    XSTRING_DATA (Fcar (normal_path)));
 	    }
 	}
 }
 #endif /* WINDOWSNT */
 #endif /* 0 */

Mercurial > hg > xemacs-beta

comparison src/lread.c @ 16:0293115a14e9 r19-15b91