mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-25 05:51:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: don't output invalid C code if dead code elimination fails

Browse source
This commit is contained in:
Marius Gerbershagen 2023-06-24 19:07:10 +02:00
parent 639d5f3ad3
commit 33aca4a57b
2 changed files with 33 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

13
src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
View file

@ -249,13 +249,20 @@
(let* ((dest-type (rep-type->lisp-type dest-rep-type))
(loc-type (loc-type loc))
(loc-rep-type (loc-representation-type loc)))
(labels ((coercion-error ()
(labels ((coercion-error (&optional (write-zero t))
(cmpwarn "Unable to coerce lisp object from type (~S,~S)~%~
to C/C++ type (~S,~S)"
loc-type loc-rep-type dest-type dest-rep-type))
loc-type loc-rep-type dest-type dest-rep-type)
(when write-zero
;; It is possible to reach this point due to a bug
;; but also due to a failure of the dead code
;; elimination. Write a zero to ensure that the
;; output is syntactically valid C code and hope for
;; the latter case.
(wt "0")))
(ensure-valid-object-type (a-lisp-type)
(when (subtypep `(AND ,loc-type ,a-lisp-type) NIL)
(coercion-error))))
(coercion-error nil))))
(when (eq dest-rep-type loc-rep-type)
(wt loc)
(return-from wt-coerce-loc))

23
src/tests/normal-tests/compiler.lsp
View file

@ -2272,3 +2272,26 @@
#'(lambda (x) (+ x 2))))
(signals error (funcall (compile nil (lambda (x) (typep x '(fun-type.0094b integer))))
#'(lambda (x) (+ x 2)))))
;;; Date 2023-06-24
;;; Description
;;;
;;; The compiler produced invalid C code when unable to coerce
;;; between incompatible C types. This situation typically
;;; indicates a bug but it can also happen because of a failure of
;;; the dead code elimination step. In this case we were
;;; outputting invalid C code for the dead part and thus the
;;; compilation could fail for valid Lisp code.
;;;
(test cmp.0095.unreachable-code-unboxed-value
(is (eql
(funcall (compile nil
(lambda (y)
(declare (optimize (safety 0) (speed 3))
(fixnum y))
(funcall (lambda (x)
(cond ((typep x 'fixnum) (1+ x))
((characterp x) (char-code x))))
(the fixnum (1+ y)))))
2)
4)))