From 7ce4dc62a7b03590b127bb950738e771e33341a7 Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 12 Sep 2002 15:11:33 +0000
Subject: [PATCH] 0.7.7.20-backend-cleanup-1.9: 	Really delete the PPC dead
 code (was commented out before) 	... deletia 	Add
 some boilerplate to various files.

---
 src/compiler/generic/early-type-vops.lisp |   12 +-
 src/compiler/generic/late-type-vops.lisp  |   12 +-
 src/compiler/ppc/macros.lisp              |  191 ----------------------
 src/compiler/ppc/type-vops.lisp           |  248 -----------------------------
 version.lisp-expr                         |    2 +-
 5 files changed, 23 insertions(+), 442 deletions(-)

diff --git a/src/compiler/generic/early-type-vops.lisp b/src/compiler/generic/early-type-vops.lisp
index 4aa4fa3..8b4d96c 100644
--- a/src/compiler/generic/early-type-vops.lisp
+++ b/src/compiler/generic/early-type-vops.lisp
@@ -1,5 +1,15 @@
-(in-package "SB!VM")
+;;;; generic type testing and checking apparatus
 
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+(in-package "SB!VM")
+
 (defparameter *immediate-types*
   (list unbound-marker-widetag base-char-widetag))
 
diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp
index 45ff2f0..4953792 100644
--- a/src/compiler/generic/late-type-vops.lisp
+++ b/src/compiler/generic/late-type-vops.lisp
@@ -1,5 +1,15 @@
+;;;; generic type testing and checking VOPs
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
 (in-package "SB!VM")
-
+
 (!define-type-vops fixnump check-fixnum fixnum object-not-fixnum-error
   (even-fixnum-lowtag odd-fixnum-lowtag)
   ;; we can save a register on the x86.
diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index 147dfd1..2dfb14b 100644
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -156,197 +156,6 @@
        ,@body)))
 
 
