From: Andrea Corallo <akrl@sdf.org>
Date: Sat, 7 Dec 2019 10:28:21 +0000 (+0100)
Subject: add native compiled function docstring support
X-Git-Tag: emacs-28.0.90~2727^2~929
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f4de790beec514808eafd1cb22fa5eacdecd4552;p=emacs.git

add native compiled function docstring support
---

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0e2ae6b3c3c..afa5c9be940 100644
--- 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 1c6b664b220..00da90464be 100644
--- 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 e2629de0426..5a00200ee87 100644
--- 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 285c0dbbbee..369997a3db4 100644
--- 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 a84c08e5669..1c692933cdb 100644
--- 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);