[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp f842816 2/3: Fix native compiler string hash consing
|
From: |
Andrea Corallo |
|
Subject: |
feature/native-comp f842816 2/3: Fix native compiler string hash consing strategy (bug#47868) |
|
Date: |
Wed, 21 Apr 2021 11:41:18 -0400 (EDT) |
branch: feature/native-comp
commit f842816125c54a46eb786ff15622d88792e7677a
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Fix native compiler string hash consing strategy (bug#47868)
* test/src/comp-tests.el (comp-test-47868-1): Add new test.
* test/src/comp-test-funcs.el (comp-test-47868-1-f)
(comp-test-47868-2-f): New functions.
* lisp/emacs-lisp/comp.el (comp-imm-equal-test): Define new hash
tanble test.
(comp-data-container): Use it.
(comp-final, comp-run-async-workers): have comp required before
reading dumped hashes so that `comp-imm-equal-test' is defined.
---
lisp/emacs-lisp/comp.el | 72 ++++++++++++++++++++++++---------------------
test/src/comp-test-funcs.el | 8 +++++
test/src/comp-tests.el | 4 +++
3 files changed, 50 insertions(+), 34 deletions(-)
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 0122008..394b8cb 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -730,11 +730,15 @@ Returns ELT."
finally return h)
"Hash table lap-op -> stack adjustment."))
+(define-hash-table-test 'comp-imm-equal-test #'equal-including-properties
+ (lambda (x)
+ (sxhash-equal-including-properties x)))
+
(cl-defstruct comp-data-container
"Data relocation container structure."
(l () :type list
:documentation "Constant objects used by functions.")
- (idx (make-hash-table :test #'equal) :type hash-table
+ (idx (make-hash-table :test 'comp-imm-equal-test) :type hash-table
:documentation "Obj -> position into the previous field."))
(cl-defstruct (comp-ctxt (:include comp-cstr-ctxt))
@@ -3648,25 +3652,26 @@ Prepare every function for final compilation and drive
the C back-end."
(print-gensym t)
(print-circle t)
(print-escape-multibyte t)
- (expr `(progn
- (require 'comp)
- (setf comp-verbose ,comp-verbose
- comp-libgccjit-reproducer
,comp-libgccjit-reproducer
- comp-ctxt ,comp-ctxt
- comp-eln-load-path ',comp-eln-load-path
- comp-native-driver-options
- ',comp-native-driver-options
- load-path ',load-path)
- ,comp-async-env-modifier-form
- (message "Compiling %s..." ',output)
- (comp-final1)))
+ (expr `((require 'comp)
+ (setf comp-verbose ,comp-verbose
+ comp-libgccjit-reproducer ,comp-libgccjit-reproducer
+ comp-ctxt ,comp-ctxt
+ comp-eln-load-path ',comp-eln-load-path
+ comp-native-driver-options
+ ',comp-native-driver-options
+ load-path ',load-path)
+ ,comp-async-env-modifier-form
+ (message "Compiling %s..." ',output)
+ (comp-final1)))
(temp-file (make-temp-file
(concat "emacs-int-comp-"
(file-name-base output) "-")
nil ".el")))
(with-temp-file temp-file
(insert ";; -*-coding: nil; -*-\n")
- (insert (prin1-to-string expr)))
+ (mapc (lambda (e)
+ (insert (prin1-to-string e)))
+ expr))
(with-temp-buffer
(unwind-protect
(if (zerop
@@ -3900,34 +3905,33 @@ display a message."
; commanded for late load.
(file-newer-than-file-p
source-file (comp-el-to-eln-filename source-file)))
- do (let* ((expr `(progn
- (require 'comp)
- ,(when (boundp 'backtrace-line-length)
- `(setf backtrace-line-length
,backtrace-line-length))
- (setf comp-speed ,comp-speed
- comp-debug ,comp-debug
- comp-verbose ,comp-verbose
- comp-libgccjit-reproducer
,comp-libgccjit-reproducer
- comp-async-compilation t
- comp-eln-load-path ',comp-eln-load-path
- comp-native-driver-options
- ',comp-native-driver-options
- load-path ',load-path
- warning-fill-column most-positive-fixnum)
- ,comp-async-env-modifier-form
- (message "Compiling %s..." ,source-file)
- (comp--native-compile ,source-file ,(and load t))))
+ do (let* ((expr `((require 'comp)
+ ,(when (boundp 'backtrace-line-length)
+ `(setf backtrace-line-length
,backtrace-line-length))
+ (setf comp-speed ,comp-speed
+ comp-debug ,comp-debug
+ comp-verbose ,comp-verbose
+ comp-libgccjit-reproducer
,comp-libgccjit-reproducer
+ comp-async-compilation t
+ comp-eln-load-path ',comp-eln-load-path
+ comp-native-driver-options
+ ',comp-native-driver-options
+ load-path ',load-path
+ warning-fill-column most-positive-fixnum)
+ ,comp-async-env-modifier-form
+ (message "Compiling %s..." ,source-file)
+ (comp--native-compile ,source-file ,(and load t))))
(source-file1 source-file) ;; Make the closure works :/
(temp-file (make-temp-file
(concat "emacs-async-comp-"
(file-name-base source-file) "-")
nil ".el"))
- (expr-string (prin1-to-string expr))
+ (expr-strings (mapcar #'prin1-to-string expr))
(_ (progn
(with-temp-file temp-file
- (insert expr-string))
+ (mapc #'insert expr-strings))
(comp-log "\n")
- (comp-log expr-string)))
+ (mapc #'comp-log expr-strings)))
(load1 load)
(process (make-process
:name (concat "Compiling: " source-file)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index cbd0e57..878db70 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -501,6 +501,14 @@
(format "%S"
(error-message-string err))))))
(cl-return-from comp-test-46824-1-f))))
+
+(defun comp-test-47868-1-f ()
+ " ")
+
+(defun comp-test-47868-2-f ()
+ #(" " 0 1 (face font-lock-keyword-face)))
+
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index b618110..cb9032a 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -507,6 +507,10 @@
https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html.";
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2021-02/msg01949.html>"
(should (equal (comp-test-46824-1-f) nil)))
+(comp-deftest comp-test-47868-1 ()
+ (should-not (equal-including-properties (comp-test-47868-1-f)
+ (comp-test-47868-2-f))))
+
;;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests. ;;