mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 22:41:06 -08:00
Code Issues Projects Releases Wiki Activity

Fix native compiler string hash consing strategy (bug#47868)

Browse source 
* 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.
This commit is contained in:
Andrea Corallo 2021-04-21 15:23:23 +02:00
parent 0eee48af9d
commit f842816125
3 changed files with 50 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

72
lisp/emacs-lisp/comp.el
View file

@ -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)