CMUCL commit: amd64-dd-branch src/tools/cross-scripts (cross-x86-amd64.lisp)

[Raymond Toy]

    Date: Friday, November 6, 2009 @ 22:56:10
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/tools/cross-scripts
     Tag: amd64-dd-branch

Modified: cross-x86-amd64.lisp

Clean up a bit by removing unused experimental junk.


----------------------+
 cross-x86-amd64.lisp |  104 -------------------------------------------------
 1 file changed, 1 insertion(+), 103 deletions(-)


Index: src/tools/cross-scripts/cross-x86-amd64.lisp
diff -u src/tools/cross-scripts/cross-x86-amd64.lisp:1.1.2.5 src/tools/cross-scripts/cross-x86-amd64.lisp:1.1.2.6
--- src/tools/cross-scripts/cross-x86-amd64.lisp:1.1.2.5	Fri Nov  6 14:52:21 2009
+++ src/tools/cross-scripts/cross-x86-amd64.lisp	Fri Nov  6 22:56:10 2009
@@ -379,84 +379,6 @@
 
 (deftype c::non-negative-fixnum () '(unsigned-byte 61))
 
-#||
-(describe (c::info c::type c::builtin 'fixnum))
-
-
-(in-package "KERNEL")
-(let ((*info-environment* (c:backend-info-environment c:*target-backend*)))
-  (c::values-specifier-type-cache-clear)
-
-  (c::clear-info c::type c::builtin 'fixnum)
-  (setf (c::info c::type c::builtin 'fixnum)
-	(c::make-numeric-type :class 'integer
-			      :low (ash -1 61)
-			      :high (1- (ash 1 61))))
-
-  (describe (c::info c::type c::builtin 'fixnum))
-  (setf (c::backend-type-predicates c::*target-backend*)
-	(acons (c::make-numeric-type :class 'integer
-				     :low (ash -1 61)
-				     :high (1- (ash 1 61)))
-	       'fixnump
-	       (c::backend-type-predicates c::*target-backend*)))
-      
-  (deftype kernel::index () '(unsigned-byte 61))
-  ;;(deftype c::non-negative-fixnum () '(unsigned-byte 61))
-
-(define-type-method (number :unparse) (type)
-  (let* ((complexp (numeric-type-complexp type))
-	 (low (numeric-type-low type))
-	 (high (numeric-type-high type))
-	 (base (case (numeric-type-class type)
-		 (integer 'integer)
-		 (rational 'rational)
-		 (float (or (numeric-type-format type) 'float))
-		 (t 'real))))
-    (let ((base+bounds
-	   (cond ((and (eq base 'integer) high low)
-		  (let ((high-count (logcount high))
-			(high-length (integer-length high)))
-		    (cond ((= low 0)
-			   (cond ((= high 0) '(integer 0 0))
-				 ((= high 1) 'bit)
-				 ((and (= high-count high-length)
-				       (plusp high-length))
-				  `(unsigned-byte ,high-length))
-				 (t
-				  `(mod ,(1+ high)))))
-			  ((and (= low vm::target-most-negative-fixnum)
-				(= high vm::target-most-positive-fixnum))
-			   'fixnum)
-			  ((and (= low (lognot high))
-				(= high-count high-length)
-				(> high-count 0))
-			   `(signed-byte ,(1+ high-length)))
-			  (t
-			   `(integer ,low ,high)))))
-		 (high `(,base ,(or low '*) ,high))
-		 (low
-		  (if (and (eq base 'integer) (= low 0))
-		      'unsigned-byte
-		      `(,base ,low)))
-		 (t base))))
-      (ecase complexp
-	(:real
-	 base+bounds)
-	(:complex
-	 (if (eq base+bounds 'real)
-	     'complex
-	     `(complex ,base+bounds)))
-	((nil)
-	 (assert (eq base+bounds 'real))
-	 'number)))))
-(setf (type-class-unparse (type-class-info (c::specifier-type 'fixnum)))
-      #'kernel::number-unparse-type-method)
-
-(c::clear-info c::type c::builtin 'fixnum)
-  )
-||#
-
 (describe (c::info c::type c::builtin 'fixnum))
 
 (c::values-specifier-type-cache-clear)
@@ -502,29 +424,5 @@
 ;;(deftype kernel::index () '(unsigned-byte 61))
 (deftype c::non-negative-fixnum () '(unsigned-byte 61))
 
-#+nil
-(let ((*info-environment* (c::backend-info-environment c:*target-backend*)))
-(kernel::def-type-translator integer (&optional low high)
-  (let* ((l (check-bound low integer))
-	 (lb (if (consp l) (1+ (car l)) l))
-	 (h (check-bound high integer))
-	 (hb (if (consp h) (1- (car h)) h)))
-    (flet ((hack-bound (b)
-	     (cond ((= b 536870911)
-		    (1- (ash 1 61)))
-		   ((= b -536870912)
-		    (ash -1 61)))))
-      (if (and hb lb (< hb lb))
-	  ;; This used to signal an error when the lb > hb, but the CLHS
-	  ;; doesn't say that this is an error, so we silently accept it
-	  ;; (as the empty type).
-	  *empty-type*
-	  (make-numeric-type :class 'integer  :complexp :real
-			     :enumerable (not (null (and l h)))
-			     :low (hack-bound lb)
-			     :high (hack-bound hb))))))
-
-)
-
-(break)
+;;(break)