emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

scratch/comp-safety cc2470112c9: Add safety declaration


From: Andrea Corallo
Subject: scratch/comp-safety cc2470112c9: Add safety declaration
Date: Fri, 3 May 2024 16:47:13 -0400 (EDT)

branch: scratch/comp-safety
commit cc2470112c9fcb3027205a27de897f60a9ec8a81
Author: Andrea Corallo <acorallo@gnu.org>
Commit: Andrea Corallo <acorallo@gnu.org>

    Add safety declaration
---
 lisp/emacs-lisp/byte-run.el |  6 ++++++
 lisp/emacs-lisp/bytecomp.el |  1 +
 lisp/emacs-lisp/comp.el     | 11 ++++++++++-
 3 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 84cc83f2270..390e40959bb 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -193,6 +193,11 @@ So far, FUNCTION can only be a symbol, not a lambda 
expression."
       (list 'function-put (list 'quote f)
             ''speed (list 'quote val))))
 
+(defalias 'byte-run--set-safety
+  #'(lambda (f _args &rest val)
+      (list 'function-put (list 'quote f)
+            ''safety (list 'quote val))))
+
 (defalias 'byte-run--set-completion
   #'(lambda (f _args val)
       (list 'function-put (list 'quote f)
@@ -242,6 +247,7 @@ If `error-free', drop calls even if 
`byte-compile-delete-errors' is nil.")
    (list 'doc-string #'byte-run--set-doc-string)
    (list 'indent #'byte-run--set-indent)
    (list 'speed #'byte-run--set-speed)
+   (list 'safety #'byte-run--set-safety)
    (list 'completion #'byte-run--set-completion)
    (list 'modes #'byte-run--set-modes)
    (list 'interactive-args #'byte-run--set-interactive-args)
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 984a10715c6..e92f2ec6bf9 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2449,6 +2449,7 @@ With argument ARG, insert value in current buffer after 
the form."
         (when byte-native-compiling
           (defvar native-comp-speed)
           (push `(native-comp-speed . ,native-comp-speed) 
byte-native-qualities)
+          (push `(safety . ,safety) byte-native-qualities)
           (defvar native-comp-debug)
           (push `(native-comp-debug . ,native-comp-debug) 
byte-native-qualities)
           (defvar native-comp-compiler-options)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index d1ad870a0aa..3e0269a80f1 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -200,7 +200,7 @@ Useful to hook into pass checkers.")
 
 (defun comp--maybe-relax-function-type (type)
   "In case relax function type TYPE so we can't optimize of it."
-  (if (= safety 0)
+  (if (= (comp--spill-safety comp-func) 0)
       type
     (pcase type
       (`(function ,args ,ret)
@@ -381,6 +381,8 @@ Returns ELT."
           :documentation "Target output file-name for the compilation.")
   (speed native-comp-speed :type number
          :documentation "Default speed for this compilation unit.")
+  (safety safety :type number
+         :documentation "Default safety level for this compilation unit.")
   (debug native-comp-debug :type number
          :documentation "Default debug level for this compilation unit.")
   (compiler-options native-comp-compiler-options :type list
@@ -540,6 +542,8 @@ CFG is mutated by a pass.")
                  :documentation "t if non local jumps are present.")
   (speed nil :type number
          :documentation "Optimization level (see `native-comp-speed').")
+  (safety nil :type number
+         :documentation "Safety level (see `safety').")
   (pure nil :type boolean
         :documentation "t if pure nil otherwise.")
   (type nil :type (or null comp-mvar)
@@ -714,6 +718,11 @@ current instruction or its cell."
   (or (comp--spill-decl-spec function-name 'speed)
       (comp-ctxt-speed comp-ctxt)))
 
+(defun comp--spill-safety (function-name)
+  "Return the safety level for FUNCTION-NAME."
+  (or (comp--spill-decl-spec function-name 'safety)
+      (comp-ctxt-safety comp-ctxt)))
+
 ;; Autoloaded as might be used by `disassemble-internal'.
 ;;;###autoload
 (defun comp-c-func-name (name prefix &optional first)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]