Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28471

Modified Files:
	version.lisp-expr 
Log Message:
0.8.9.38:
	Ignore some SPARC variables


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1547
retrieving revision 1.1548
diff -u -d -r1.1547 -r1.1548
--- version.lisp-expr	13 Apr 2004 13:31:36 -0000	1.1547
+++ version.lisp-expr	13 Apr 2004 20:37:49 -0000	1.1548
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.9.37"
+"0.8.9.38"

Update of /cvsroot/sbcl/sbcl/src/compiler/sparc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28471/src/compiler/sparc

Modified Files:
	insts.lisp move.lisp 
Log Message:
0.8.9.38:
	Ignore some SPARC variables


Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/insts.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- insts.lisp	8 Sep 2003 08:52:15 -0000	1.11
+++ insts.lisp	13 Apr 2004 20:37:49 -0000	1.12
@@ -130,6 +130,7 @@
 	 (rd (ldb (byte 5 25) word))
 	 (immed-p (not (zerop (ldb (byte 1 13) word))))
 	 (immed-val (sign-extend-immed-value (ldb (byte 13 0) word))))
+    (declare (ignore immed-p))
     ;; Only the value of format and rd are guaranteed to be correct
     ;; because the disassembler is trying to print out the value of a
     ;; register.  The other values may not be right.
