diff --git a/code/print.lisp b/code/print.lisp
index 6df6a41de5ac7754de3a2ff9771cd5479cfc4f21..0889d80ce5d5715eea0bced9936b189db6903875 100644
--- a/code/print.lisp
+++ b/code/print.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/code/print.lisp,v 1.88 2004/04/22 14:26:27 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.89 2004/04/22 14:38:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1673,44 +1673,6 @@
 			  output-float-free-format-exponent-min
 			  output-float-free-format-exponent-max)))))))
 
-#+(or)
-(defmacro output-float-free-format-p (x)
-  "Returns true if x can be printed in free format, as per ANSI CL."
-  (loop with x-var = (gensym)
-	for type in '(short-float single-float double-float long-float)
-	collect
-	`(,type
-	  (and (>= ,x-var ,(coerce output-float-free-format-min type))
-	       (< ,x-var ,(coerce output-float-free-format-max type))))
-	into clauses
-	finally
-	(return
-	  `(let ((,x-var ,x))
-	     (etypecase ,x-var
-	       ,@clauses)))))
-
-#+(or)
-(defun output-float-aux (x stream)
-  (if (output-float-free-format-p x)
-      ;;free format
-      (multiple-value-bind (str len lpoint tpoint)
-			   (flonum-to-string x)
-	(declare (ignore len))
-	(when lpoint (write-char #\0 stream))
-	(write-string str stream)
-	(when tpoint (write-char #\0 stream))
-	(print-float-exponent x 0 stream))
-      ;;exponential format 
-      (multiple-value-bind (f ex)
-			   (scale-exponent x)
-	(multiple-value-bind (str len lpoint tpoint)
-			     (flonum-to-string f nil nil 1)
-	  (declare (ignore len))
-	  (when lpoint (write-char #\0 stream))
-	  (write-string str stream)
-	  (when tpoint (write-char #\0 stream))
-	  ;; subtract out scale factor of 1 passed to flonum-to-string
-	  (print-float-exponent x (1- ex) stream)))))
 
 ;; Smallest possible (unbiased) exponents
 (defconstant double-float-min-e
diff --git a/code/reader.lisp b/code/reader.lisp
index 30b05d20b9cd8af6d9d458d2bdca6f6a3c4917c3..7ea038796ce8c40297bd547dd7ca56498be0a756 100644
--- a/code/reader.lisp
+++ b/code/reader.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/code/reader.lisp,v 1.45 2004/04/22 14:26:27 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.46 2004/04/22 14:38:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -155,6 +155,15 @@
   (defconstant package-delimiter 11)
   ;;fake attribute for use in read-unqualified-token
   (defconstant delimiter 12)
+  ;; More fake attributes for used for reading numbers.
+  ;;
+  ;; The following two are not static but depend on *READ-BASE*.
+  ;; DECIMAL-DIGIT is for characters being digits in base 10 but not in
+  ;; base *READ-BASE* (which is therefore perforce smaller than 10);
+  ;; DIGIT-OR-EXPT is for characters being both exponent markers and
+  ;; digits in base *READ-BASE* (which is therefore perforce larger
+  ;; than 10).
+  
   (defconstant constituent-decimal-digit 13)
   (defconstant constituent-digit-or-expt 14))
 
@@ -877,341 +886,6 @@
 	       (cond (all-lower (raise-em))
 		     (all-upper (lower-em))))))))))))
   
