From 20ea2964cdf89eec255fb7d66064a9f1ab9e1575 Mon Sep 17 00:00:00 2001
From: "Richard M. Stallman" <rms@gnu.org>
Date: Wed, 21 Dec 1994 18:14:20 +0000
Subject: [PATCH] (Qload_file_name, Vload_file_name): New variables.
 (syms_of_lread): Initialize and staticpro it. (Fload): Bind it. (read_list):
 Before dumping, ignore (#$ . WHATEVER)--return 0.

---
 src/lread.c | 52 +++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 49 insertions(+), 3 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 4034085a38..d19c15787a 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -67,7 +67,7 @@ extern int errno;
 
 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
-Lisp_Object Qascii_character, Qload;
+Lisp_Object Qascii_character, Qload, Qload_file_name;
 
 extern Lisp_Object Qevent_symbol_element_mask;
 
@@ -81,9 +81,12 @@ Lisp_Object Vload_path;
    lists of defs in their load files. */
 Lisp_Object Vload_history;
 
-/* This is useud to build the load history. */
+/* This is used to build the load history. */
 Lisp_Object Vcurrent_load_list;
 
+/* Name of file actually being read by `load'.  */
+Lisp_Object Vload_file_name;
+
 /* List of descriptors now open for Fload.  */
 static Lisp_Object load_descriptor_list;
 
@@ -436,6 +439,7 @@ Return t if file exists.")
   XSETFASTINT (XCONS (lispstream)->cdr, (EMACS_UINT)stream & 0xffff);
   record_unwind_protect (load_unwind, lispstream);
   record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
+  specbind (Qload_file_name, found);
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
   load_in_progress++;
@@ -1183,6 +1187,31 @@ read1 (readcharfun, pch)
 	  return tmp;
 	}
 #endif
+      /* #@NUMBER is used to skip NUMBER following characters.
+	 That's used in .elc files to skip over doc strings
+	 and function definitions.  */
+      if (c == '@')
+	{
+	  int i, nskip = 0;
+
+	  /* Read a decimal integer.  */
+	  while ((c = READCHAR) >= 0
+		 && c >= '0' && c <= '9')
+	    {
+	      nskip *= 10;
+	      nskip += c - '0';
+	    }
+	  if (c >= 0)
+	    UNREAD (c);
+	  
+	  /* Skip that many characters.  */
+	  for (i = 0; i < nskip && c >= 0; i++)
+	    c = READCHAR;
+	  goto retry;
+	}
+      if (c == '$')
+	return Vload_file_name;
+
       UNREAD (c);
       Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
 
@@ -1471,6 +1500,7 @@ read_list (flag, readcharfun)
   Lisp_Object val, tail;
   register Lisp_Object elt, tem;
   struct gcpro gcpro1, gcpro2;
+  int cancel = 0;
 
   val = Qnil;
   tail = Qnil;
@@ -1481,6 +1511,15 @@ read_list (flag, readcharfun)
       GCPRO2 (val, tail);
       elt = read1 (readcharfun, &ch);
       UNGCPRO;
+
+	/* If purifying, and the list starts with #$,
+	   return 0 instead.  This is a doc string reference
+	   and it will be replaced anyway by Snarf-documentation,
+	   so don't waste pure space with it.  */
+      if (EQ (elt, Vload_file_name)
+	  && !NILP (Vpurify_flag) && NILP (Vdoc_file_name))
+	cancel = 1;
+
       if (ch)
 	{
 	  if (flag > 0)
@@ -1501,7 +1540,7 @@ read_list (flag, readcharfun)
 	      read1 (readcharfun, &ch);
 	      UNGCPRO;
 	      if (ch == ')')
-		return val;
+		return (cancel ? make_number (0) : val);
 	      return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
 	    }
 	  return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
@@ -2020,6 +2059,10 @@ The remaining elements of each list are symbols defined as functions\n\
 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
   Vload_history = Qnil;
 
+  DEFVAR_LISP ("load-file-name", &Vload_file_name,
+    "Full name of file being loaded by `load'.");
+  Vload_file_name = Qnil;
+
   DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
     "Used for internal purposes by `load'.");
   Vcurrent_load_list = Qnil;
@@ -2044,4 +2087,7 @@ or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
 
   Qload = intern ("load");
   staticpro (&Qload);
+
+  Qload_file_name = intern ("load-file-name");
+  staticpro (&Qload_file_name);
 }
-- 
2.20.1