Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/code
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv21848/src/code

Modified Files:
	bignum.lisp early-extensions.lisp 
Log Message:
1.0.7.4: RESTRICT-COMPILER-POLICY

 * Allow users to set a global minimum for optimization qualities,
   overriding declarations and proclamations.

   The intended use is to make it easy to recompile large bodies of
   code with many local optimization declarations with a minimum
   SAFETY or DEBUG everywhere.

 * Changes to SBCL itself to allow building with SBCL that has minimum
   safety set to 3:

    -- Second argument of %MORE-KW-ARG is a negative: DEFKNOWN it as a
       FIXNUM, not INDEX.

    -- We don't have a deftype for SB-VM::POSITIVE-FIXNUM -- it's only
       a backend type. Use (AND UNSIGNED-BYTE FIXNUM) instead.

 * Delete some unused functions: READ-SEQUENCE-OR-DIE,
   RENAME-KEY-ARGS.


Index: bignum.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/bignum.lisp,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- bignum.lisp	4 Jun 2007 23:11:46 -0000	1.29
+++ bignum.lisp	30 Jun 2007 09:21:25 -0000	1.30
@@ -550,7 +550,7 @@
 ;;; it, we pay a heavy price in BIGNUM-GCD when compiled by the
 ;;; cross-compiler. -- CSR, 2004-07-19
 (declaim (ftype (sfunction (bignum-type bignum-index bignum-type bignum-index)
-                           sb!vm::positive-fixnum)
+                           (and unsigned-byte fixnum))
                 bignum-factors-of-two))
 (defun bignum-factors-of-two (a len-a b len-b)
   (declare (type bignum-index len-a len-b) (type bignum-type a b))

Index: early-extensions.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/early-extensions.lisp,v
retrieving revision 1.86
retrieving revision 1.87
diff -u -d -r1.86 -r1.87
--- early-extensions.lisp	28 Jun 2007 13:04:58 -0000	1.86
+++ early-extensions.lisp	30 Jun 2007 09:21:26 -0000	1.87
@@ -934,61 +934,6 @@
       (t
        (error "unknown operator in feature expression: ~S." x)))
     (not (null (memq x *features*)))))
-
-;;; Given a list of keyword substitutions `(,OLD ,NEW), and a
-;;; &KEY-argument-list-style list of alternating keywords and
-;;; arbitrary values, return a new &KEY-argument-list-style list with
-;;; all substitutions applied to it.
-;;;
-;;; Note: If efficiency mattered, we could do less consing. (But if
-;;; efficiency mattered, why would we be using &KEY arguments at
-;;; all, much less renaming &KEY arguments?)
-;;;
-;;; KLUDGE: It would probably be good to get rid of this. -- WHN 19991201
-(defun rename-key-args (rename-list key-args)
-  (declare (type list rename-list key-args))
-  ;; Walk through RENAME-LIST modifying RESULT as per each element in
-  ;; RENAME-LIST.
-  (do ((result (copy-list key-args))) ; may be modified below
-      ((null rename-list) result)
-    (destructuring-bind (old new) (pop rename-list)
-      ;; ANSI says &KEY arg names aren't necessarily KEYWORDs.
-      (declare (type symbol old new))
-      ;; Walk through RESULT renaming any OLD key argument to NEW.
-      (do ((in-result result (cddr in-result)))
-          ((null in-result))
-        (declare (type list in-result))
-        (when (eq (car in-result) old)
-          (setf (car in-result) new))))))
-
-;;; ANSI Common Lisp's READ-SEQUENCE function, unlike most of the
-;;; other ANSI input functions, is defined to communicate end of file
-;;; status with its return value, not by signalling. That is not the
-;;; behavior that we usually want. This function is a wrapper which
-;;; restores the behavior that we usually want, causing READ-SEQUENCE
-;;; to communicate end-of-file status by signalling.
-(defun read-sequence-or-die (sequence stream &key start end)
-  ;; implementation using READ-SEQUENCE
-  #-no-ansi-read-sequence
-  (let ((read-end (read-sequence sequence
-                                 stream
-                                 :start start
-                                 :end end)))
-    (unless (= read-end end)
-      (error 'end-of-file :stream stream))
-    (values))
-  ;; workaround for broken READ-SEQUENCE
-  #+no-ansi-read-sequence
-  (progn
-    (aver (<= start end))
-    (let ((etype (stream-element-type stream)))
-    (cond ((equal etype '(unsigned-byte 8))
-           (do ((i start (1+ i)))
-               ((>= i end)
-                (values))
-             (setf (aref sequence i)
-                   (read-byte stream))))
-          (t (error "unsupported element type ~S" etype))))))
 
 ;;;; utilities for two-VALUES predicates
 
@@ -1306,3 +1251,4 @@
                                                 bind))
                                           bindings)))
        ,@forms)))
+