-#+(or)
-(defun read-token (stream firstchar)
-  "This function is just an fsm that recognizes numbers and symbols."
-  ;;check explicitly whether firstchar has entry for non-terminating
-  ;;in character-attribute-table and read-dot-number-symbol in CMT.
-  ;;Report an error if these are violated (if we called this, we want
-  ;;something that is a legitimate token!).
-  ;;read in the longest possible string satisfying the bnf for
-  ;;"unqualified-token".  Leave the result in the *READ-BUFFER*.
-  ;;Return next char after token (last char read).
-  (when *read-suppress*
-    (internal-read-extended-token stream firstchar nil)
-    (return-from read-token nil))
-  (let ((attribute-table (character-attribute-table *readtable*))
-	(package nil)
-	(colons 0)
-	(possibly-rational t)
-	(possibly-float t)
-	(escapes ()))
-    (reset-read-buffer)
-    (prog ((char firstchar))
-      (case (char-class3 char attribute-table)
-	(#.constituent-sign (go SIGN))
-	(#.constituent-digit (go LEFTDIGIT))
-	(#.constituent-dot (go FRONTDOT))
-	(#.escape (go ESCAPE))
-	(#.package-delimiter (go COLON))
-	(#.multiple-escape (go MULT-ESCAPE))
-	;;can't have eof, whitespace, or terminating macro as first char!
-	(t (go SYMBOL)))
-     SIGN
-      ;;saw "sign"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (setq possibly-rational t
-	    possibly-float t)
-      (case (char-class3 char attribute-table)
-	(#.constituent-digit (go LEFTDIGIT))
-	(#.constituent-dot (go SIGNDOT))
-	(#.escape (go ESCAPE))
-	(#.package-delimiter (go COLON))
-	(#.multiple-escape (go MULT-ESCAPE))	
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(t (go SYMBOL)))
-     LEFTDIGIT
-      ;;saw "[sign] {digit}+"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (return (make-integer)))
-      (case (char-class3 char attribute-table)
-	(#.constituent-digit (go LEFTDIGIT))
-	(#.constituent-dot (if possibly-float
-			       (go MIDDLEDOT)
-			       (go SYMBOL)))
-	(#.constituent-expt (go EXPONENT))
-	(#.constituent-slash (if possibly-rational
-				 (go RATIO)
-				 (go SYMBOL)))
-	(#.delimiter (unread-char char stream) (return (make-integer)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     MIDDLEDOT
-      ;;saw "[sign] {digit}+ dot"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (return (let ((*read-base* 10))
-			     (make-integer))))
-      (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.constituent-expt (go EXPONENT))
-	(#.delimiter
-	 (unread-char char stream)
-	 (return (let ((*read-base* 10))
-		   (make-integer))))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     RIGHTDIGIT
-      ;;saw "[sign] {digit}* dot {digit}+"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (return (make-float)))
-      (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.constituent-expt (go EXPONENT))
-	(#.delimiter (unread-char char stream) (return (make-float)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     SIGNDOT
-      ;;saw "[sign] dot"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(t (go SYMBOL)))
-     FRONTDOT
-      ;;saw "dot"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (%reader-error stream "Dot context error."))
-      (case (char-class char attribute-table)
-	(#.constituent-digit (go RIGHTDIGIT))
-	(#.constituent-dot (go DOTS))
-	(#.delimiter  (%reader-error stream "Dot context error."))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     EXPONENT
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
-	(#.constituent-sign (go EXPTSIGN))
-	(#.constituent-digit (go EXPTDIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     EXPTSIGN
-      ;;we got to EXPONENT, and saw a sign character.
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
-	(#.constituent-digit (go EXPTDIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     EXPTDIGIT
-      ;;got to EXPONENT, saw "[sign] {digit}+"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (return (make-float)))
-      (case (char-class char attribute-table)
-	(#.constituent-digit (go EXPTDIGIT))
-	(#.delimiter (unread-char char stream) (return (make-float)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     RATIO
-      ;;saw "[sign] {digit}+ slash"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (case (char-class2 char attribute-table)
-	(#.constituent-digit (go RATIODIGIT))
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     RATIODIGIT
-      ;;saw "[sign] {digit}+ slash {digit}+"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (return (make-ratio)))
-      (case (char-class2 char attribute-table)
-	(#.constituent-digit (go RATIODIGIT))
-	(#.delimiter (unread-char char stream) (return (make-ratio)))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     DOTS
-      ;;saw "dot {dot}+"
-      (ouch-read-buffer char)
-      (setq char (read-char stream nil nil))
-      (unless char (%reader-error stream "Too many dots."))
-      (case (char-class char attribute-table)
-	(#.constituent-dot (go DOTS))
-	(#.delimiter
-	 (unread-char char stream)
-	 (%reader-error stream "Too many dots."))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-     SYMBOL
-      ;;not a dot, dots, or number.
-      (let ((stream (in-synonym-of stream)))
-	(stream-dispatch stream
-	  ;; simple-stream
-	  (prog ()
-	   SYMBOL-LOOP
-	   (ouch-read-buffer char)
-	   (setq char (stream::%read-char stream nil nil t t))
-	   (unless char (go RETURN-SYMBOL))
-	   (case (char-class char attribute-table)
-	     (#.escape (go ESCAPE))
-	     (#.delimiter (stream::%unread-char stream char)
-			  (go RETURN-SYMBOL))
-	     (#.multiple-escape (go MULT-ESCAPE))
-	     (#.package-delimiter (go COLON))
-	     (t (go SYMBOL-LOOP))))
-	  ;; lisp-stream
-	  (prepare-for-fast-read-char stream
-	    (prog ()
-	     SYMBOL-LOOP
-	     (ouch-read-buffer char)
-	     (setq char (fast-read-char nil nil))
-	     (unless char (go RETURN-SYMBOL))
-	     (case (char-class char attribute-table)
-	       (#.escape (done-with-fast-read-char)
-			 (go ESCAPE))
-	       (#.delimiter (done-with-fast-read-char)
-			    (unread-char char stream)
-			    (go RETURN-SYMBOL))
-	       (#.multiple-escape (done-with-fast-read-char)
-				  (go MULT-ESCAPE))
-	       (#.package-delimiter (done-with-fast-read-char)
-				    (go COLON))
-	       (t (go SYMBOL-LOOP)))))
-	  ;; fundamental-stream
-	  (prog ()
-	   SYMBOL-LOOP
-	   (ouch-read-buffer char)
-	   (setq char (stream-read-char stream))
-	   (when (eq char :eof) (go RETURN-SYMBOL))
-	   (case (char-class char attribute-table)
-	     (#.escape (go ESCAPE))
-	     (#.delimiter (stream-unread-char stream char)
-			  (go RETURN-SYMBOL))
-	     (#.multiple-escape (go MULT-ESCAPE))
-	     (#.package-delimiter (go COLON))
-	     (t (go SYMBOL-LOOP))))))
-     ESCAPE
-      ;;saw an escape.
-      ;;don't put the escape in the read-buffer.
-      ;;read-next char, put in buffer (no case conversion).
-      (let ((nextchar (read-char stream nil nil)))
-	(unless nextchar
-	  (reader-eof-error stream "after escape character"))
-	(push *ouch-ptr* escapes)
-	(ouch-read-buffer nextchar))
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-      MULT-ESCAPE
-      (do ((char (read-char stream t) (read-char stream t)))
-	  ((multiple-escape-p char))
-	(if (escapep char) (setq char (read-char stream t)))
-	(push *ouch-ptr* escapes)
-	(ouch-read-buffer char))
-      (setq char (read-char stream nil nil))
-      (unless char (go RETURN-SYMBOL))
-      (case (char-class char attribute-table)
-	(#.delimiter (unread-char char stream) (go RETURN-SYMBOL))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go COLON))
-	(t (go SYMBOL)))
-      COLON
-      (casify-read-buffer escapes)
-      (unless (zerop colons)
-	(%reader-error stream "Too many colons in ~S"
-		      (read-buffer-to-string)))
-      (setq colons 1)
-      (setq package
-	    (if (eql (char-class firstchar attribute-table)
-		     #.package-delimiter)
-		*keyword-package*
-		(read-buffer-to-string)))
-      (reset-read-buffer)
-      (setq escapes ())
-      (setq char (read-char stream nil nil))
-      (unless char (reader-eof-error stream "after reading a colon"))
-      (case (char-class char attribute-table)
-	(#.delimiter
-	 (unread-char char stream)
-	 (%reader-error stream "Illegal terminating character after a colon, ~S."
-		       char))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter (go INTERN))
-	(t (go SYMBOL)))
-      INTERN
-      (setq colons 2)
-      (setq char (read-char stream nil nil))
-      (unless char
-	(reader-eof-error stream "after reading a colon"))
-      (case (char-class char attribute-table)
-	(#.delimiter
-	 (unread-char char stream)
-	 (%reader-error stream "Illegal terminating character after a colon, ~S"
-		       char))
-	(#.escape (go ESCAPE))
-	(#.multiple-escape (go MULT-ESCAPE))
-	(#.package-delimiter
-	 (%reader-error stream "To many colons after ~S:" package))
-	(t (go SYMBOL)))
-      RETURN-SYMBOL
-      (casify-read-buffer escapes)
-      (let ((found (if package
-		       (find-package package)
-		       *package*)))
-	(unless found
-	  (error 'reader-package-error :stream stream
-		 :format-arguments (list package)
-		 :format-control "Package ~S not found."))
-
-	(if (or (zerop colons) (= colons 2) (eq found *keyword-package*))
-	    (return (intern* *read-buffer* *ouch-ptr* found))
-	    (multiple-value-bind (symbol test)
-				 (find-symbol* *read-buffer* *ouch-ptr* found)
-	      (when (eq test :external) (return symbol))
-	      (let ((name (read-buffer-to-string)))
-		(with-simple-restart (continue "Use symbol anyway.")
-		  (error 'reader-package-error :stream stream
-			 :format-arguments (list name (package-name found))
-			 :format-control
-			 (if test
-			     "The symbol ~S is not external in the ~A package."
-			     "Symbol ~S not found in the ~A package.")))
-		(return (intern name found)))))))))
-
 (defun read-token (stream firstchar)
   "This function is just an fsm that recognizes numbers and symbols."
   ;; Check explicitly whether FIRSTCHAR has an entry for
@@ -1713,105 +1387,6 @@
        (setq number (+ num (* number base-power)))))))
 
 
-
-#+(or)
-(defun make-float ()
-  ;;assume that the contents of *read-buffer* are a legal float, with nothing
-  ;;else after it.
-  (read-unwind-read-buffer)
-  (let ((negative-fraction nil)
-	(number 0)
-	(divisor 1)
-	(negative-exponent nil)
-	(exponent 0)
-	(float-char ())
-	(char (inch-read-buffer)))
-    (if (cond ((char= char #\+) t)
-	      ((char= char #\-) (setq negative-fraction t)))
-	;;flush it
-	(setq char (inch-read-buffer)))
-    ;;read digits before the dot
-    (do* ((ch char (inch-read-buffer))
-	  (dig (digit-char-p ch) (digit-char-p ch)))
-	 ((not dig) (setq char ch))
-      (setq number (+ (* number 10) dig)))
-    ;;deal with the dot, if it's there.
-    (when (char= char #\.)
-      (setq char (inch-read-buffer))
-      ;;read digits after the dot.
-      (do* ((ch char (inch-read-buffer))
-	    (dig (and (not (eofp ch)) (digit-char-p ch))
-		 (and (not (eofp ch)) (digit-char-p ch))))
-	   ((not dig) (setq char ch))
-	(setq divisor (* divisor 10))
-	(setq number (+ (* number 10) dig))))
-    ;;is there an exponent letter?
-    (cond ((eofp char)
-	   ;;if not, we've read the whole number.
-	   (let ((num (make-float-aux number divisor
-				      *read-default-float-format*)))
-	     (return-from make-float (if negative-fraction (- num) num))))
-	  ((exponent-letterp char)
-	   (setq float-char char)
-	   ;;build exponent
-	   (setq char (inch-read-buffer))
-	   ;;check leading sign
-	   (if (cond ((char= char #\+) t)
-		     ((char= char #\-) (setq negative-exponent t)))
-	       ;;flush sign
-	       (setq char (inch-read-buffer)))
-	   ;;read digits for exponent
-	   (do* ((ch char (inch-read-buffer))
-		 (dig (and (not (eofp ch)) (digit-char-p ch))
-		      (and (not (eofp ch)) (digit-char-p ch))))
-		((not dig)
-		 (setq exponent (if negative-exponent (- exponent) exponent)))
-	     (setq exponent (+ (* exponent 10) dig)))
-	   ;;generate and return the float, depending on float-char:
-	   (let* ((float-format (case (char-upcase float-char)
-				  (#\E *read-default-float-format*)
-				  (#\S 'short-float)
-				  (#\F 'single-float)
-				  (#\D 'double-float)
-				  (#\L 'long-float)))
-		  num)
-	     ;; toy@rtp.ericsson.se: We need to watch out if the
-	     ;; exponent is too small or too large.  We add enough to
-	     ;; EXPONENT to make it within range and scale NUMBER
-	     ;; appropriately.  This should avoid any unnecessary
-	     ;; underflow or overflow problems.
-	     (multiple-value-bind (min-expo max-expo)
-		 (case float-format
-		   (short-float
-		    (values 
-		     #.(log least-positive-normalized-short-float 10s0)
-		     #.(log most-positive-short-float 10s0)))
-		   (single-float
-		    (values 
-		     #.(log least-positive-normalized-single-float 10f0)
-		     #.(log most-positive-single-float 10f0)))
-		   (double-float
-		    (values
-		     #.(log least-positive-normalized-double-float 10d0)
-		     #.(log most-positive-double-float 10d0)))
-		   (long-float
-		    (values 
-		     #.(log least-positive-normalized-long-float 10L0)
-		     #.(log most-positive-long-float 10L0))))
-	       (let ((correction (cond ((<= exponent min-expo)
-					(ceiling (- min-expo exponent)))
-				       ((>= exponent max-expo)
-					(floor (- max-expo exponent)))
-				       (t
-					0))))
-		 (incf exponent correction)
-		 (setf number (/ number (expt 10 correction)))
-		 (setq num (make-float-aux number divisor float-format))
-		 (setq num (* num (expt 10 exponent)))
-		 (return-from make-float (if negative-fraction (- num) num))))))
-	  ;;should never happen:	
-	  (t (error "Internal error in floating point reader.")))))
-
 (defun make-float ()
   ;; Assume that the contents of *read-buffer* are a legal float, with nothing
   ;; else after it.