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.

diff --git a/src/compiler/generic/early-type-vops.lisp b/src/compiler/generic/early-type-vops.lisp
index 4aa4fa3..8b4d96c 100644 (file)
--- 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")
+\f
 (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 (file)
--- 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")
-
+\f
 (!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 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -156,197 +156,6 @@
        ,@body)))
 
 \f
-;;;; 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)))))
-|#
-\f
 ;;;; 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 (file)
--- 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))
-|#
 \f
 ;;;; Other integer ranges.
 

diff --git a/version.lisp-expr b/version.lisp-expr
index 8b95227..6e267b1 100644 (file)
--- 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"