feature/native-comp 6e09597 1/3: Introduce load-true-file-name

[Andrea Corallo]

branch: feature/native-comp
commit 6e09597e27fd769e734ddacca8824abd6769257d
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>

    Introduce load-true-file-name
    
        * src/comp.c (maybe_defer_native_compilation): Use
        `load-true-file-name' instead of `load-file-name'.
    
        * src/lread.c (Fload, end_of_file_error, read1, read_list)
        (init_lread, syms_of_lread): Add new `load-true-file-name' and
        fake `load-file-name' value when loading .eln files.
---
 src/comp.c  | 10 +++++-----
 src/lread.c | 35 ++++++++++++++++++++++++++++-------
 2 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/src/comp.c b/src/comp.c
index 32fc7f2..4bd2714 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -3467,7 +3467,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
 #include <sys/types.h>
 #include <unistd.h>
   if (!NILP (function_name) &&
-      STRINGP (Vload_file_name))
+      STRINGP (Vload_true_file_name))
     {
       static FILE *f;
       if (!f)
@@ -3480,7 +3480,7 @@ maybe_defer_native_compilation (Lisp_Object function_name,
        exit (1);
       fprintf (f, "function %s file %s\n",
               SSDATA (Fsymbol_name (function_name)),
-              SSDATA (Vload_file_name));
+              SSDATA (Vload_true_file_name));
       fflush (f);
     }
 #endif
@@ -3489,12 +3489,12 @@ maybe_defer_native_compilation (Lisp_Object 
function_name,
       || !NILP (Vpurify_flag)
       || !COMPILEDP (definition)
       || !FIXNUMP (AREF (definition, COMPILED_ARGLIST))
-      || !STRINGP (Vload_file_name)
-      || !suffix_p (Vload_file_name, ".elc"))
+      || !STRINGP (Vload_true_file_name)
+      || !suffix_p (Vload_true_file_name, ".elc"))
     return;
 
   Lisp_Object src =
-    concat2 (CALL1I (file-name-sans-extension, Vload_file_name),
+    concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name),
             build_pure_c_string (".el"));
   if (NILP (Ffile_exists_p (src)))
     return;
diff --git a/src/lread.c b/src/lread.c
index 2b1ac93..937b456 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1467,7 +1467,20 @@ Return t if the file exists and loads successfully.  */)
        message_with_string ("Loading %s...", file, 1);
     }
 
-  specbind (Qload_file_name, found);
+  if (is_native_elisp)
+    {
+      Lisp_Object dir = Ffile_name_directory (found);
+      Lisp_Object parent_dir =
+       Ffile_name_directory (Fsubstring (dir,
+                                         make_fixnum (0),
+                                         Fsub1 (Flength (dir))));
+      specbind (Qload_file_name,
+               concat2 (parent_dir,
+                        Ffile_name_nondirectory (found)));
+    }
+  else
+    specbind (Qload_file_name, found);
+  specbind (Qload_true_file_name, found);
   specbind (Qinhibit_file_name_operation, Qnil);
   specbind (Qload_in_progress, Qt);
 
@@ -1928,8 +1941,8 @@ readevalloop_1 (int old)
 static AVOID
 end_of_file_error (void)
 {
-  if (STRINGP (Vload_file_name))
-    xsignal1 (Qend_of_file, Vload_file_name);
+  if (STRINGP (Vload_true_file_name))
+    xsignal1 (Qend_of_file, Vload_true_file_name);
 
   xsignal0 (Qend_of_file);
 }
@@ -3161,7 +3174,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool 
first_in_list)
          goto retry;
        }
       if (c == '$')
-       return Vload_file_name;
+       return Vload_true_file_name;
       if (c == '\'')
        return list2 (Qfunction, read0 (readcharfun));
       /* #:foo is the uninterned symbol named foo.  */
@@ -3960,7 +3973,7 @@ read_list (bool flag, Lisp_Object readcharfun)
       first_in_list = 0;
 
       /* While building, if the list starts with #$, treat it specially.  */
-      if (EQ (elt, Vload_file_name)
+      if (EQ (elt, Vload_true_file_name)
          && ! NILP (elt)
          && !NILP (Vpurify_flag))
        {
@@ -3981,7 +3994,7 @@ read_list (bool flag, Lisp_Object readcharfun)
              elt = concat2 (dot_dot_lisp, Ffile_name_nondirectory (elt));
            }
        }
-      else if (EQ (elt, Vload_file_name)
+      else if (EQ (elt, Vload_true_file_name)
               && ! NILP (elt)
               && load_force_doc_strings)
        doc_reference = 2;
@@ -4737,6 +4750,7 @@ init_lread (void)
 
   load_in_progress = 0;
   Vload_file_name = Qnil;
+  Vload_true_file_name = Qnil;
   Vstandard_input = Qt;
   Vloads_in_progress = Qnil;
 }
@@ -4938,9 +4952,15 @@ directory.  These file names are converted to absolute 
at startup.  */);
   Vload_history = Qnil;
 
   DEFVAR_LISP ("load-file-name", Vload_file_name,
-              doc: /* Full name of file being loaded by `load'.  */);
+              doc: /* Full name of file being loaded by `load'.
+In case a .eln file is being loaded this is unreliable and 
`load-true-file-name'
+should be used instead.  */);
   Vload_file_name = Qnil;
 
+  DEFVAR_LISP ("load-true-file-name", Vload_true_file_name,
+              doc: /* Full name of file being loaded by `load'.  */);
+  Vload_true_file_name = Qnil;
+
   DEFVAR_LISP ("user-init-file", Vuser_init_file,
               doc: /* File name, including directory, of user's initialization 
file.
 If the file loaded had extension `.elc', and the corresponding source file
@@ -5082,6 +5102,7 @@ that are loaded before your customizations are read!  */);
   DEFSYM (Qfunction, "function");
   DEFSYM (Qload, "load");
   DEFSYM (Qload_file_name, "load-file-name");
+  DEFSYM (Qload_true_file_name, "load-true-file-name");
   DEFSYM (Qeval_buffer_list, "eval-buffer-list");
   DEFSYM (Qdir_ok, "dir-ok");
   DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");