From d323b0249b9b1e4a91ddf8716ac9185cd268d973 Mon Sep 17 00:00:00 2001
From: William Harold Newman <william.newman@airmail.net>
Date: Wed, 17 Apr 2002 02:19:38 +0000
Subject: [PATCH] 0.7.2.13: 	merged APD "obsolete byte-compiler support"
 patch (sbcl-devel 		2002-04-13) 	merged CSR
 BUGS serialization patch

---
 BUGS                              |    9 ++++++++
 src/compiler/float-tran.lisp      |   41 +++++++++++++++++----------------
 src/compiler/ir1-translators.lisp |    3 +--
 src/compiler/ir1opt.lisp          |   15 +------------
 src/compiler/knownfun.lisp        |   18 +++++----------
 src/compiler/macros.lisp          |    8 ++-----
 src/compiler/seqtran.lisp         |    8 +++----
 src/compiler/sparc/float.lisp     |    4 ++--
 src/compiler/srctran.lisp         |   45 +++++++++++++++++--------------------
 src/compiler/typetran.lisp        |    7 +++---
 version.lisp-expr                 |    2 +-
 11 files changed, 69 insertions(+), 91 deletions(-)

diff --git a/BUGS b/BUGS
index 77a6771..5d4a779 100644
--- a/BUGS
+++ b/BUGS
@@ -1301,6 +1301,15 @@ WORKAROUND:
   (reported by Christophe Rhodes and Martin Atzmueller sbcl-devel
   2002-05-15)
 
+160:
+  USER-HOMEDIR-PATHNAME returns a pathname that SBCL can't do anything
+  with.  Probably we should return an absolute physical pathname
+  instead.  (Reported by Peter van Eynde sbcl-devel 2002-03-29)
+
+161:
+  Typep on certain SATISFIES types doesn't take account of the fact
+  that the function could cause an error; e.g. (TYPEP #\! '(SATISFIES
+  FBOUNDP)) raises an error when it should return NIL.
 
 DEFUNCT CATEGORIES OF BUGS
   IR1-#:
diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 8ceae40..b0e652a 100644
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -18,23 +18,22 @@
 (defknown %single-float (real) single-float (movable foldable flushable))
 (defknown %double-float (real) double-float (movable foldable flushable))
 
