aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2019-12-07 18:19:00 +0100
committerAndrea Corallo2020-01-01 11:38:12 +0100
commita248dfe2c3341ed73de38c2feea64ec12f053aaa (patch)
tree7b0f352051a5cfcfe889e4b8d654edfc68ba1a5e
parent48f5530e7922e4c46db1c4ab82b1c3532db724c9 (diff)
downloademacs-a248dfe2c3341ed73de38c2feea64ec12f053aaa.tar.gz
emacs-a248dfe2c3341ed73de38c2feea64ec12f053aaa.zip
native compile interactive functions support
-rw-r--r--lisp/emacs-lisp/comp.el10
-rw-r--r--src/alloc.c4
-rw-r--r--src/comp.c6
-rw-r--r--src/data.c4
-rw-r--r--src/lisp.h9
5 files changed, 21 insertions, 12 deletions
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index e46453e8516..ffd4985301e 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -1076,9 +1076,7 @@ the annotation emission."
1076(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function)) 1076(cl-defmethod comp-emit-for-top-level ((form byte-to-native-function))
1077 (let* ((name (byte-to-native-function-name form)) 1077 (let* ((name (byte-to-native-function-name form))
1078 (f (gethash name (comp-ctxt-funcs-h comp-ctxt))) 1078 (f (gethash name (comp-ctxt-funcs-h comp-ctxt)))
1079 (args (comp-func-args f)) 1079 (args (comp-func-args f)))
1080 (c-name (comp-func-c-name f))
1081 (doc (comp-func-doc f)))
1082 (cl-assert (and name f)) 1080 (cl-assert (and name f))
1083 (comp-emit (comp-call 'comp--register-subr 1081 (comp-emit (comp-call 'comp--register-subr
1084 (make-comp-mvar :constant name) 1082 (make-comp-mvar :constant name)
@@ -1086,8 +1084,10 @@ the annotation emission."
1086 (make-comp-mvar :constant (if (comp-args-p args) 1084 (make-comp-mvar :constant (if (comp-args-p args)
1087 (comp-args-max args) 1085 (comp-args-max args)
1088 'many)) 1086 'many))
1089 (make-comp-mvar :constant c-name) 1087 (make-comp-mvar :constant (comp-func-c-name f))
1090 (make-comp-mvar :constant doc))))) 1088 (make-comp-mvar :constant (comp-func-doc f))
1089 (make-comp-mvar :constant
1090 (comp-func-int-spec f))))))
1091 1091
1092(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level)) 1092(cl-defmethod comp-emit-for-top-level ((form byte-to-native-top-level))
1093 (let ((form (byte-to-native-top-level-form form))) 1093 (let ((form (byte-to-native-top-level-form form)))
diff --git a/src/alloc.c b/src/alloc.c
index 00da90464be..5ff0d907915 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -7450,14 +7450,14 @@ N should be nonnegative. */);
7450 static union Aligned_Lisp_Subr Swatch_gc_cons_threshold = 7450 static union Aligned_Lisp_Subr Swatch_gc_cons_threshold =
7451 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, 7451 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
7452 { .a4 = watch_gc_cons_threshold }, 7452 { .a4 = watch_gc_cons_threshold },
7453 4, 4, "watch_gc_cons_threshold", 0, {0}}}; 7453 4, 4, "watch_gc_cons_threshold", {0}, {0}, 0}};
7454 XSETSUBR (watcher, &Swatch_gc_cons_threshold.s); 7454 XSETSUBR (watcher, &Swatch_gc_cons_threshold.s);
7455 Fadd_variable_watcher (Qgc_cons_threshold, watcher); 7455 Fadd_variable_watcher (Qgc_cons_threshold, watcher);
7456 7456
7457 static union Aligned_Lisp_Subr Swatch_gc_cons_percentage = 7457 static union Aligned_Lisp_Subr Swatch_gc_cons_percentage =
7458 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, 7458 {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) },
7459 { .a4 = watch_gc_cons_percentage }, 7459 { .a4 = watch_gc_cons_percentage },
7460 4, 4, "watch_gc_cons_percentage", 0, {0}}}; 7460 4, 4, "watch_gc_cons_percentage", {0}, {0}, 0}};
7461 XSETSUBR (watcher, &Swatch_gc_cons_percentage.s); 7461 XSETSUBR (watcher, &Swatch_gc_cons_percentage.s);
7462 Fadd_variable_watcher (Qgc_cons_percentage, watcher); 7462 Fadd_variable_watcher (Qgc_cons_percentage, watcher);
7463} 7463}
diff --git a/src/comp.c b/src/comp.c
index 5a00200ee87..a15bedf41aa 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -3304,11 +3304,11 @@ load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file)
3304 3304
3305DEFUN ("comp--register-subr", Fcomp__register_subr, 3305DEFUN ("comp--register-subr", Fcomp__register_subr,
3306 Scomp__register_subr, 3306 Scomp__register_subr,
3307 5, 5, 0, 3307 6, 6, 0,
3308 doc: /* This gets called by top_level_run during load phase to register 3308 doc: /* This gets called by top_level_run during load phase to register
3309 each exported subr. */) 3309 each exported subr. */)
3310 (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, 3310 (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg,
3311 Lisp_Object c_name, Lisp_Object doc) 3311 Lisp_Object c_name, Lisp_Object doc, Lisp_Object intspec)
3312{ 3312{
3313 dynlib_handle_ptr handle = xmint_pointer (XCAR (load_handle_stack)); 3313 dynlib_handle_ptr handle = xmint_pointer (XCAR (load_handle_stack));
3314 if (!handle) 3314 if (!handle)
@@ -3325,7 +3325,7 @@ DEFUN ("comp--register-subr", Fcomp__register_subr,
3325 x->s.min_args = XFIXNUM (minarg); 3325 x->s.min_args = XFIXNUM (minarg);
3326 x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; 3326 x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY;
3327 x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name))); 3327 x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name)));
3328 x->s.intspec = NULL; 3328 x->s.native_intspec = intspec;
3329 x->s.native_doc = doc; 3329 x->s.native_doc = doc;
3330 x->s.native_elisp = true; 3330 x->s.native_elisp = true;
3331 defsubr (x); 3331 defsubr (x);
diff --git a/src/data.c b/src/data.c
index 50dce9e4644..67613881d67 100644
--- a/src/data.c
+++ b/src/data.c
@@ -899,6 +899,10 @@ Value, if non-nil, is a list (interactive SPEC). */)
899 899
900 if (SUBRP (fun)) 900 if (SUBRP (fun))
901 { 901 {
902#ifdef HAVE_NATIVE_COMP
903 if (XSUBR (fun)->native_elisp && XSUBR (fun)->native_intspec)
904 return XSUBR (fun)->native_intspec;
905#endif
902 const char *spec = XSUBR (fun)->intspec; 906 const char *spec = XSUBR (fun)->intspec;
903 if (spec) 907 if (spec)
904 return list2 (Qinteractive, 908 return list2 (Qinteractive,
diff --git a/src/lisp.h b/src/lisp.h
index 1c692933cdb..56aa7b151e6 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2086,7 +2086,12 @@ struct Lisp_Subr
2086 } function; 2086 } function;
2087 short min_args, max_args; 2087 short min_args, max_args;
2088 const char *symbol_name; 2088 const char *symbol_name;
2089 const char *intspec; 2089 union {
2090 const char *intspec;
2091#ifdef HAVE_NATIVE_COMP
2092 Lisp_Object native_intspec;
2093#endif
2094 };
2090 union { 2095 union {
2091 EMACS_INT doc; 2096 EMACS_INT doc;
2092#ifdef HAVE_NATIVE_COMP 2097#ifdef HAVE_NATIVE_COMP
@@ -3106,7 +3111,7 @@ CHECK_INTEGER (Lisp_Object x)
3106 static union Aligned_Lisp_Subr sname = \ 3111 static union Aligned_Lisp_Subr sname = \
3107 {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ 3112 {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \
3108 { .a ## maxargs = fnname }, \ 3113 { .a ## maxargs = fnname }, \
3109 minargs, maxargs, lname, intspec, {0}}}; \ 3114 minargs, maxargs, lname, {intspec}, {0}, 0}}; \
3110 Lisp_Object fnname 3115 Lisp_Object fnname
3111 3116
3112/* defsubr (Sname); 3117/* defsubr (Sname);