From aab6df3b52e64b0f430cc681164509fe4aa6ba71 Mon Sep 17 00:00:00 2001
From: gerd <gerd>
Date: Fri, 10 Oct 2003 09:29:18 +0000
Subject: [PATCH] 	(funcall (compile nil  	  '(lambda () (flet ((%f2 ()
 288213285))  	                 (+ (%f2) (* 13 (%f2))))))) 	 =>
 segmentation violation

	(funcall (compile nil
	  '(lambda ()
	      (let ((v9 (labels ((%f13 () nil)) nil)))
		 (let ((v3 (logandc2 97 3)))
		      (* v3 (- 37391897 (logand v3 -66))))))))
	 => invalid argument count

	* src/compiler/srctran.lisp (*) <deftransform>: #+nil because it's
	lying to the compiler, leading to compiler inconsistencies.
	Reported by Paul Dietz.
---
 compiler/srctran.lisp | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index 0fa0ade82..c99e2519e 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.138 2003/09/26 03:52:25 toy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.139 2003/10/10 09:29:18 gerd Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2608,7 +2608,22 @@
 ;;; by the bit position of the last set bit.  We can't use this second method
 ;;; when the high order bit is bit 31 because shifting by 32 doesn't work
 ;;; too well.
-;;; 
+;;;
+
+;;; This is commented out because its uses of TRULY-THE for vop
+;;; selection lie to the compiler, leading to internal
+;;; inconsistencies, which in turn lead to incorrect code being
+;;; generated.  Example:
+;;;
+;;; (funcall (compile nil
+;;; 	'(lambda () (flet ((%f2 () 288213285))
+;;; 		      (+ (%f2) (* 13 (%f2)))))))
+;;;  => segmentation violation
+;;;
+;;; The right fix for this is probably to port SBCL's modular
+;;; functions implementation.
+
+#+nil
 (deftransform * ((x y)
 		 ((unsigned-byte 32) (unsigned-byte 32))
 		 (unsigned-byte 32))
-- 
GitLab