-(deftransform float ((n &optional f) (* &optional single-float) * :when :both)
+(deftransform float ((n &optional f) (* &optional single-float) *)
   '(%single-float n))
 
-(deftransform float ((n f) (* double-float) * :when :both)
+(deftransform float ((n f) (* double-float) *)
   '(%double-float n))
 
-(deftransform %single-float ((n) (single-float) * :when :both)
+(deftransform %single-float ((n) (single-float) *)
   'n)
 
-(deftransform %double-float ((n) (double-float) * :when :both)
+(deftransform %double-float ((n) (double-float) *)
   'n)
 
 ;;; RANDOM
 (macrolet ((frob (fun type)
 	     `(deftransform random ((num &optional state)
-				    (,type &optional *) *
-				    :when :both)
+				    (,type &optional *) *)
 		"Use inline float operations."
 		'(,fun num (or state *random-state*)))))
   (frob %random-single-float single-float)
@@ -139,26 +138,26 @@
 (defknown scale-double-float (double-float fixnum) double-float
   (movable foldable flushable))
 
-(deftransform decode-float ((x) (single-float) * :when :both)
+(deftransform decode-float ((x) (single-float) *)
   '(decode-single-float x))
 
-(deftransform decode-float ((x) (double-float) * :when :both)
+(deftransform decode-float ((x) (double-float) *)
   '(decode-double-float x))
 
-(deftransform integer-decode-float ((x) (single-float) * :when :both)
+(deftransform integer-decode-float ((x) (single-float) *)
   '(integer-decode-single-float x))
 
-(deftransform integer-decode-float ((x) (double-float) * :when :both)
+(deftransform integer-decode-float ((x) (double-float) *)
   '(integer-decode-double-float x))
 
-(deftransform scale-float ((f ex) (single-float *) * :when :both)
+(deftransform scale-float ((f ex) (single-float *) *)
   (if (and #!+x86 t #!-x86 nil
 	   (csubtypep (continuation-type ex)
 		      (specifier-type '(signed-byte 32))))
       '(coerce (%scalbn (coerce f 'double-float) ex) 'single-float)
       '(scale-single-float f ex)))
 
-(deftransform scale-float ((f ex) (double-float *) * :when :both)
+(deftransform scale-float ((f ex) (double-float *) *)
   (if (and #!+x86 t #!-x86 nil
 	   (csubtypep (continuation-type ex)
 		      (specifier-type '(signed-byte 32))))
@@ -292,7 +291,7 @@
 ;;; do it for any rational that has a precise representation as a
 ;;; float (such as 0).
 (macrolet ((frob (op)
-	     `(deftransform ,op ((x y) (float rational) * :when :both)
+	     `(deftransform ,op ((x y) (float rational) *)
 		"open-code FLOAT to RATIONAL comparison"
 		(unless (constant-continuation-p y)
 		  (give-up-ir1-transform
@@ -398,7 +397,7 @@
              `(progn
                (deftransform ,name ((x) (single-float) ,rtype)
                  `(coerce (,',prim (coerce x 'double-float)) 'single-float))
-               (deftransform ,name ((x) (double-float) ,rtype :when :both)
+               (deftransform ,name ((x) (double-float) ,rtype)
                  `(,',prim x)))))
   (def exp %exp *)
   (def log %log float)
@@ -433,7 +432,7 @@
                                  (type-specifier (continuation-type x)))
                                 `(coerce (,',prim (coerce x 'double-float)) 'single-float)))
                   #!-x86 `(coerce (,',prim (coerce x 'double-float)) 'single-float))
-               (deftransform ,name ((x) (double-float) * :when :both)
+               (deftransform ,name ((x) (double-float) *)
                  #!+x86 (cond ((csubtypep (continuation-type x)
                                           (specifier-type '(double-float
                                                             (#.(- (expt 2d0 64)))
@@ -453,18 +452,18 @@
 (deftransform atan ((x y) (single-float single-float) *)
   `(coerce (%atan2 (coerce x 'double-float) (coerce y 'double-float))
     'single-float))
-(deftransform atan ((x y) (double-float double-float) * :when :both)
+(deftransform atan ((x y) (double-float double-float) *)
   `(%atan2 x y))
 
 (deftransform expt ((x y) ((single-float 0f0) single-float) *)
   `(coerce (%pow (coerce x 'double-float) (coerce y 'double-float))
     'single-float))
-(deftransform expt ((x y) ((double-float 0d0) double-float) * :when :both)
+(deftransform expt ((x y) ((double-float 0d0) double-float) *)
   `(%pow x y))
 (deftransform expt ((x y) ((single-float 0f0) (signed-byte 32)) *)
   `(coerce (%pow (coerce x 'double-float) (coerce y 'double-float))
     'single-float))
-(deftransform expt ((x y) ((double-float 0d0) (signed-byte 32)) * :when :both)
+(deftransform expt ((x y) ((double-float 0d0) (signed-byte 32)) *)
   `(%pow x (coerce y 'double-float)))
 
 ;;; ANSI says log with base zero returns zero.
@@ -473,7 +472,7 @@
 
 ;;; Handle some simple transformations.
 
-(deftransform abs ((x) ((complex double-float)) double-float :when :both)
+(deftransform abs ((x) ((complex double-float)) double-float)
   '(%hypot (realpart x) (imagpart x)))
 
 (deftransform abs ((x) ((complex single-float)) single-float)
@@ -481,7 +480,7 @@
 		   (coerce (imagpart x) 'double-float))
 	  'single-float))
 
-(deftransform phase ((x) ((complex double-float)) double-float :when :both)
+(deftransform phase ((x) ((complex double-float)) double-float)
   '(%atan2 (imagpart x) (realpart x)))
 
 (deftransform phase ((x) ((complex single-float)) single-float)
@@ -489,7 +488,7 @@
 		   (coerce (realpart x) 'double-float))
 	  'single-float))
 
-(deftransform phase ((x) ((float)) float :when :both)
+(deftransform phase ((x) ((float)) float)
   '(if (minusp (float-sign x))
        (float pi x)
        (float 0 x)))
diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index acec941..c8eb5e9 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -465,7 +465,7 @@
 ;;; FUNCALL is implemented on %FUNCALL, which can only call functions
 ;;; (not symbols). %FUNCALL is used directly in some places where the
 ;;; call should always be open-coded even if FUNCALL is :NOTINLINE.
-(deftransform funcall ((function &rest args) * * :when :both)
+(deftransform funcall ((function &rest args) * *)
   (let ((arg-names (make-gensym-list (length args))))
     `(lambda (function ,@arg-names)
        (%funcall ,(if (csubtypep (continuation-type function)
@@ -490,7 +490,6 @@
       (values nil t)))
 
 (deftransform %coerce-callable-to-fun ((thing) (function) *
-				       :when :both
 				       :important t)
   "optimize away possible call to FDEFINITION at runtime"
   'thing)
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 822178a..66df637 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -982,20 +982,7 @@
 		    (policy node (>= speed inhibit-warnings))
 		    (policy node (> speed inhibit-warnings))))
 	 (*compiler-error-context* node))
-    (cond ((not (member (transform-when transform)
-			'(:native :both)))
-	   ;; FIXME: Make sure that there's a transform for
-	   ;; (MEMBER SYMBOL ..) into MEMQ.
-	   ;; FIXME: Note that when/if I make SHARE operation to shared
-	   ;; constant data between objects in the system, remember that a
-	   ;; SHAREd list, or other SHAREd compound object, can be processed
-	   ;; recursively, so that e.g. the two lists above can share their
-	   ;; '(:BOTH) tail sublists.
-	   (let ((when (transform-when transform)))
-	     (not (or (eq when :both)
-		      (eq when :native))))
-	   t)
-	  ((or (not constrained)
+    (cond ((or (not constrained)
 	       (valid-fun-use node type :strict-result t))
 	   (multiple-value-bind (severity args)
 	       (catch 'give-up-ir1-transform
diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp
index ee94ecd..c5fa533 100644
--- a/src/compiler/knownfun.lisp
+++ b/src/compiler/knownfun.lisp
@@ -135,36 +135,30 @@
   ;; string used in efficiency notes
   (note (missing-arg) :type string)
   ;; T if we should emit a failure note even if SPEED=INHIBIT-WARNINGS.
-  (important nil :type (member t nil))
-  ;; usable for byte code, native code, or both?
-  ;;
-  ;; FIXME: Now that there's no byte compiler, this is stale and could
-  ;; all go away.
-  (when :native :type (member :byte :native :both)))
+  (important nil :type (member t nil)))
 
-(defprinter (transform) type note important when)
+(defprinter (transform) type note important)
 
 ;;; Grab the FUN-INFO and enter the function, replacing any old
 ;;; one with the same type and note.
 (declaim (ftype (function (t list function &optional (or string null)
-			     (member t nil) (member :native :byte :both))
+			     (member t nil))
 			  *)
 		%deftransform))
-(defun %deftransform (name type fun &optional note important (when :native))
+(defun %deftransform (name type fun &optional note important)
   (let* ((ctype (specifier-type type))
 	 (note (or note "optimize"))
 	 (info (fun-info-or-lose name))
 	 (old (find-if (lambda (x)
 			 (and (type= (transform-type x) ctype)
 			      (string-equal (transform-note x) note)
-			      (eq (transform-important x) important)
-			      (eq (transform-when x) when)))
+			      (eq (transform-important x) important)))
 		       (fun-info-transforms info))))
     (if old
 	(setf (transform-function old) fun
 	      (transform-note old) note)
 	(push (make-transform :type ctype :function fun :note note
-			      :important important :when when)
+			      :important important)
 	      (fun-info-transforms info)))
     name))
 
diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 1141310..d1170eb 100644
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -386,13 +386,10 @@
 ;;;             which means efficiency notes will be generated when this
 ;;;             transform fails even if INHIBIT-WARNINGS=SPEED (but not if
 ;;;             INHIBIT-WARNINGS>SPEED).
-;;;   :WHEN {:NATIVE | :BYTE | :BOTH}
-;;;           - Indicates whether this transform applies to native code,
-;;;             byte-code or both (default :native.)
 (defmacro deftransform (name (lambda-list &optional (arg-types '*)
 					  (result-type '*)
 					  &key result policy node defun-only
-					  eval-name important (when :native))
+					  eval-name important)
 			     &body body-decls-doc)
   (when (and eval-name defun-only)
     (error "can't specify both DEFUN-ONLY and EVAL-NAME"))
@@ -433,8 +430,7 @@
 		     `'(function ,arg-types ,result-type))
 		(lambda ,@stuff)
 		,doc
-		,(if important t nil)
-		,when)))))))
+		,(if important t nil))))))))
 
 ;;;; DEFKNOWN and DEFOPTIMIZER
 
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 6b4f154..2e5251d 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -214,13 +214,13 @@
 		      (declare (ignorable dacc))
 		      ,push-dacc))))))))))
 
-(deftransform elt ((s i) ((simple-array * (*)) *) * :when :both)
+(deftransform elt ((s i) ((simple-array * (*)) *) *)
   '(aref s i))
 
-(deftransform elt ((s i) (list *) * :when :both)
+(deftransform elt ((s i) (list *) *)
   '(nth i s))
 
-(deftransform %setelt ((s i v) ((simple-array * (*)) * *) * :when :both)
+(deftransform %setelt ((s i v) ((simple-array * (*)) * *) *)
   '(%aset s i v))
 
 (deftransform %setelt ((s i v) (list * *))
@@ -228,7 +228,7 @@
 
 (macrolet ((def (name)
              `(deftransform ,name ((e l &key (test #'eql)) * *
-				   :node node :when :both)
+				   :node node)
                 (unless (constant-continuation-p l)
                   (give-up-ir1-transform))
 
diff --git a/src/compiler/sparc/float.lisp b/src/compiler/sparc/float.lisp
index 64b67e3..5834443 100644
--- a/src/compiler/sparc/float.lisp
+++ b/src/compiler/sparc/float.lisp
@@ -2548,7 +2548,7 @@
 	   (make-canonical-union-type (list (continuation-type x)
 					    (continuation-type y)))))))
 
-(deftransform max ((x y) (number number) * :when :both)
+(deftransform max ((x y) (number number) *)
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y))
 	(signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
@@ -2578,7 +2578,7 @@
 	       (if (> ,arg1 ,arg2)
 		   ,arg1 ,arg2)))))))
 
-(deftransform min ((x y) (real real) * :when :both)
+(deftransform min ((x y) (real real) *)
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y))
 	(signed (specifier-type '(signed-byte #.sb!vm:n-word-bits)))
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index f48639c..af914ef 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -40,7 +40,7 @@
 ;;; lambda with the appropriate fixed number of args. If the
 ;;; destination is a FUNCALL, then do the &REST APPLY thing, and let
 ;;; MV optimization figure things out.
-(deftransform complement ((fun) * * :node node :when :both)
+(deftransform complement ((fun) * * :node node)
   "open code"
   (multiple-value-bind (min max)
       (fun-type-nargs (continuation-type fun))
@@ -2492,7 +2492,7 @@
 		 "place constant arg last"))
 
 ;;; Handle the case of a constant BOOLE-CODE.
-(deftransform boole ((op x y) * * :when :both)
+(deftransform boole ((op x y) * *)
   "convert to inline logical operations"
   (unless (constant-continuation-p op)
     (give-up-ir1-transform "BOOLE code is not a constant."))
@@ -2521,7 +2521,7 @@
 ;;;; converting special case multiply/divide to shifts
 
 ;;; If arg is a constant power of two, turn * into a shift.
-(deftransform * ((x y) (integer integer) * :when :both)
+(deftransform * ((x y) (integer integer) *)
   "convert x*2^k to shift"
   (unless (constant-continuation-p y)
     (give-up-ir1-transform))
@@ -2608,7 +2608,7 @@
     (frob y t)))
 
 ;;; Do the same for MOD.
-(deftransform mod ((x y) (integer integer) * :when :both)
+(deftransform mod ((x y) (integer integer) *)
   "convert remainder mod 2^k to LOGAND"
   (unless (constant-continuation-p y)
     (give-up-ir1-transform))
@@ -2645,7 +2645,7 @@
 		   (logand x ,mask))))))
 
 ;;; And the same for REM.
-(deftransform rem ((x y) (integer integer) * :when :both)
+(deftransform rem ((x y) (integer integer) *)
   "convert remainder mod 2^k to LOGAND"
   (unless (constant-continuation-p y)
     (give-up-ir1-transform))
@@ -2664,8 +2664,7 @@
 ;;; Flush calls to various arith functions that convert to the
 ;;; identity function or a constant.
 (macrolet ((def (name identity result)
-             `(deftransform ,name ((x y) (* (constant-arg (member ,identity)))
-                                    * :when :both)
+             `(deftransform ,name ((x y) (* (constant-arg (member ,identity))) *)
                 "fold identity operations"
                 ',result)))
   (def ash 0 x)
@@ -2678,12 +2677,10 @@
 
 ;;; These are restricted to rationals, because (- 0 0.0) is 0.0, not -0.0, and
 ;;; (* 0 -4.0) is -0.0.
-(deftransform - ((x y) ((constant-arg (member 0)) rational) *
-		 :when :both)
+(deftransform - ((x y) ((constant-arg (member 0)) rational) *)
   "convert (- 0 x) to negate"
   '(%negate y))
-(deftransform * ((x y) (rational (constant-arg (member 0))) *
-		 :when :both)
+(deftransform * ((x y) (rational (constant-arg (member 0))) *)
   "convert (* x 0) to 0"
   0)
 
@@ -2725,7 +2722,7 @@
 ;;;
 ;;; If y is not constant, not zerop, or is contagious, or a positive
 ;;; float +0.0 then give up.
-(deftransform + ((x y) (t (constant-arg t)) * :when :both)
+(deftransform + ((x y) (t (constant-arg t)) *)
   "fold zero arg"
   (let ((val (continuation-value y)))
     (unless (and (zerop val)
@@ -2738,7 +2735,7 @@
 ;;;
 ;;; If y is not constant, not zerop, or is contagious, or a negative
 ;;; float -0.0 then give up.
-(deftransform - ((x y) (t (constant-arg t)) * :when :both)
+(deftransform - ((x y) (t (constant-arg t)) *)
   "fold zero arg"
   (let ((val (continuation-value y)))
     (unless (and (zerop val)
@@ -2749,8 +2746,7 @@
 
 ;;; Fold (OP x +/-1)
 (macrolet ((def (name result minus-result)
-             `(deftransform ,name ((x y) (t (constant-arg real))
-                                    * :when :both)
+             `(deftransform ,name ((x y) (t (constant-arg real)) *)
                 "fold identity operations"
                 (let ((val (continuation-value y)))
                   (unless (and (= (abs val) 1)
@@ -2787,7 +2783,7 @@
 ;;; doing them?  -- WHN 19990917
 (macrolet ((def (name)
              `(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
-                                   * :when :both)
+                                   *)
                 "fold zero arg"
                 0)))
   (def ash)
@@ -2795,7 +2791,7 @@
 
 (macrolet ((def (name)
              `(deftransform ,name ((x y) ((constant-arg (integer 0 0)) integer)
-                                   * :when :both)
+                                   *)
                 "fold zero arg"
                 '(values 0 0))))
   (def truncate)
@@ -2849,8 +2845,7 @@
 ;;; if there is no intersection between the types of the arguments,
 ;;; then the result is definitely false.
 (deftransform simple-equality-transform ((x y) * *
-					 :defun-only t
-					 :when :both)
+					 :defun-only t)
   (cond ((same-leaf-ref-p x y)
 	 t)
 	((not (types-equal-or-intersect (continuation-type x)
@@ -2878,7 +2873,7 @@
 ;;;    these interesting cases.
 ;;; -- If Y is a fixnum, then we quietly pass because the back end can
 ;;;    handle that case, otherwise give an efficiency note.
-(deftransform eql ((x y) * * :when :both)
+(deftransform eql ((x y) * *)
   "convert to simpler equality predicate"
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y))
@@ -2904,7 +2899,7 @@
 
 ;;; Convert to EQL if both args are rational and complexp is specified
 ;;; and the same for both.
-(deftransform = ((x y) * * :when :both)
+(deftransform = ((x y) * *)
   "open code"
   (let ((x-type (continuation-type x))
 	(y-type (continuation-type y)))
@@ -2982,18 +2977,18 @@
 	      (t
 	       (give-up-ir1-transform))))))
 
-(deftransform < ((x y) (integer integer) * :when :both)
+(deftransform < ((x y) (integer integer) *)
   (ir1-transform-< x y x y '>))
 
-(deftransform > ((x y) (integer integer) * :when :both)
+(deftransform > ((x y) (integer integer) *)
   (ir1-transform-< y x x y '<))
 
 #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(deftransform < ((x y) (float float) * :when :both)
+(deftransform < ((x y) (float float) *)
   (ir1-transform-< x y x y '>))
 
 #-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(deftransform > ((x y) (float float) * :when :both)
+(deftransform > ((x y) (float float) *)
   (ir1-transform-< y x x y '<))
 
 ;;;; converting N-arg comparisons
diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index ddd6066..3117ce2 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -97,8 +97,7 @@
 
 ;;; If FIND-CLASS is called on a constant class, locate the CLASS-CELL
 ;;; at load time.
-(deftransform find-class ((name) ((constant-arg symbol)) *
-			  :when :both)
+(deftransform find-class ((name) ((constant-arg symbol)) *)
   (let* ((name (continuation-value name))
 	 (cell (find-class-cell name)))
     `(or (class-cell-class ',cell)
@@ -385,7 +384,7 @@
 ;;; then we also check whether the layout for the object is invalid
 ;;; and signal an error if so. Otherwise, look up the indirect
 ;;; class-cell and call CLASS-CELL-TYPEP at runtime.
-(deftransform %instance-typep ((object spec) (* *) * :node node :when :both)
+(deftransform %instance-typep ((object spec) (* *) * :node node)
   (aver (constant-continuation-p spec))
   (let* ((spec (continuation-value spec))
 	 (class (specifier-type spec))
@@ -526,7 +525,7 @@
 
 ;;;; coercion
 
-(deftransform coerce ((x type) (* *) * :when :both)
+(deftransform coerce ((x type) (* *) *)
   (unless (constant-continuation-p type)
     (give-up-ir1-transform))
   (let ((tspec (specifier-type (continuation-value type))))
diff --git a/version.lisp-expr b/version.lisp-expr
index d740ca2..4f6f89a 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.2.12"
+"0.7.2.13"
-- 
1.7.10.4