@@ -207,6 +208,7 @@
 			  dstate)))))))
 
 (defun handle-jmpl-inst (rs1 immed-val rd dstate)
+  (declare (ignore rd))
   (let* ((sethi (assoc rs1 *note-sethi-inst*)))
     (when sethi
       ;; RS1 was used in a SETHI instruction.  Assume that

Index: move.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/sparc/move.lisp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- move.lisp	9 Apr 2002 09:29:04 -0000	1.2
+++ move.lisp	13 Apr 2004 20:37:49 -0000	1.3
@@ -232,8 +232,7 @@
   (:generator 20
     (move x arg)
     (let ((done (gen-label))
-	  (one-word (gen-label))
-	  (initial-alloc (pad-data-block (1+ bignum-digits-offset))))
+	  (one-word (gen-label)))
       (inst sra temp x n-positive-fixnum-bits)
       (inst cmp temp)
       (inst b :eq done)

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30445/src/runtime

Modified Files:
	bsd-os.c thread.h x86-arch.c x86-arch.h 
Log Message:
0.8.9.37:
	NetBSD fixes
	... remove one __NetBSD__ which got in the way;
	... include kernel revision detection.
	... also include less expensive spinlock definitions
		for x86/unithread builds.


Index: bsd-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/bsd-os.c,v
retrieving revision 1.20
retrieving revision 1.21
diff -u -d -r1.20 -r1.21
--- bsd-os.c	8 Apr 2004 13:26:04 -0000	1.20
+++ bsd-os.c	13 Apr 2004 13:31:37 -0000	1.21
@@ -43,6 +43,7 @@
 
 #ifdef __NetBSD__
 #include <sys/resource.h>
+#include <sys/sysctl.h>
 #include <string.h>
 
 static void netbsd_init();
@@ -232,6 +233,21 @@
 static void netbsd_init()
 {
     struct rlimit rl;
+    int mib[2], osrev;
+    size_t len;
+
+    /* Are we running on a sufficiently functional kernel? */
+    mib[0] = CTL_KERN;
+    mib[1] = KERN_OSREV;
+
+    len = sizeof(osrev);
+    sysctl(mib, 2, &osrev, &len, NULL, 0);
+
+    /* If we're older than 2.0... */
+    if (osrev < 200000000) {
+	fprintf(stderr, "osrev = %d (needed at least 200000000).\n", osrev);
+	lose("NetBSD kernel too old to run sbcl.\n");
+    }
     
     /* NetBSD counts mmap()ed space against the process's data size limit,
      * so yank it up. This might be a nasty thing to do? */

Index: thread.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- thread.h	6 Oct 2003 16:48:39 -0000	1.9
+++ thread.h	13 Apr 2004 13:31:37 -0000	1.10
@@ -5,8 +5,8 @@
 #include <sys/types.h>
 #include <unistd.h>
 #include <stddef.h>
-#include "runtime.h"
 #include "sbcl.h"
+#include "runtime.h"
 #include "os.h"
 #include "interrupt.h"
 #ifdef LISP_FEATURE_GENCGC
@@ -104,7 +104,7 @@
  * much stuff like struct thread and all_threads to be defined, which
  * usually aren't by that time.  So, it's here instead.  Sorry */
 
-inline static struct thread *arch_os_get_current_thread() {
+static inline struct thread *arch_os_get_current_thread() {
 #if defined(LISP_FEATURE_SB_THREAD) && defined (LISP_FEATURE_X86)
     register struct thread *me=0;
     if(all_threads)

Index: x86-arch.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-arch.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -d -r1.24 -r1.25
--- x86-arch.c	8 Apr 2004 13:26:04 -0000	1.24
+++ x86-arch.c	13 Apr 2004 13:31:37 -0000	1.25
@@ -55,7 +55,7 @@
     return &context->uc_mcontext.gregs[16];
 #elif defined __FreeBSD__
     return &context->uc_mcontext.mc_eflags;
-#elif defined __OpenBSD__ || defined __NetBSD__
+#elif defined __OpenBSD__
     return &context->sc_eflags;
 #elif defined __NetBSD__
     return &(context->uc_mcontext.__gregs[_REG_EFL]);

Index: x86-arch.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-arch.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- x86-arch.h	25 Aug 2003 21:00:02 -0000	1.2
+++ x86-arch.h	13 Apr 2004 13:31:37 -0000	1.3
@@ -10,8 +10,10 @@
 /* FIXME: Do we also want
  *   #define ARCH_HAS_FLOAT_REGISTERS
  * here? (The answer wasn't obvious to me when merging the
- * architecture-abstracting patches for CSR's SPARC port. -- WHN 2002-02-15) */
+ * architecture-abstracting patches for CSR's SPARC port. -- WHN
+ * 2002-02-15) */
 
+#ifdef LISP_FEATURE_SB_THREAD
 static inline void 
 get_spinlock(lispobj *word,int value)
 {
@@ -31,4 +33,18 @@
     *word=0;
 }
 
+#else
+
+static inline void 
+get_spinlock(lispobj *word, int value)
+{
+    *word = value;
+}
+
+static inline void
+release_spinlock(lispobj *word) {
+    *word = 0;
+}
+
+#endif /* LISP_FEATURE_SB_THREAD */
 #endif /* _X86_ARCH_H */

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30445

Modified Files:
	version.lisp-expr 
Log Message:
0.8.9.37:
	NetBSD fixes
	... remove one __NetBSD__ which got in the way;
	... include kernel revision detection.
	... also include less expensive spinlock definitions
		for x86/unithread builds.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1546
retrieving revision 1.1547
diff -u -d -r1.1546 -r1.1547
--- version.lisp-expr	13 Apr 2004 10:30:37 -0000	1.1546
+++ version.lisp-expr	13 Apr 2004 13:31:36 -0000	1.1547
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.9.36"
+"0.8.9.37"

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25438/src/compiler

Modified Files:
	ir1opt.lisp ir1tran-lambda.lisp ir1tran.lisp ir1util.lisp 
	ir2tran.lisp ltn.lisp macros.lisp srctran.lisp stack.lisp 
	typetran.lisp 
Log Message:
0.8.9.36:
	Commit "ignore during cross-compilation" patch (CSR sbcl-devel
	2004-04-05)
	... bad treatment of IGNORE now gets a full WARNING during
		cross-compilation;
	... fix all the badness this reveals;
	... implement SAME-ARG checking in LOGFOO type derivers;
	... also add one more IGNORABLE in PCL (from Marcus Pearce);
	... test for bad (signed-byte <N>) bug.


Index: ir1opt.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1opt.lisp,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -d -r1.90 -r1.91
--- ir1opt.lisp	4 Apr 2004 14:07:25 -0000	1.90
+++ ir1opt.lisp	13 Apr 2004 10:30:38 -0000	1.91
@@ -740,6 +740,7 @@
          (ctran (node-next node))
 	 (tail (component-tail (block-component block)))
 	 (succ (first (block-succ block))))
+    (declare (ignore lvar))
     (unless (or (and (eq node (block-last block)) (eq succ tail))
 		(block-delete-p block))
       (when (eq (node-derived-type node) *empty-type*)

Index: ir1tran-lambda.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran-lambda.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- ir1tran-lambda.lisp	30 Mar 2004 16:58:26 -0000	1.14
+++ ir1tran-lambda.lisp	13 Apr 2004 10:30:38 -0000	1.15
@@ -261,6 +261,7 @@
 ;;; whereas NEXT is a variable naming a CTRAN in the body.  -- CSR,
 ;;; 2004-03-30.
 (defmacro with-dynamic-extent ((start body-start next kind) &body body)
+  (declare (ignore kind))
   (with-unique-names (cleanup next-ctran)
     `(progn
       (ctran-starts-block ,body-start)
@@ -966,6 +967,7 @@
 				      (source-name '.anonymous.)
 				      debug-name
 				      allow-debug-catch-tag)
+  (declare (ignore allow-debug-catch-tag))
   (destructuring-bind (decls macros symbol-macros &rest body)
 		      (if (eq (car fun) 'lambda-with-lexenv)
 			  (cdr fun)

Index: ir1tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1tran.lisp,v
retrieving revision 1.117
retrieving revision 1.118
diff -u -d -r1.117 -r1.118
--- ir1tran.lisp	30 Mar 2004 16:58:26 -0000	1.117
+++ ir1tran.lisp	13 Apr 2004 10:30:39 -0000	1.118
@@ -619,7 +619,12 @@
 	 (when (lambda-var-ignorep var)
 	   ;; (ANSI's specification for the IGNORE declaration requires
 	   ;; that this be a STYLE-WARNING, not a full WARNING.)
-	   (compiler-style-warn "reading an ignored variable: ~S" name)))
+	   #-sb-xc-host
+	   (compiler-style-warn "reading an ignored variable: ~S" name)
+	   ;; there's no need for us to accept ANSI's lameness when
+	   ;; processing our own code, though.
+	   #+sb-xc-host
+	   (compiler-warn "reading an ignored variable: ~S" name)))
        (reference-leaf start next result var))
       (cons
        (aver (eq (car var) 'MACRO))

Index: ir1util.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1util.lisp,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -d -r1.89 -r1.90
--- ir1util.lisp	4 Apr 2004 14:07:25 -0000	1.89
+++ ir1util.lisp	13 Apr 2004 10:30:39 -0000	1.90
@@ -1149,8 +1149,14 @@
 	(unless (policy *compiler-error-context* (= inhibit-warnings 3))
 	  ;; ANSI section "3.2.5 Exceptional Situations in the Compiler"
 	  ;; requires this to be no more than a STYLE-WARNING.
+	  #-sb-xc-host
 	  (compiler-style-warn "The variable ~S is defined but never used."
-			       (leaf-debug-name var)))
+			       (leaf-debug-name var))
+	  ;; There's no reason to accept this kind of equivocation
+	  ;; when compiling our own code, though.
+	  #+sb-xc-host
+	  (compiler-warn "The variable ~S is defined but never used."
+			 (leaf-debug-name var)))
 	(setf (leaf-ever-used var) t)))) ; to avoid repeated warnings? -- WHN
   (values))
 
@@ -1466,8 +1472,7 @@
 ;;; exits to CONT in that entry, then return it, otherwise return NIL.
 (defun find-nlx-info (exit)
   (declare (type exit exit))
-  (let* ((entry (exit-entry exit))
-         (entry-cleanup (entry-cleanup entry)))
+  (let ((entry (exit-entry exit)))
     (dolist (nlx (physenv-nlx-info (node-physenv entry)) nil)
       (when (eq (nlx-info-exit nlx) exit)
 	(return nlx)))))

Index: ir2tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir2tran.lisp,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -d -r1.48 -r1.49
--- ir2tran.lisp	4 Apr 2004 14:07:25 -0000	1.48
+++ ir2tran.lisp	13 Apr 2004 10:30:39 -0000	1.49
@@ -559,6 +559,7 @@
 (defun find-template-result-types (call template rtypes)
   (declare (type combination call)
 	   (type template template) (list rtypes))
+  (declare (ignore template))
   (let* ((dtype (node-derived-type call))
 	 (type dtype)
 	 (types (mapcar #'primitive-type
@@ -857,6 +858,7 @@
 ;;;      lvar LOC.
 ;;;   -- We don't know what it is.
 (defun fun-lvar-tn (node block lvar)
+  (declare (ignore node block))
   (declare (type lvar lvar))
   (let ((2lvar (lvar-info lvar)))
     (if (eq (ir2-lvar-kind 2lvar) :delayed)

Index: ltn.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ltn.lisp,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -d -r1.28 -r1.29
--- ltn.lisp	4 Apr 2004 14:07:25 -0000	1.28
+++ ltn.lisp	13 Apr 2004 10:30:39 -0000	1.29
@@ -434,6 +434,7 @@
 (defun template-args-ok (template call safe-p)
   (declare (type template template)
 	   (type combination call))
+  (declare (ignore safe-p))
   (let ((mtype (template-more-args-type template)))
     (do ((args (basic-combination-args call) (cdr args))
 	 (types (template-arg-types template) (cdr types)))

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/macros.lisp,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -d -r1.51 -r1.52
--- macros.lisp	7 Apr 2004 14:22:36 -0000	1.51
+++ macros.lisp	13 Apr 2004 10:30:39 -0000	1.52
@@ -58,11 +58,12 @@
       `(progn
 	 (declaim (ftype (function (ctran ctran (or lvar null) t) (values))
 			 ,fn-name))
-	 (defun ,fn-name (,start-var ,next-var ,result-var ,n-form)
-	   (let ((,n-env *lexenv*))
-	     ,@decls
-	     ,body
-	     (values)))
+	 (defun ,fn-name (,start-var ,next-var ,result-var ,n-form
+			  &aux (,n-env *lexenv*))
+	   (declare (ignorable ,start-var ,next-var ,result-var))
+	   ,@decls
+	   ,body
+	   (values))
 	 ,@(when doc
 	     `((setf (fdocumentation ',name 'function) ,doc)))
 	 ;; FIXME: Evidently "there can only be one!" -- we overwrite any
@@ -513,6 +514,7 @@
     (let ((n-args (gensym)))
       `(progn
 	(defun ,name (,n-node ,@vars)
+	  (declare (ignorable ,@vars))
 	  (let ((,n-args (basic-combination-args ,n-node)))
 	    ,(parse-deftransform lambda-list body n-args
 				 `(return-from ,name nil))))

Index: srctran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/srctran.lisp,v
retrieving revision 1.105
retrieving revision 1.106
diff -u -d -r1.105 -r1.106
--- srctran.lisp	4 Apr 2004 14:07:25 -0000	1.105
+++ srctran.lisp	13 Apr 2004 10:30:39 -0000	1.106
@@ -2121,7 +2121,8 @@
       (values nil t t)))
 
 (defun logand-derive-type-aux (x y &optional same-leaf)
-  (declare (ignore same-leaf))
+  (when same-leaf
+    (return-from logand-derive-type-aux x))
   (multiple-value-bind (x-len x-pos x-neg) (integer-type-length x)
     (declare (ignore x-pos))
     (multiple-value-bind (y-len y-pos y-neg) (integer-type-length  y)
@@ -2153,7 +2154,8 @@
 		  (specifier-type 'integer)))))))
 
 (defun logior-derive-type-aux (x y &optional same-leaf)
-  (declare (ignore same-leaf))
+  (when same-leaf
+    (return-from logior-derive-type-aux x))
   (multiple-value-bind (x-len x-pos x-neg) (integer-type-length x)
     (multiple-value-bind (y-len y-pos y-neg) (integer-type-length y)
       (cond
@@ -2192,7 +2194,8 @@
 		(specifier-type 'integer))))))))
 
 (defun logxor-derive-type-aux (x y &optional same-leaf)
-  (declare (ignore same-leaf))
+  (when same-leaf
+    (return-from logxor-derive-type-aux (specifier-type '(eql 0))))
   (multiple-value-bind (x-len x-pos x-neg) (integer-type-length x)
     (multiple-value-bind (y-len y-pos y-neg) (integer-type-length y)
       (cond
@@ -2230,7 +2233,7 @@
 (defoptimizer (logeqv derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
 			     (lognot-derive-type-aux 
-			      (logxor-derive-type-aux x y same-leaf))) 
+			      (logxor-derive-type-aux x y same-leaf)))
 		       #'logeqv))
 (defoptimizer (lognand derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
@@ -2242,25 +2245,34 @@
 			     (lognot-derive-type-aux
 			      (logior-derive-type-aux x y same-leaf)))
 		       #'lognor))
+;;; FIXME: use SAME-LEAF instead of ignoring it.
 (defoptimizer (logandc1 derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
-			     (logand-derive-type-aux
-			      (lognot-derive-type-aux x) y nil))
+			     (if same-leaf
+				 (specifier-type '(eql 0))
+				 (logand-derive-type-aux
+				  (lognot-derive-type-aux x) y nil)))
 		       #'logandc1))
 (defoptimizer (logandc2 derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
-			     (logand-derive-type-aux
-			      x (lognot-derive-type-aux y) nil))
+			     (if same-leaf
+				 (specifier-type '(eql 0))
+				 (logand-derive-type-aux
+				  x (lognot-derive-type-aux y) nil)))
 		       #'logandc2))
 (defoptimizer (logorc1 derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
-			     (logior-derive-type-aux
-			      (lognot-derive-type-aux x) y nil))
+			     (if same-leaf
+				 (specifier-type '(eql -1))
+				 (logior-derive-type-aux
+				  (lognot-derive-type-aux x) y nil)))
 		       #'logorc1))
 (defoptimizer (logorc2 derive-type) ((x y))
   (two-arg-derive-type x y (lambda (x y same-leaf)
-			     (logior-derive-type-aux
-			      x (lognot-derive-type-aux y) nil))
+			     (if same-leaf
+				 (specifier-type '(eql -1))
+				 (logior-derive-type-aux
+				  x (lognot-derive-type-aux y) nil)))
 		       #'logorc2))
 
 ;;;; miscellaneous derive-type methods

Index: stack.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/stack.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- stack.lisp	18 Feb 2004 03:04:10 -0000	1.11
+++ stack.lisp	13 Apr 2004 10:30:39 -0000	1.12
@@ -65,6 +65,7 @@
          (new-end end)
          (cleanup (block-end-cleanup block))
          (found-similar-p nil))
+    (declare (ignore #-nil cleanup))
     (dolist (succ (block-succ block))
       #+nil
       (when (and (< block succ)

Index: typetran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/typetran.lisp,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -d -r1.40 -r1.41
--- typetran.lisp	15 Sep 2003 09:21:38 -0000	1.40
+++ typetran.lisp	13 Apr 2004 10:30:39 -0000	1.41
@@ -243,13 +243,13 @@
 
 ;;; Do source transformation for TYPEP of a known union type. If a
 ;;; union type contains LIST, then we pull that out and make it into a
-;;; single LISTP call. Note that if SYMBOL is in the union, then LIST
-;;; will be a subtype even without there being any (member NIL). We
-;;; just drop through to the general code in this case, rather than
-;;; trying to optimize it.
+;;; single LISTP call.  Note that if SYMBOL is in the union, then LIST
+;;; will be a subtype even without there being any (member NIL).  We
+;;; currently just drop through to the general code in this case,
+;;; rather than trying to optimize it (but FIXME CSR 2004-04-05: it
+;;; wouldn't be hard to optimize it after all).
 (defun source-transform-union-typep (object type)
   (let* ((types (union-type-types type))
-	 (type-list (specifier-type 'list))
          (type-cons (specifier-type 'cons))
 	 (mtype (find-if #'member-type-p types))
          (members (when mtype (member-type-members mtype))))

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

Modified Files:
	condition.lisp defbangstruct.lisp fd-stream.lisp 
	float-trap.lisp late-format.lisp late-type.lisp stream.lisp 
	target-load.lisp target-unithread.lisp thread.lisp time.lisp 
	x86-vm.lisp 
Log Message:
0.8.9.36:
	Commit "ignore during cross-compilation" patch (CSR sbcl-devel
	2004-04-05)
	... bad treatment of IGNORE now gets a full WARNING during
		cross-compilation;
	... fix all the badness this reveals;
	... implement SAME-ARG checking in LOGFOO type derivers;
	... also add one more IGNORABLE in PCL (from Marcus Pearce);
	... test for bad (signed-byte <N>) bug.


Index: condition.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- condition.lisp	21 Aug 2003 11:47:17 -0000	1.37
+++ condition.lisp	13 Apr 2004 10:30:38 -0000	1.38
@@ -781,6 +781,7 @@
 (define-condition nil-array-accessed-error (type-error)
   ()
   (:report (lambda (condition stream)
+	     (declare (ignore condition))
 	     (format stream
 		     "An attempt to access an array of element-type ~
                       NIL was made.  Congratulations!"))))

Index: defbangstruct.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/defbangstruct.lisp,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- defbangstruct.lisp	19 May 2003 14:05:17 -0000	1.15
+++ defbangstruct.lisp	13 Apr 2004 10:30:38 -0000	1.16
@@ -75,7 +75,7 @@
 ;;; objects
 (defun just-dump-it-normally (object &optional (env nil env-p))
   (declare (type structure!object object))
-  (declare (ignorable env env-p))
+  (declare (ignorable env env-p object))
   ;; KLUDGE: we require essentially three different behaviours of
   ;; JUST-DUMP-IT-NORMALLY, two of which (host compiler's
   ;; MAKE-LOAD-FORM, cross-compiler's MAKE-LOAD-FORM) are handled by

Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- fd-stream.lisp	9 Feb 2004 20:25:59 -0000	1.44
+++ fd-stream.lisp	13 Apr 2004 10:30:38 -0000	1.45
@@ -574,7 +574,7 @@
 	   (let ((,element-var
 		  (catch 'eof-input-catcher
 		    (input-at-least ,stream-var ,bytes)
-		    ,@read-forms)))
+		    (locally ,@read-forms))))
 	     (cond (,element-var
 		    (incf (fd-stream-ibuf-head ,stream-var) ,bytes)
 		    ,element-var)
@@ -663,14 +663,15 @@
 	do (return-from pick-input-routine
 	     (values
 	      (lambda (stream eof-error eof-value)
-		(let ((sap (fd-stream-ibuf-sap stream))
-		      (head (fd-stream-ibuf-head stream)))
-		  (loop for j from 0 below (/ i 8)
-			with result = 0
-			do (setf result
-				 (+ (* 256 result)
-				    (sap-ref-8 sap (+ head j))))
-			finally (return (dpb result (byte i 0) -1)))))
+		(input-wrapper (stream (/ i 8) eof-error eof-value)
+		  (let ((sap (fd-stream-ibuf-sap stream))
+			(head (fd-stream-ibuf-head stream)))
+		    (loop for j from 0 below (/ i 8)
+			  with result = 0
+			  do (setf result
+				   (+ (* 256 result)
+				      (sap-ref-8 sap (+ head j))))
+			  finally (return (dpb result (byte i 0) -1))))))
 	      `(signed-byte ,i)
 	      (/ i 8)))))
 
@@ -1185,6 +1186,8 @@
    :IF-DOES-NOT-EXIST - one of :ERROR, :CREATE or NIL
   See the manual for details."
 
+  (declare (ignore external-format)) ; FIXME: CHECK-TYPE?  WARN-if-not?
+  
   ;; Calculate useful stuff.
   (multiple-value-bind (input output mask)
       (case direction

Index: float-trap.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/float-trap.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- float-trap.lisp	29 Jul 2003 13:01:55 -0000	1.13
+++ float-trap.lisp	13 Apr 2004 10:30:38 -0000	1.14
@@ -137,7 +137,7 @@
 
 ;;; Signal the appropriate condition when we get a floating-point error.
 (defun sigfpe-handler (signal info context)
-  (declare (ignore signal info context))
+  (declare (ignore signal info))
   (declare (type system-area-pointer context))
   (let* ((modes (context-floating-point-modes
 		 (sb!alien:sap-alien context (* os-context-t))))

Index: late-format.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-format.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- late-format.lisp	7 Aug 2003 09:32:07 -0000	1.18
+++ late-format.lisp	13 Apr 2004 10:30:38 -0000	1.19
@@ -1245,14 +1245,15 @@
 		   ;; corresponding argument was a list.
 		   (t (values 1 1 remaining))))))
 	   (walk-conditional (conditional directives args)
-	     (declare (ignore args))
 	     (let ((*default-format-error-offset*
 		    (1- (format-directive-end conditional))))
 	       (multiple-value-bind (sublists last-semi-with-colon-p remaining)
 		   (parse-conditional-directive directives)
 		 (declare (ignore last-semi-with-colon-p))
-		 (let ((sub-max (loop for s in sublists
-				      maximize (nth-value 1 (walk-directive-list s args)))))
+		 (let ((sub-max
+			(loop for s in sublists
+			      maximize (nth-value
+					1 (walk-directive-list s args)))))
 		   (cond
 		     ((format-directive-atsignp conditional)
 		      (values 1 (max 1 sub-max) remaining))

Index: late-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-type.lisp,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -d -r1.104 -r1.105
--- late-type.lisp	9 Mar 2004 12:08:40 -0000	1.104
+++ late-type.lisp	13 Apr 2004 10:30:38 -0000	1.105
@@ -307,6 +307,10 @@
     ((csubtypep type1 (specifier-type 'function)) nil)
     (t :call-other-method)))
 (!define-type-method (function :complex-union2) (type1 type2)
+  (declare (ignore type2))
+  ;; TYPE2 is a FUNCTION type.  If TYPE1 is a classoid type naming
+  ;; FUNCTION, then it is the union of the two; otherwise, there is no
+  ;; special union.
   (cond
     ((type= type1 (specifier-type 'function)) type1)
     (t nil)))

Index: stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/stream.lisp,v
retrieving revision 1.61
retrieving revision 1.62
diff -u -d -r1.61 -r1.62
--- stream.lisp	6 Mar 2004 22:09:58 -0000	1.61
+++ stream.lisp	13 Apr 2004 10:30:38 -0000	1.62
@@ -789,8 +789,7 @@
 		      (bin #'concatenated-bin)
 		      (n-bin #'concatenated-n-bin)
 		      (misc #'concatenated-misc))
-	    (:constructor %make-concatenated-stream
-			  (&rest streams &aux (current streams)))
+	    (:constructor %make-concatenated-stream (&rest streams))
 	    (:copier nil))
   ;; The car of this is the substream we are reading from now.
   (streams nil :type list))
@@ -1255,7 +1254,7 @@
     dst-end))
 
 (defun fill-pointer-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg1 arg2))
+  (declare (ignore arg2))
   (case operation
     (:file-position
      (let ((buffer (fill-pointer-output-stream-string stream)))

Index: target-load.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-load.lisp,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -d -r1.32 -r1.33
--- target-load.lisp	5 Apr 2004 23:16:29 -0000	1.32
+++ target-load.lisp	13 Apr 2004 10:30:38 -0000	1.33
@@ -165,7 +165,7 @@
   #!+sb-doc
   "Load the file given by FILESPEC into the Lisp environment, returning
    T on success."
-
+  (declare (ignore external-format))
   (let ((*load-depth* (1+ *load-depth*))
 	;; KLUDGE: I can't find in the ANSI spec where it says that
 	;; DECLAIM/PROCLAIM of optimization policy should have file

Index: target-unithread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-unithread.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- target-unithread.lisp	28 Nov 2003 04:41:05 -0000	1.9
+++ target-unithread.lisp	13 Apr 2004 10:30:38 -0000	1.10
@@ -14,9 +14,11 @@
 ;;;; queues, locks 
 
 ;; spinlocks use 0 as "free" value: higher-level locks use NIL
-(defun get-spinlock (lock offset new-value) )
+(defun get-spinlock (lock offset new-value)
+  (declare (ignore lock offset new-value)))
 
 (defmacro with-spinlock ((queue) &body body)
+  (declare (ignore queue))
   `(progn ,@body))
 
 ;;;; the higher-level locking operations are based on waitqueues
@@ -128,7 +130,11 @@
 ;;;; job control
 
 (defun init-job-control () t)
-(defun debugger-wait-until-foreground-thread (stream) t)
+(defun debugger-wait-until-foreground-thread (stream)
+  (declare (ignore stream))
+  t)
 (defun get-foreground () t)
-(defun release-foreground (&optional next) t)
+(defun release-foreground (&optional next)
+  (declare (ignore next))
+  t)
 (defun terminate-session ())

Index: thread.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/thread.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- thread.lisp	27 Nov 2003 06:21:04 -0000	1.9
+++ thread.lisp	13 Apr 2004 10:30:38 -0000	1.10
@@ -1,6 +1,7 @@
 (in-package "SB!THREAD")
 
 (sb!xc:defmacro with-recursive-lock ((mutex) &body body)
+  (declare (ignore #!-sb-thread mutex))
   #!+sb-thread
   (with-unique-names (cfp)
     `(let ((,cfp (sb!kernel:current-fp)))

Index: time.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/time.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- time.lisp	9 Mar 2004 12:08:40 -0000	1.21
+++ time.lisp	13 Apr 2004 10:30:38 -0000	1.22
@@ -162,6 +162,7 @@
     (if (< unix-time (ash 1 31))
 	unix-time
 	(multiple-value-bind (year offset) (years-since-mar-2000 utime)
+	  (declare (ignore year))
 	  (+  +mar-1-2035+  (- unix-to-universal-time)  offset)))))
   
 (defun decode-universal-time (universal-time &optional time-zone)

Index: x86-vm.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/x86-vm.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- x86-vm.lisp	26 Jun 2003 18:58:45 -0000	1.27
+++ x86-vm.lisp	13 Apr 2004 10:30:38 -0000	1.28
@@ -69,8 +69,7 @@
 
 (declaim (inline adjust-fixup-array))
 (defun adjust-fixup-array (array size)
-  (let ((length (length array))
-        (new (make-array size :element-type '(unsigned-byte 32))))
+  (let ((new (make-array size :element-type '(unsigned-byte 32))))
     (replace new array)
     new))

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25438/src/pcl

Modified Files:
	vector.lisp 
Log Message:
0.8.9.36:
	Commit "ignore during cross-compilation" patch (CSR sbcl-devel
	2004-04-05)
	... bad treatment of IGNORE now gets a full WARNING during
		cross-compilation;
	... fix all the badness this reveals;
	... implement SAME-ARG checking in LOGFOO type derivers;
	... also add one more IGNORABLE in PCL (from Marcus Pearce);
	... test for bad (signed-byte <N>) bug.


Index: vector.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/vector.lisp,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -d -r1.29 -r1.30
--- vector.lisp	30 Nov 2003 15:19:35 -0000	1.29
+++ vector.lisp	13 Apr 2004 10:30:39 -0000	1.30
@@ -907,7 +907,8 @@
   `(pv-env (,pv ,calls ,pv-table-symbol ,pv-parameters)
      (let (,@(mapcar (lambda (slot-var p) `(,slot-var (get-slots-or-nil ,p)))
 		     slot-vars pv-parameters))
-	,@body)))
+       (declare (ignorable ,@(mapcar #'identity slot-vars)))
+       ,@body)))
 
 ;;; This gets used only when the default MAKE-METHOD-LAMBDA is
 ;;; overridden.

Update of /cvsroot/sbcl/sbcl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25438

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.9.36:
	Commit "ignore during cross-compilation" patch (CSR sbcl-devel
	2004-04-05)
	... bad treatment of IGNORE now gets a full WARNING during
		cross-compilation;
	... fix all the badness this reveals;
	... implement SAME-ARG checking in LOGFOO type derivers;
	... also add one more IGNORABLE in PCL (from Marcus Pearce);
	... test for bad (signed-byte <N>) bug.


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.510
retrieving revision 1.511
diff -u -d -r1.510 -r1.511
--- NEWS	8 Apr 2004 13:26:02 -0000	1.510
+++ NEWS	13 Apr 2004 10:30:37 -0000	1.511
@@ -2381,6 +2381,8 @@
     pointers.  (reported by Sean Ross)
   * bug fix: PROFILE output is printed nicely even for large numerical
     values.  (thanks to Zach Beane)
+  * bug fix: streams with element-type (SIGNED-BYTE <N>) for <N>
+    greater than 32 handle EOF correctly.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1545
retrieving revision 1.1546
diff -u -d -r1.1545 -r1.1546
--- version.lisp-expr	11 Apr 2004 21:10:53 -0000	1.1545
+++ version.lisp-expr	13 Apr 2004 10:30:37 -0000	1.1546
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.9.35"
+"0.8.9.36"

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25438/src/compiler/x86

Modified Files:
	float.lisp 
Log Message:
0.8.9.36:
	Commit "ignore during cross-compilation" patch (CSR sbcl-devel
	2004-04-05)
	... bad treatment of IGNORE now gets a full WARNING during
		cross-compilation;
	... fix all the badness this reveals;
	... implement SAME-ARG checking in LOGFOO type derivers;
	... also add one more IGNORABLE in PCL (from Marcus Pearce);
	... test for bad (signed-byte <N>) bug.


Index: float.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/float.lisp,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- float.lisp	15 Mar 2004 15:55:22 -0000	1.17
+++ float.lisp	13 Apr 2004 10:30:39 -0000	1.18
@@ -68,6 +68,7 @@
 ;;; this is the right thing to do anyway; omitting them can lead to
 ;;; system corruption on conforming code.  -- CSR
 (defun maybe-fp-wait (node &optional note-next-instruction)
+  (declare (ignore node))
   #+nil
   (when (policy node (or (= debug 3) (> safety speed))))
   (when note-next-instruction

Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv25438/tests

Modified Files:
	stream.pure.lisp 
Log Message:
0.8.9.36:
	Commit "ignore during cross-compilation" patch (CSR sbcl-devel
	2004-04-05)
	... bad treatment of IGNORE now gets a full WARNING during
		cross-compilation;
	... fix all the badness this reveals;
	... implement SAME-ARG checking in LOGFOO type derivers;
	... also add one more IGNORABLE in PCL (from Marcus Pearce);
	... test for bad (signed-byte <N>) bug.


Index: stream.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/stream.pure.lisp,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- stream.pure.lisp	18 Sep 2003 16:43:57 -0000	1.9
+++ stream.pure.lisp	13 Apr 2004 10:30:39 -0000	1.10
@@ -160,13 +160,14 @@
 ;;; the end of string and the string is adjustable the string will be
 ;;; implicitly extended, otherwise an error will be signalled. The
 ;;; latter case is provided for in the code, but not currently
-;;; excercised since SBCL fill-pointer arrays are always (currently) adjustable.
+;;; excercised since SBCL fill-pointer arrays are always (currently)
+;;; adjustable.
 ;;;
 ;;; * END will refer to the ARRAY-TOTAL-SIZE of string, not
 ;;; FILL-POINTER, since by definition the FILE-POSITION will always be
 ;;; a FILL-POINTER, so that would be of limited use.
 ;;;
-;;; * Rewinding the stream works with owerwriting semantics.
+;;; * Rewinding the stream works with overwriting semantics.
 ;;;
 #+nil (let ((str (make-array 0
 		       :element-type 'character
@@ -238,3 +239,6 @@
   (frob 'character)
   (frob 'base-char)
   (frob 'nil))
+
+(with-open-file (s "/dev/null" :element-type '(signed-byte 48))
+  (assert (eq :eof (read-byte s nil :eof))))