add native compiled function docstring support

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0e2ae6b3c3c1d75bbfd846535f632fac55c2c6de..afa5c9be940c208e8085f3e8bc0ee8ca6e319735 100644 (file)
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -377,7 +377,7 @@ suitable file is found, return nil."
      ;; This applies to config files like ~/.emacs,
      ;; which people sometimes compile.
      ((let (fn)
-       (and (string-match "\\`\\..*\\.elc\\'"
+       (and (string-match "\\`\\..*\\.el[cn]\\'"
                           (file-name-nondirectory file-name))
             (string-equal (file-name-directory file-name)
                           (file-name-as-directory (expand-file-name "~")))
@@ -386,7 +386,7 @@ suitable file is found, return nil."
      ;; When the Elisp source file can be found in the install
      ;; directory, return the name of that file.
      ((let ((lib-name
-            (if (string-match "[.]elc\\'" file-name)
+            (if (string-match "[.]el[cn]\\'" file-name)
                 (substring-no-properties file-name 0 -1)
               file-name)))
        (or (and (file-readable-p lib-name) lib-name)
@@ -399,7 +399,7 @@ suitable file is found, return nil."
              ;; name, convert that back to a file name and see if we
              ;; get the original one.  If so, they are equivalent.
              (if (equal file-name (locate-file lib-name load-path '("")))
-                 (if (string-match "[.]elc\\'" lib-name)
+                 (if (string-match "[.]el[cn]\\'" lib-name)
                      (substring-no-properties lib-name 0 -1)
                    lib-name)
                file-name))
@@ -738,6 +738,8 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED REAL-DEF)."
                 ;; aliases before functions.
                 (aliased
                  (format-message "an alias for `%s'" real-def))
+                 ((subr-native-elisp-p def)
+                  "native compiled Lisp function")
                 ((subrp def)
                  (concat beg (if (eq 'unevalled (cdr (subr-arity def)))
                                  "special form"

diff --git a/src/alloc.c b/src/alloc.c
index 1c6b664b220aad464c3663209288405f4698f9f4..00da90464bed2f901d1f6eeb5930d39317b785aa 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7450,14 +7450,14 @@ N should be nonnegative.  */);
   static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
      {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
        { .a4 = watch_gc_cons_threshold },
-       4, 4, "watch_gc_cons_threshold", 0, 0}};
+       4, 4, "watch_gc_cons_threshold", 0, {0}}};
   XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
   Fadd_variable_watcher (Qgc_cons_threshold, watcher);
 
   static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
      {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
        { .a4 = watch_gc_cons_percentage },
-       4, 4, "watch_gc_cons_percentage", 0, 0}};
+       4, 4, "watch_gc_cons_percentage", 0, {0}}};
   XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
   Fadd_variable_watcher (Qgc_cons_percentage, watcher);
 }

diff --git a/src/comp.c b/src/comp.c
index e2629de042690de38970c75becb62b6cfbeeea10..5a00200ee8733f675bbe48a471f74fcb0ae708ba 100644 (file)
--- a/src/comp.c
+++ b/src/comp.c
@@ -3317,17 +3317,21 @@ DEFUN ("comp--register-subr", Fcomp__register_subr,
   void *func = dynlib_sym (handle, SSDATA (c_name));
   eassert (func);
 
+  /* FIXME add gc support, now just leaking.  */
   union Aligned_Lisp_Subr *x = xmalloc (sizeof (union Aligned_Lisp_Subr));
+
   x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS;
   x->s.function.a0 = func;
   x->s.min_args = XFIXNUM (minarg);
   x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
-  x->s.symbol_name = SSDATA (Fsymbol_name (name));
+  x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name)));
   x->s.intspec = NULL;
-  x->s.doc = 0; /* FIXME */
+  x->s.native_doc = doc;
   x->s.native_elisp = true;
   defsubr (x);
 
+  LOADHIST_ATTACH (Fcons (Qdefun, name));
+
   return Qnil;
 }
 

diff --git a/src/doc.c b/src/doc.c
index 285c0dbbbee9ac9ecd1459f3dda952dce92cccdf..369997a3db43240ee222465e96e7e78f0ab84c24 100644 (file)
--- a/src/doc.c
+++ b/src/doc.c
@@ -335,6 +335,11 @@ string is passed through `substitute-command-keys'.  */)
     xsignal1 (Qvoid_function, function);
   if (CONSP (fun) && EQ (XCAR (fun), Qmacro))
     fun = XCDR (fun);
+#ifdef HAVE_NATIVE_COMP
+  if (!NILP (Fsubr_native_elisp_p (fun)))
+    doc = XSUBR (fun)->native_doc;
+  else
+#endif
   if (SUBRP (fun))
     doc = make_fixnum (XSUBR (fun)->doc);
 #ifdef HAVE_MODULES
@@ -508,7 +513,12 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
 
   /* Lisp_Subrs have a slot for it.  */
   else if (SUBRP (fun))
-    XSUBR (fun)->doc = offset;
+    {
+#ifdef HAVE_NATIVE_COMP
+      eassert (NILP (Fsubr_native_elisp_p (fun)));
+#endif
+      XSUBR (fun)->doc = offset;
+    }
 
   /* Bytecode objects sometimes have slots for it.  */
   else if (COMPILEDP (fun))

diff --git a/src/lisp.h b/src/lisp.h
index a84c08e56694124b3350d2c49a20b0f951f65932..1c692933cdbb455287ebd95903bd74141e4821e5 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2087,10 +2087,13 @@ struct Lisp_Subr
     short min_args, max_args;
     const char *symbol_name;
     const char *intspec;
-    EMACS_INT doc;
+    union {
+      EMACS_INT doc;
 #ifdef HAVE_NATIVE_COMP
-    bool native_elisp;
+      Lisp_Object native_doc;
 #endif
+    };
+    bool native_elisp;
   } GCALIGNED_STRUCT;
 union Aligned_Lisp_Subr
   {
@@ -3103,7 +3106,7 @@ CHECK_INTEGER (Lisp_Object x)
   static union Aligned_Lisp_Subr sname =                                \
      {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },                                \
        { .a ## maxargs = fnname },                                     \
-       minargs, maxargs, lname, intspec, 0}};                          \
+       minargs, maxargs, lname, intspec, {0}}};                                \
    Lisp_Object fnname
 
 /* defsubr (Sname);