-;;;; Type testing noise.
-
-;;; GEN-RANGE-TEST -- internal
-;;;
-;;; Generate code that branches to TARGET iff REG contains one of VALUES.
-;;; If NOT-P is true, invert the test.  Jumping to NOT-TARGET is the same
-;;; as falling out the bottom.
-;;; 
-
-#|
-(defun gen-range-test (reg target not-target not-p min seperation max values)
-  (let ((tests nil)
-	(start nil)
-	(end nil)
-	(insts nil))
-    (multiple-value-bind (equal less-or-equal greater-or-equal label)
-			 (if not-p
-			     (values :ne :gt :lt not-target)
-			     (values :eq :le :ge target))
-      (flet ((emit-test ()
-	       (if (= start end)
-		   (push start tests)
-		   (push (cons start end) tests))))
-	(dolist (value values)
-	  (cond ((< value min)
-		 (error "~S is less than the specified minimum of ~S"
-			value min))
-		((> value max)
-		 (error "~S is greater than the specified maximum of ~S"
-			value max))
-		((not (zerop (rem (- value min) seperation)))
-		 (error "~S isn't an even multiple of ~S from ~S"
-			value seperation min))
-		((null start)
-		 (setf start value))
-		((> value (+ end seperation))
-		 (emit-test)
-		 (setf start value)))
-	  (setf end value))
-	(emit-test))
-      (macrolet ((inst (name &rest args)
-		       `(push (list 'inst ',name ,@args) insts)))
-	(do ((remaining (nreverse tests) (cdr remaining)))
-	    ((null remaining))
-	  (let ((test (car remaining))
-		(last (null (cdr remaining))))
-	    (if (atom test)
-		(progn
-		  (inst cmpwi reg test)
-		  (if last
-		      (inst b? equal target)
-		      (inst beq label)))
-		(let ((start (car test))
-		      (end (cdr test)))
-		  (cond ((and (= start min) (= end max))
-			 (warn "The values ~S cover the entire range from ~
-			 ~S to ~S [step ~S]."
-			       values min max seperation)
-			 (push `(unless ,not-p (inst b ,target)) insts))
-			((= start min)
-			 (inst cmpwi reg end)
-			 (if last
-			     (inst b? less-or-equal target)
-			     (inst ble label)))
-			((= end max)
-			 (inst cmpwi reg start)
-			 (if last
-			     (inst b? greater-or-equal target)
-			     (inst bge label)))
-			(t
-			 (inst cmpwi reg start)
-			 (inst blt (if not-p target not-target))
-			 (inst cmpwi reg end)
-			 (if last
-			     (inst b? less-or-equal target)
-			     (inst ble label))))))))))
-    (nreverse insts)))
-
-(defun gen-other-immediate-test (reg target not-target not-p values)
-  (gen-range-test reg target not-target not-p
-		  (+ other-immediate-0-lowtag lowtag-limit)
-		  (- other-immediate-1-lowtag other-immediate-0-lowtag)
-		  (ash 1 n-widetag-bits)
-		  values))
-
-
-(defun test-type-aux (reg temp target not-target not-p lowtags immed hdrs
-			  function-p)
-  (let* ((fixnump (and (member even-fixnum-lowtag lowtags :test #'eql)
-		       (member odd-fixnum-lowtag lowtags :test #'eql)))
-	 (lowtags (sort (if fixnump
-			    (delete even-fixnum-lowtag
-				    (remove odd-fixnum-lowtag lowtags
-					    :test #'eql)
-				    :test #'eql)
-			    (copy-list lowtags))
-			#'<))
-	 (lowtag (if function-p
-		     sb!vm:fun-pointer-lowtag
-		     sb!vm:other-pointer-lowtag))
-	 (hdrs (sort (copy-list hdrs) #'<))
-	 (immed (sort (copy-list immed) #'<)))
-    (append
-     (when immed
-       `((inst andi. ,temp ,reg widetag-mask)
-	 ,@(if (or fixnump lowtags hdrs)
-	       (let ((fall-through (gensym)))
-		 `((let (,fall-through (gen-label))
-		     ,@(gen-other-immediate-test
-			temp (if not-p not-target target)
-			fall-through nil immed)
-		     (emit-label ,fall-through))))
-	       (gen-other-immediate-test temp target not-target not-p immed))))
-     (when fixnump
-       `((inst andi. ,temp ,reg 3)
-	 ,(if (or lowtags hdrs)
-	      `(inst beq ,(if not-p not-target target))
-	      `(inst b? ,(if not-p :ne :eq) ,target))))
-     (when (or lowtags hdrs)
-       `((inst andi. ,temp ,reg lowtag-mask)))
-     (when lowtags
-       (if hdrs
-	   (let ((fall-through (gensym)))
-	     `((let ((,fall-through (gen-label)))
-		 ,@(gen-range-test temp (if not-p not-target target)
-				   fall-through nil
-				   0 1 (1- lowtag-limit) lowtags)
-		 (emit-label ,fall-through))))
-	   (gen-range-test temp target not-target not-p 0 1
-			   (1- lowtag-limit) lowtags)))
-     (when hdrs
-       `((inst cmpwi ,temp ,lowtag)
-	 (inst bne ,(if not-p target not-target))
-	 (load-type ,temp ,reg (- ,lowtag))
-	 ,@(gen-other-immediate-test temp target not-target not-p hdrs))))))
-
-(defparameter immediate-types
-  (list base-char-widetag unbound-marker-widetag))
-
-(defparameter function-subtypes
-  (list funcallable-instance-header-widetag
-	simple-fun-header-widetag closure-fun-header-widetag
-	closure-header-widetag))
-
-(defmacro test-type (register temp target not-p &rest type-codes)
-  (let* ((type-codes (mapcar #'eval type-codes))
-	 (lowtags (remove lowtag-limit type-codes :test #'<))
-	 (extended (remove lowtag-limit type-codes :test #'>))
-	 (immediates (intersection extended immediate-types :test #'eql))
-	 (headers (set-difference extended immediate-types :test #'eql))
-	 (function-p nil))
-    (unless type-codes
-      (error "Must supply at least on type for test-type."))
-    (when (and headers (member other-pointer-lowtag lowtags))
-      (warn "OTHER-POINTER-LOWTAG supersedes the use of ~S" headers)
-      (setf headers nil))
-    (when (and immediates
-	       (or (member other-immediate-0-lowtag lowtags)
-		   (member other-immediate-1-lowtag lowtags)))
-      (warn "OTHER-IMMEDIATE-n-LOWTAG supersedes the use of ~S" immediates)
-      (setf immediates nil))
-    (when (intersection headers function-subtypes)
-      (unless (subsetp headers function-subtypes)
-	(error "Can't test for mix of function subtypes and normal ~
-		header types."))
-      (setq function-p t))
-      
-    (let ((n-reg (gensym))
-	  (n-temp (gensym))
-	  (n-target (gensym))
-	  (not-target (gensym)))
-      `(let ((,n-reg ,register)
-	     (,n-temp ,temp)
-	     (,n-target ,target)
-	     (,not-target (gen-label)))
-	 (declare (ignorable ,n-temp))
-	 ,@(if (constantp not-p)
-	       (test-type-aux n-reg n-temp n-target not-target
-			      (eval not-p) lowtags immediates headers
-			      function-p)
-	       `((cond (,not-p
-			,@(test-type-aux n-reg n-temp n-target not-target t
-					 lowtags immediates headers
-					 function-p))
-		       (t
-			,@(test-type-aux n-reg n-temp n-target not-target nil
-					 lowtags immediates headers
-					 function-p)))))
-	 (emit-label ,not-target)))))
-|#
-
 ;;;; Error Code
 
 (defvar *adjustable-vectors* nil)
diff --git a/src/compiler/ppc/type-vops.lisp b/src/compiler/ppc/type-vops.lisp
index ccb2f07..87d5dee 100644
--- a/src/compiler/ppc/type-vops.lisp
+++ b/src/compiler/ppc/type-vops.lisp
@@ -130,254 +130,6 @@
 			   (move result value))))))))
        ,@(when ptype
 	   `((primitive-type-vop ,check-name (:check) ,ptype))))))
-
-#|
-  (def-type-vops fixnump nil nil object-not-fixnum-error
-		 sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag)
-  (define-vop (check-fixnum check-type)
-      (:generator 3
-		  (inst andi. temp value 3)
-		  (inst twi 0 value (error-number-or-lose 'object-not-fixnum-error))
-		  (inst twi :ne temp 0)
-		  (move result value)))
-  (primitive-type-vop check-fixnum (:check) fixnum)
-  (def-type-vops functionp nil nil
-		 object-not-fun-error sb!vm:fun-pointer-lowtag)
-  
-  (define-vop (check-fun check-type)
-      (:generator 3
-		  (inst andi. temp value 7)
-		  (inst twi 0 value (error-number-or-lose 'object-not-fun-error))
-		  (inst twi :ne temp sb!vm:fun-pointer-lowtag)
-		  (move result value)))
-  (primitive-type-vop check-fun (:check) function)
-  
-  (def-type-vops listp nil nil
-		 object-not-list-error sb!vm:list-pointer-lowtag)
-  (define-vop (check-list check-type)
-      (:generator 3
-		  (inst andi. temp value 7)
-		  (inst twi 0 value (error-number-or-lose 'object-not-list-error))
-		  (inst twi :ne temp sb!vm:list-pointer-lowtag)
-		  (move result value)))
-  (primitive-type-vop check-list (:check) list)
-  
-  (def-type-vops %instancep nil nil
-		 object-not-instance-error sb!vm:instance-pointer-lowtag)
-  (define-vop (check-instance check-type)
-      (:generator 3
-		  (inst andi. temp value 7)
-		  (inst twi 0 value (error-number-or-lose 'object-not-instance-error))
-		  (inst twi :ne temp sb!vm:instance-pointer-lowtag)
-		  (move result value)))
-  (primitive-type-vop check-instance (:check) instance)
-  
-  
-  (def-type-vops bignump check-bignum bignum
-		 object-not-bignum-error sb!vm:bignum-widetag)
-  
-  (def-type-vops ratiop check-ratio ratio
-		 object-not-ratio-error sb!vm:ratio-widetag)
-  
-  (def-type-vops complexp check-complex complex
-		 object-not-complex-error sb!vm:complex-widetag
-		 complex-single-float-widetag complex-double-float-widetag)
-  
-  (def-type-vops complex-rational-p check-complex-rational nil
-		 object-not-complex-rational-error complex-widetag)
-  
-  (def-type-vops complex-float-p check-complex-float nil
-		 object-not-complex-float-error
-		 complex-single-float-widetag complex-double-float-widetag)
-  
-  (def-type-vops complex-single-float-p check-complex-single-float
-    complex-single-float object-not-complex-single-float-error
-    complex-single-float-widetag)
-  
-  (def-type-vops complex-double-float-p check-complex-double-float
-    complex-double-float object-not-complex-double-float-error
-    complex-double-float-widetag)
-  
-(def-type-vops single-float-p check-single-float single-float
-  object-not-single-float-error sb!vm:single-float-widetag)
-
-(def-type-vops double-float-p check-double-float double-float
-  object-not-double-float-error sb!vm:double-float-widetag)
-
-(def-type-vops simple-string-p check-simple-string simple-string
-  object-not-simple-string-error sb!vm:simple-string-widetag)
-
-(def-type-vops simple-bit-vector-p check-simple-bit-vector simple-bit-vector
-  object-not-simple-bit-vector-error simple-bit-vector-widetag)
-
-(def-type-vops simple-vector-p check-simple-vector simple-vector
-  object-not-simple-vector-error sb!vm:simple-vector-widetag)
-
-(def-type-vops simple-array-unsigned-byte-2-p
-  check-simple-array-unsigned-byte-2
-  simple-array-unsigned-byte-2
-  object-not-simple-array-unsigned-byte-2-error
-  sb!vm:simple-array-unsigned-byte-2-widetag)
-
-(def-type-vops simple-array-unsigned-byte-4-p
-  check-simple-array-unsigned-byte-4
-  simple-array-unsigned-byte-4
-  object-not-simple-array-unsigned-byte-4-error
-  sb!vm:simple-array-unsigned-byte-4-widetag)
-
-(def-type-vops simple-array-unsigned-byte-8-p
-  check-simple-array-unsigned-byte-8
-  simple-array-unsigned-byte-8
-  object-not-simple-array-unsigned-byte-8-error
-  sb!vm:simple-array-unsigned-byte-8-widetag)
-
-(def-type-vops simple-array-unsigned-byte-16-p
-  check-simple-array-unsigned-byte-16
-  simple-array-unsigned-byte-16
-  object-not-simple-array-unsigned-byte-16-error
-  sb!vm:simple-array-unsigned-byte-16-widetag)
-
-(def-type-vops simple-array-unsigned-byte-32-p
-  check-simple-array-unsigned-byte-32
-  simple-array-unsigned-byte-32
-  object-not-simple-array-unsigned-byte-32-error
-  sb!vm:simple-array-unsigned-byte-32-widetag)
-
-(def-type-vops simple-array-signed-byte-8-p
-  check-simple-array-signed-byte-8
-  simple-array-signed-byte-8
-  object-not-simple-array-signed-byte-8-error
-  simple-array-signed-byte-8-widetag)
-
-(def-type-vops simple-array-signed-byte-16-p
-  check-simple-array-signed-byte-16
-  simple-array-signed-byte-16
-  object-not-simple-array-signed-byte-16-error
-  simple-array-signed-byte-16-widetag)
-
-(def-type-vops simple-array-signed-byte-30-p
-  check-simple-array-signed-byte-30
-  simple-array-signed-byte-30
-  object-not-simple-array-signed-byte-30-error
-  simple-array-signed-byte-30-widetag)
-
-(def-type-vops simple-array-signed-byte-32-p
-  check-simple-array-signed-byte-32
-  simple-array-signed-byte-32
-  object-not-simple-array-signed-byte-32-error
-  simple-array-signed-byte-32-widetag)
-
-(def-type-vops simple-array-single-float-p check-simple-array-single-float
-  simple-array-single-float object-not-simple-array-single-float-error
-  sb!vm:simple-array-single-float-widetag)
-
-(def-type-vops simple-array-double-float-p check-simple-array-double-float
-  simple-array-double-float object-not-simple-array-double-float-error
-  sb!vm:simple-array-double-float-widetag)
-
-(def-type-vops simple-array-complex-single-float-p
-  check-simple-array-complex-single-float
-  simple-array-complex-single-float
-  object-not-simple-array-complex-single-float-error
-  simple-array-complex-single-float-widetag)
-
-(def-type-vops simple-array-complex-double-float-p
-  check-simple-array-complex-double-float
-  simple-array-complex-double-float
-  object-not-simple-array-complex-double-float-error
-  simple-array-complex-double-float-widetag)
-
-(def-type-vops base-char-p check-base-char base-char
-  object-not-base-char-error sb!vm:base-char-widetag)
-
-(def-type-vops system-area-pointer-p check-system-area-pointer
-  system-area-pointer object-not-sap-error sb!vm:sap-widetag)
-
-(def-type-vops weak-pointer-p check-weak-pointer weak-pointer
-  object-not-weak-pointer-error sb!vm:weak-pointer-widetag)
-
-(def-type-vops code-component-p nil nil nil
-  sb!vm:code-header-widetag)
-
-(def-type-vops lra-p nil nil nil
-  sb!vm:return-pc-header-widetag)
-
-(def-type-vops fdefn-p nil nil nil
-  sb!vm:fdefn-widetag)
-
-(def-type-vops funcallable-instance-p nil nil nil
-  sb!vm:funcallable-instance-header-widetag)
-
-(def-type-vops array-header-p nil nil nil
-  sb!vm:simple-array-widetag sb!vm:complex-string-widetag sb!vm:complex-bit-vector-widetag
-  sb!vm:complex-vector-widetag sb!vm:complex-array-widetag)
-
-(def-type-vops nil check-function-or-symbol nil object-not-function-or-symbol-error
-  sb!vm:fun-pointer-lowtag sb!vm:symbol-header-widetag)
-
-(def-type-vops stringp check-string nil object-not-string-error
-  sb!vm:simple-string-widetag sb!vm:complex-string-widetag)
-
-(def-type-vops complex-vector-p check-complex-vector nil
- object-not-complex-vector-error complex-vector-widetag)
-
-(def-type-vops bit-vector-p check-bit-vector nil object-not-bit-vector-error
-  sb!vm:simple-bit-vector-widetag sb!vm:complex-bit-vector-widetag)
-
-(def-type-vops vectorp check-vector nil object-not-vector-error
-  simple-string-widetag simple-bit-vector-widetag simple-vector-widetag
-  simple-array-unsigned-byte-2-widetag simple-array-unsigned-byte-4-widetag
-  simple-array-unsigned-byte-8-widetag simple-array-unsigned-byte-16-widetag
-  simple-array-unsigned-byte-32-widetag
-  simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
-  simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
-  simple-array-single-float-widetag simple-array-double-float-widetag
-  simple-array-complex-single-float-widetag
-  simple-array-complex-double-float-widetag
-  complex-string-widetag complex-bit-vector-widetag complex-vector-widetag)
-
-(def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error
-  simple-array-widetag simple-string-widetag simple-bit-vector-widetag
-  simple-vector-widetag simple-array-unsigned-byte-2-widetag
-  simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
-  simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
-  simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
-  simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
-  simple-array-single-float-widetag simple-array-double-float-widetag
-  simple-array-complex-single-float-widetag
-  simple-array-complex-double-float-widetag)
-
-(def-type-vops arrayp check-array nil object-not-array-error
-  simple-array-widetag simple-string-widetag simple-bit-vector-widetag
-  simple-vector-widetag simple-array-unsigned-byte-2-widetag
-  simple-array-unsigned-byte-4-widetag simple-array-unsigned-byte-8-widetag
-  simple-array-unsigned-byte-16-widetag simple-array-unsigned-byte-32-widetag
-  simple-array-signed-byte-8-widetag simple-array-signed-byte-16-widetag
-  simple-array-signed-byte-30-widetag simple-array-signed-byte-32-widetag
-  simple-array-single-float-widetag simple-array-double-float-widetag
-  simple-array-complex-single-float-widetag
-  simple-array-complex-double-float-widetag
-  complex-string-widetag complex-bit-vector-widetag complex-vector-widetag
-  complex-array-widetag)
-
-(def-type-vops numberp check-number nil object-not-number-error
-  even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag ratio-widetag
-  single-float-widetag double-float-widetag complex-widetag
-  complex-single-float-widetag complex-double-float-widetag)
-
-(def-type-vops rationalp check-rational nil object-not-rational-error
-  sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:ratio-widetag sb!vm:bignum-widetag)
-
-(def-type-vops integerp check-integer nil object-not-integer-error
-  sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:bignum-widetag)
-
-(def-type-vops floatp check-float nil object-not-float-error
-  sb!vm:single-float-widetag sb!vm:double-float-widetag)
-
-(def-type-vops realp check-real nil object-not-real-error
-  sb!vm:even-fixnum-lowtag sb!vm:odd-fixnum-lowtag sb!vm:ratio-widetag sb!vm:bignum-widetag
-  sb!vm:single-float-widetag sb!vm:double-float-widetag))
-|#
 
 ;;;; Other integer ranges.
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 8b95227..6e267b1 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.7.20-backend-cleanup-1.8"
+"0.7.7.20-backend-cleanup-1.9"
-- 
1.7.10.4