Steel Bank Common Lisp

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.7.29:
	merged dan_b patches from sbcl-devel 2004-01-22:
		"GC fixes: splay.lisp and SIGSTOP"
		"Another one for the collection [bug 108]"


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1444
retrieving revision 1.1445
diff -u -d -r1.1444 -r1.1445
--- version.lisp-expr	28 Jan 2004 22:42:45 -0000	1.1444
+++ version.lisp-expr	29 Jan 2004 04:09:31 -0000	1.1445
@@ -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.7.28"
+"0.8.7.29"

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.7.30:
	More TYPE-ERRORs from stream functions
	... FORCE-OUTPUT, FINISH-OUTPUT, CLEAR-OUTPUT, CLEAR-INPUT


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.472
retrieving revision 1.473
diff -u -d -r1.472 -r1.473
--- NEWS	28 Jan 2004 22:42:45 -0000	1.472
+++ NEWS	29 Jan 2004 11:44:03 -0000	1.473
@@ -2286,6 +2286,8 @@
     ** OPEN :DIRECTION :IO no longer fails to work on non-existent
        files.
     ** DIRECTORY on logical pathnames is more correct.
+    ** CLEAR-INPUT, CLEAR-OUTPUT, FINISH-OUTPUT and FORCE-OUTPUT
+       signal a TYPE-ERROR if their argument is not a stream.
 
 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.1445
retrieving revision 1.1446
diff -u -d -r1.1445 -r1.1446
--- version.lisp-expr	29 Jan 2004 04:09:31 -0000	1.1445
+++ version.lisp-expr	29 Jan 2004 11:44:03 -0000	1.1446
@@ -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.7.29"
+"0.8.7.30"

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

Modified Files:
	gray-streams.lisp 
Log Message:
0.8.7.30:
	More TYPE-ERRORs from stream functions
	... FORCE-OUTPUT, FINISH-OUTPUT, CLEAR-OUTPUT, CLEAR-INPUT


Index: gray-streams.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/gray-streams.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- gray-streams.lisp	18 Jan 2004 21:02:27 -0000	1.12
+++ gray-streams.lisp	29 Jan 2004 11:44:04 -0000	1.13
@@ -15,13 +15,19 @@
 ;;; user is responsible for some of the protocol implementation, it's
 ;;; not necessarily a bug in SBCL itself if we fall through to one of
 ;;; these default methods.
+;;;
+;;; FIXME: there's a lot of similarity in these Gray stream
+;;; implementation generic functions.  All of them could (maybe
+;;; should?) have two default methods: one on STREAM calling
+;;; BUG-OR-ERROR, and one on T signalling a TYPE-ERROR.
 (defmacro bug-or-error (stream fun)
-  `(error "~@<The stream ~S has no suitable method for ~S, ~
-           and so has fallen through to this method.  If you think that this is ~
-           a bug, please report it to the applicable authority (bugs in SBCL itself ~
-           should go to the mailing lists referenced from <http://www.sbcl.org/>).~@:>"
-           ,stream ,fun))
-
+  `(error
+    "~@<The stream ~S has no suitable method for ~S, ~
+     and so has fallen through to this method.  If you think that this is ~
+     a bug, please report it to the applicable authority (bugs in SBCL itself ~
+     should go to the mailing lists referenced from ~
+     <http://www.sbcl.org/>).~@:>"
+    ,stream ,fun))
 
 (fmakunbound 'stream-element-type)
 
@@ -218,6 +224,10 @@
 
 (defmethod stream-clear-input ((stream fundamental-character-input-stream))
   nil)
+(defmethod stream-clear-input ((stream stream))
+  (bug-or-error stream 'stream-clear-input))
+(defmethod stream-clear-input ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-read-sequence (stream seq &optional start end)
   (:documentation
@@ -379,6 +389,10 @@
 
 (defmethod stream-finish-output ((stream fundamental-output-stream))
   nil)
+(defmethod stream-finish-output ((stream stream))
+  (bug-or-error stream 'stream-finish-output))
+(defmethod stream-finish-output ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-force-output (stream)
   #+sb-doc
@@ -388,6 +402,10 @@
 
 (defmethod stream-force-output ((stream fundamental-output-stream))
   nil)
+(defmethod stream-force-output ((stream stream))
+  (bug-or-error stream 'stream-force-output))
+(defmethod stream-force-output ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-clear-output (stream)
   #+sb-doc
@@ -397,6 +415,10 @@
 
 (defmethod stream-clear-output ((stream fundamental-output-stream))
   nil)
+(defmethod stream-clear-output ((stream stream))
+  (bug-or-error stream 'stream-clear-output))
+(defmethod stream-clear-output ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
 
 (defgeneric stream-advance-to-column (stream column)
   #+sb-doc

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

Modified Files:
	gray-streams.lisp 
Log Message:
0.8.7.31:
	Make READ-BYTE and WRITE-BYTE signal errors on non-streams
	as required


Index: gray-streams.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/gray-streams.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- gray-streams.lisp	29 Jan 2004 11:44:04 -0000	1.13
+++ gray-streams.lisp	29 Jan 2004 15:17:26 -0000	1.14
@@ -492,12 +492,22 @@
    "Used by READ-BYTE; returns either an integer, or the symbol :EOF
   if the stream is at end-of-file."))
 
+(defmethod stream-read-byte ((stream stream))
+  (bug-or-error stream 'stream-read-byte))
+(defmethod stream-read-byte ((non-stream t))
+  (error 'type-error :datum non-stream :expected-type 'stream))
+
 (defgeneric stream-write-byte (stream integer)
   #+sb-doc
   (:documentation
    "Implements WRITE-BYTE; writes the integer to the stream and
   returns the integer as the result."))
 
+(defmethod stream-write-byte ((stream stream) integer)
+  (bug-or-error stream 'stream-write-byte))
+(defmethod stream-write-byte ((non-stream t) integer)
+  (error 'type-error :datum non-stream :expected-type 'stream))
+
 ;; Provide a reasonable default for binary Gray streams.  We might be
 ;; able to do better by specializing on the sequence type, but at
 ;; least the behaviour is reasonable. --tony 2003/05/08.

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.7.31:
	Make READ-BYTE and WRITE-BYTE signal errors on non-streams
	as required


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.473
retrieving revision 1.474
diff -u -d -r1.473 -r1.474
--- NEWS	29 Jan 2004 11:44:03 -0000	1.473
+++ NEWS	29 Jan 2004 15:17:26 -0000	1.474
@@ -2288,6 +2288,8 @@
     ** DIRECTORY on logical pathnames is more correct.
     ** CLEAR-INPUT, CLEAR-OUTPUT, FINISH-OUTPUT and FORCE-OUTPUT
        signal a TYPE-ERROR if their argument is not a stream.
+    ** READ-BYTE and WRITE-BYTE signal a TYPE-ERROR if their stream
+       designator argument does not designate a stream.
 
 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.1446
retrieving revision 1.1447
diff -u -d -r1.1446 -r1.1447
--- version.lisp-expr	29 Jan 2004 11:44:03 -0000	1.1446
+++ version.lisp-expr	29 Jan 2004 15:17:26 -0000	1.1447
@@ -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.7.30"
+"0.8.7.31"

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

Modified Files:
	BUGS version.lisp-expr 
Log Message:
0.8.7.33:
	just logging a bug



Index: BUGS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/BUGS,v
retrieving revision 1.366
retrieving revision 1.367
diff -u -d -r1.366 -r1.367
--- BUGS	14 Jan 2004 04:42:52 -0000	1.366
+++ BUGS	30 Jan 2004 21:07:17 -0000	1.367
@@ -1235,3 +1235,17 @@
   less error prone to have EXPLICIT-CHECK be a local declaration,
   being put into the definition, instead of an attribute being kept in
   a separate file; maybe also put it into SB-EXT?
+
+301: ARRAY-SIMPLE-=-TYPE-METHOD breaks on corner cases which can arise
+     in NOTE-ASSUMED-TYPES
+  In sbcl-0.8.7.32, compiling the file
+	(defun foo (x y)
+	  (declare (type integer x))
+	  (declare (type (vector (or hash-table bit)) y))
+	  (bletch 2 y))
+	(defun bar (x y)
+	  (declare (type integer x))
+	  (declare (type (simple-array base (2)) y))
+	  (bletch 1 y))
+  gives the error
+    failed AVER: "(NOT (AND (NOT EQUALP) CERTAINP))"

Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1448
retrieving revision 1.1449
diff -u -d -r1.1448 -r1.1449
--- version.lisp-expr	30 Jan 2004 20:55:40 -0000	1.1448
+++ version.lisp-expr	30 Jan 2004 21:07:17 -0000	1.1449
@@ -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.7.32"
+"0.8.7.33"

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.7.32:
	renamed FOO_PAGE masks to FOO_PAGE_MASK in hopes of reducing
		future confusion between wordwise equality and bitwise
		flag testing (which seemed to be implicit in one of the
		GC fixes in 0.8.7.whatever)



Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1447
retrieving revision 1.1448
diff -u -d -r1.1447 -r1.1448
--- version.lisp-expr	29 Jan 2004 15:17:26 -0000	1.1447
+++ version.lisp-expr	30 Jan 2004 20:55:40 -0000	1.1448
@@ -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.7.31"
+"0.8.7.32"

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

Modified Files:
	gc-internal.h gencgc.c 
Log Message:
0.8.7.32:
	renamed FOO_PAGE masks to FOO_PAGE_MASK in hopes of reducing
		future confusion between wordwise equality and bitwise
		flag testing (which seemed to be implicit in one of the
		GC fixes in 0.8.7.whatever)



Index: gc-internal.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-internal.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- gc-internal.h	1 Jan 2004 22:02:50 -0000	1.4
+++ gc-internal.h	30 Jan 2004 20:56:06 -0000	1.5
@@ -35,10 +35,10 @@
 #define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
 
 /* values for the *_alloc_* parameters */
-#define FREE_PAGE 0
-#define BOXED_PAGE 1
-#define UNBOXED_PAGE 2
-#define OPEN_REGION_PAGE 4
+#define FREE_PAGE_FLAG 0
+#define BOXED_PAGE_FLAG 1
+#define UNBOXED_PAGE_FLAG 2
+#define OPEN_REGION_PAGE_FLAG 4
 
 #define ALLOC_BOXED 0
 #define ALLOC_UNBOXED 1

Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.49
retrieving revision 1.50
diff -u -d -r1.49 -r1.50
--- gencgc.c	29 Jan 2004 04:09:53 -0000	1.49
+++ gencgc.c	30 Jan 2004 20:56:06 -0000	1.50
@@ -274,7 +274,7 @@
     int count = 0;
 
     for (i = 0; i < last_free_page; i++)
-	if ((page_table[i].allocated != FREE_PAGE)
+	if ((page_table[i].allocated != FREE_PAGE_FLAG)
 	    && (page_table[i].gen == generation)
 	    && (page_table[i].write_protected == 1))
 	    count++;
@@ -372,7 +372,7 @@
 
 		/* Count the number of boxed pages within the given
 		 * generation. */
-		if (page_table[j].allocated & BOXED_PAGE) {
+		if (page_table[j].allocated & BOXED_PAGE_FLAG) {
 		    if (page_table[j].large_object)
 			large_boxed_cnt++;
 		    else
@@ -381,7 +381,7 @@
 		if(page_table[j].dont_move) pinned_cnt++;
 		/* Count the number of unboxed pages within the given
 		 * generation. */
-		if (page_table[j].allocated & UNBOXED_PAGE) {
+		if (page_table[j].allocated & UNBOXED_PAGE_FLAG) {
 		    if (page_table[j].large_object)
 			large_unboxed_cnt++;
 		    else
@@ -533,35 +533,35 @@
     /* The first page may have already been in use. */
     if (page_table[first_page].bytes_used == 0) {
 	if (unboxed)
-	    page_table[first_page].allocated = UNBOXED_PAGE;
+	    page_table[first_page].allocated = UNBOXED_PAGE_FLAG;
 	else
-	    page_table[first_page].allocated = BOXED_PAGE;
+	    page_table[first_page].allocated = BOXED_PAGE_FLAG;
 	page_table[first_page].gen = gc_alloc_generation;
 	page_table[first_page].large_object = 0;
 	page_table[first_page].first_object_offset = 0;
     }
 
     if (unboxed)
-	gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
+	gc_assert(page_table[first_page].allocated == UNBOXED_PAGE_FLAG);
     else
-	gc_assert(page_table[first_page].allocated == BOXED_PAGE);
-    page_table[first_page].allocated |= OPEN_REGION_PAGE; 
+	gc_assert(page_table[first_page].allocated == BOXED_PAGE_FLAG);
+    page_table[first_page].allocated |= OPEN_REGION_PAGE_FLAG; 
 
     gc_assert(page_table[first_page].gen == gc_alloc_generation);
     gc_assert(page_table[first_page].large_object == 0);
 
     for (i = first_page+1; i <= last_page; i++) {
 	if (unboxed)
-	    page_table[i].allocated = UNBOXED_PAGE;
+	    page_table[i].allocated = UNBOXED_PAGE_FLAG;
 	else
-	    page_table[i].allocated = BOXED_PAGE;
+	    page_table[i].allocated = BOXED_PAGE_FLAG;
 	page_table[i].gen = gc_alloc_generation;
 	page_table[i].large_object = 0;
 	/* This may not be necessary for unboxed regions (think it was
 	 * broken before!) */
 	page_table[i].first_object_offset =
 	    alloc_region->start_addr - page_address(i);
-	page_table[i].allocated |= OPEN_REGION_PAGE ;
+	page_table[i].allocated |= OPEN_REGION_PAGE_FLAG ;
     }
     /* Bump up last_free_page. */
     if (last_page+1 > last_free_page) {
@@ -722,12 +722,12 @@
 	 * first_object_offset. */
 	if (page_table[first_page].bytes_used == 0)
 	    gc_assert(page_table[first_page].first_object_offset == 0);
-	page_table[first_page].allocated &= ~(OPEN_REGION_PAGE);
+	page_table[first_page].allocated &= ~(OPEN_REGION_PAGE_FLAG);
 
 	if (unboxed)
-	    gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
+	    gc_assert(page_table[first_page].allocated == UNBOXED_PAGE_FLAG);
 	else
-	    gc_assert(page_table[first_page].allocated == BOXED_PAGE);
+	    gc_assert(page_table[first_page].allocated == BOXED_PAGE_FLAG);
 	gc_assert(page_table[first_page].gen == gc_alloc_generation);
 	gc_assert(page_table[first_page].large_object == 0);
 
@@ -748,11 +748,11 @@
 	 * first_object_offset pointer to the start of the region, and set
 	 * the bytes_used. */
 	while (more) {
-	    page_table[next_page].allocated &= ~(OPEN_REGION_PAGE);
+	    page_table[next_page].allocated &= ~(OPEN_REGION_PAGE_FLAG);
 	    if (unboxed)
-		gc_assert(page_table[next_page].allocated == UNBOXED_PAGE);
+		gc_assert(page_table[next_page].allocated==UNBOXED_PAGE_FLAG);
 	    else
-		gc_assert(page_table[next_page].allocated == BOXED_PAGE);
+		gc_assert(page_table[next_page].allocated == BOXED_PAGE_FLAG);
 	    gc_assert(page_table[next_page].bytes_used == 0);
 	    gc_assert(page_table[next_page].gen == gc_alloc_generation);
 	    gc_assert(page_table[next_page].large_object == 0);
@@ -800,15 +800,15 @@
     } else {
 	/* There are no bytes allocated. Unallocate the first_page if
 	 * there are 0 bytes_used. */
-	page_table[first_page].allocated &= ~(OPEN_REGION_PAGE);
+	page_table[first_page].allocated &= ~(OPEN_REGION_PAGE_FLAG);
 	if (page_table[first_page].bytes_used == 0)
-	    page_table[first_page].allocated = FREE_PAGE;
+	    page_table[first_page].allocated = FREE_PAGE_FLAG;
     }
 
     /* Unallocate any unused pages. */
     while (next_page <= alloc_region->last_page) {
 	gc_assert(page_table[next_page].bytes_used == 0);
-	page_table[next_page].allocated = FREE_PAGE;
+	page_table[next_page].allocated = FREE_PAGE_FLAG;
 	next_page++;
     }
     release_spinlock(&free_pages_lock);
@@ -858,18 +858,18 @@
      * first_object_offset. */
     if (page_table[first_page].bytes_used == 0) {
 	if (unboxed)
-	    page_table[first_page].allocated = UNBOXED_PAGE;
+	    page_table[first_page].allocated = UNBOXED_PAGE_FLAG;
 	else
-	    page_table[first_page].allocated = BOXED_PAGE;
+	    page_table[first_page].allocated = BOXED_PAGE_FLAG;
 	page_table[first_page].gen = gc_alloc_generation;
 	page_table[first_page].first_object_offset = 0;
 	page_table[first_page].large_object = 1;
     }
 
     if (unboxed)
-	gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
+	gc_assert(page_table[first_page].allocated == UNBOXED_PAGE_FLAG);
     else
-	gc_assert(page_table[first_page].allocated == BOXED_PAGE);
+	gc_assert(page_table[first_page].allocated == BOXED_PAGE_FLAG);
     gc_assert(page_table[first_page].gen == gc_alloc_generation);
     gc_assert(page_table[first_page].large_object == 1);
 
@@ -891,12 +891,12 @@
      * first_object_offset pointer to the start of the region, and
      * set the bytes_used. */
     while (more) {
-	gc_assert(page_table[next_page].allocated == FREE_PAGE);
+	gc_assert(page_table[next_page].allocated == FREE_PAGE_FLAG);
 	gc_assert(page_table[next_page].bytes_used == 0);
 	if (unboxed)
-	    page_table[next_page].allocated = UNBOXED_PAGE;
+	    page_table[next_page].allocated = UNBOXED_PAGE_FLAG;
 	else
-	    page_table[next_page].allocated = BOXED_PAGE;
+	    page_table[next_page].allocated = BOXED_PAGE_FLAG;
 	page_table[next_page].gen = gc_alloc_generation;
 	page_table[next_page].large_object = 1;
 
@@ -956,14 +956,14 @@
 	first_page = restart_page;
 	if (large_p)		
 	    while ((first_page < NUM_PAGES)
-		   && (page_table[first_page].allocated != FREE_PAGE))
+		   && (page_table[first_page].allocated != FREE_PAGE_FLAG))
 		first_page++;
 	else
 	    while (first_page < NUM_PAGES) {
-		if(page_table[first_page].allocated == FREE_PAGE)
+		if(page_table[first_page].allocated == FREE_PAGE_FLAG)
 		    break;
 		if((page_table[first_page].allocated ==
-		    (unboxed ? UNBOXED_PAGE : BOXED_PAGE)) &&
+		    (unboxed ? UNBOXED_PAGE_FLAG : BOXED_PAGE_FLAG)) &&
 		   (page_table[first_page].large_object == 0) &&
 		   (page_table[first_page].gen == gc_alloc_generation) &&
 		   (page_table[first_page].bytes_used < (PAGE_BYTES-32)) &&
@@ -990,7 +990,7 @@
 	while (((bytes_found < nbytes) 
 		|| (!large_p && (num_pages < 2)))
 	       && (last_page < (NUM_PAGES-1))
-	       && (page_table[last_page+1].allocated == FREE_PAGE)) {
+	       && (page_table[last_page+1].allocated == FREE_PAGE_FLAG)) {
 	    last_page++;
 	    num_pages++;
 	    bytes_found += PAGE_BYTES;
@@ -1150,7 +1150,7 @@
 	remaining_bytes = nwords*4;
 	while (remaining_bytes > PAGE_BYTES) {
 	    gc_assert(page_table[next_page].gen == from_space);
-	    gc_assert(page_table[next_page].allocated == BOXED_PAGE);
+	    gc_assert(page_table[next_page].allocated == BOXED_PAGE_FLAG);
 	    gc_assert(page_table[next_page].large_object);
 	    gc_assert(page_table[next_page].first_object_offset==
 		      -PAGE_BYTES*(next_page-first_page));
@@ -1175,7 +1175,7 @@
 	gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
 
 	page_table[next_page].gen = new_space;
-	gc_assert(page_table[next_page].allocated == BOXED_PAGE);
+	gc_assert(page_table[next_page].allocated == BOXED_PAGE_FLAG);
 
 	/* Adjust the bytes_used. */
 	old_bytes_used = page_table[next_page].bytes_used;
@@ -1187,7 +1187,7 @@
 	next_page++;
 	while ((old_bytes_used == PAGE_BYTES) &&
 	       (page_table[next_page].gen == from_space) &&
-	       (page_table[next_page].allocated == BOXED_PAGE) &&
+	       (page_table[next_page].allocated == BOXED_PAGE_FLAG) &&
 	       page_table[next_page].large_object &&
 	       (page_table[next_page].first_object_offset ==
 		-(next_page - first_page)*PAGE_BYTES)) {
@@ -1198,7 +1198,7 @@
 	    gc_assert(page_table[next_page].write_protected == 0);
 
 	    old_bytes_used = page_table[next_page].bytes_used;
-	    page_table[next_page].allocated = FREE_PAGE;
+	    page_table[next_page].allocated = FREE_PAGE_FLAG;
 	    page_table[next_page].bytes_used = 0;
 	    bytes_freed += old_bytes_used;
 	    next_page++;
@@ -1294,15 +1294,15 @@
 	remaining_bytes = nwords*4;
 	while (remaining_bytes > PAGE_BYTES) {
 	    gc_assert(page_table[next_page].gen == from_space);
-	    gc_assert((page_table[next_page].allocated == UNBOXED_PAGE)
-		      || (page_table[next_page].allocated == BOXED_PAGE));
+	    gc_assert((page_table[next_page].allocated == UNBOXED_PAGE_FLAG)
+		      || (page_table[next_page].allocated == BOXED_PAGE_FLAG));
 	    gc_assert(page_table[next_page].large_object);
 	    gc_assert(page_table[next_page].first_object_offset==
 		      -PAGE_BYTES*(next_page-first_page));
 	    gc_assert(page_table[next_page].bytes_used == PAGE_BYTES);
 
 	    page_table[next_page].gen = new_space;
-	    page_table[next_page].allocated = UNBOXED_PAGE;
+	    page_table[next_page].allocated = UNBOXED_PAGE_FLAG;
 	    remaining_bytes -= PAGE_BYTES;
 	    next_page++;
 	}
@@ -1314,7 +1314,7 @@
 	gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
 
 	page_table[next_page].gen = new_space;
-	page_table[next_page].allocated = UNBOXED_PAGE;
+	page_table[next_page].allocated = UNBOXED_PAGE_FLAG;
 
 	/* Adjust the bytes_used. */
 	old_bytes_used = page_table[next_page].bytes_used;
@@ -1326,8 +1326,8 @@
 	next_page++;
 	while ((old_bytes_used == PAGE_BYTES) &&
 	       (page_table[next_page].gen == from_space) &&
-	       ((page_table[next_page].allocated == UNBOXED_PAGE)
-		|| (page_table[next_page].allocated == BOXED_PAGE)) &&
+	       ((page_table[next_page].allocated == UNBOXED_PAGE_FLAG)
+		|| (page_table[next_page].allocated == BOXED_PAGE_FLAG)) &&
 	       page_table[next_page].large_object &&
 	       (page_table[next_page].first_object_offset ==
 		-(next_page - first_page)*PAGE_BYTES)) {
@@ -1338,7 +1338,7 @@
 	    gc_assert(page_table[next_page].write_protected == 0);
 
 	    old_bytes_used = page_table[next_page].bytes_used;
-	    page_table[next_page].allocated = FREE_PAGE;
+	    page_table[next_page].allocated = FREE_PAGE_FLAG;
 	    page_table[next_page].bytes_used = 0;
 	    bytes_freed += old_bytes_used;
 	    next_page++;
@@ -2013,7 +2013,8 @@
     lispobj *start;
 
     /* The address may be invalid, so do some checks. */
-    if ((page_index == -1) || (page_table[page_index].allocated == FREE_PAGE))
+    if ((page_index == -1) ||
+	(page_table[page_index].allocated == FREE_PAGE_FLAG))
 	return NULL;
     start = (lispobj *)((void *)page_address(page_index)
 			+ page_table[page_index].first_object_offset);
@@ -2277,7 +2278,7 @@
     /* Check whether it's a vector or bignum object. */
     switch (widetag_of(where[0])) {
     case SIMPLE_VECTOR_WIDETAG:
-	boxed = BOXED_PAGE;
+	boxed = BOXED_PAGE_FLAG;
 	break;
     case BIGNUM_WIDETAG:
     case SIMPLE_BASE_STRING_WIDETAG:
@@ -2318,7 +2319,7 @@
 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
     case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
 #endif
-	boxed = UNBOXED_PAGE;
+	boxed = UNBOXED_PAGE_FLAG;
 	break;
     default:
 	return;
@@ -2342,8 +2343,8 @@
     remaining_bytes = nwords*4;
     while (remaining_bytes > PAGE_BYTES) {
 	gc_assert(page_table[next_page].gen == from_space);
-	gc_assert((page_table[next_page].allocated == BOXED_PAGE)
-		  || (page_table[next_page].allocated == UNBOXED_PAGE));
+	gc_assert((page_table[next_page].allocated == BOXED_PAGE_FLAG)
+		  || (page_table[next_page].allocated == UNBOXED_PAGE_FLAG));
 	gc_assert(page_table[next_page].large_object);
 	gc_assert(page_table[next_page].first_object_offset ==
 		  -PAGE_BYTES*(next_page-first_page));
@@ -2378,8 +2379,8 @@
     next_page++;
     while ((old_bytes_used == PAGE_BYTES) &&
 	   (page_table[next_page].gen == from_space) &&
-	   ((page_table[next_page].allocated == UNBOXED_PAGE)
-	    || (page_table[next_page].allocated == BOXED_PAGE)) &&
+	   ((page_table[next_page].allocated == UNBOXED_PAGE_FLAG)
+	    || (page_table[next_page].allocated == BOXED_PAGE_FLAG)) &&
 	   page_table[next_page].large_object &&
 	   (page_table[next_page].first_object_offset ==
 	    -(next_page - first_page)*PAGE_BYTES)) {
@@ -2390,7 +2391,7 @@
 	gc_assert(page_table[next_page].write_protected == 0);
 
 	old_bytes_used = page_table[next_page].bytes_used;
-	page_table[next_page].allocated = FREE_PAGE;
+	page_table[next_page].allocated = FREE_PAGE_FLAG;
 	page_table[next_page].bytes_used = 0;
 	bytes_freed += old_bytes_used;
 	next_page++;
@@ -2430,13 +2431,13 @@
 
     /* quick check 1: Address is quite likely to have been invalid. */
     if ((addr_page_index == -1)
-	|| (page_table[addr_page_index].allocated == FREE_PAGE)
+	|| (page_table[addr_page_index].allocated == FREE_PAGE_FLAG)
 	|| (page_table[addr_page_index].bytes_used == 0)
 	|| (page_table[addr_page_index].gen != from_space)
 	/* Skip if already marked dont_move. */
 	|| (page_table[addr_page_index].dont_move != 0))
 	return;
-    gc_assert(!(page_table[addr_page_index].allocated & OPEN_REGION_PAGE));
+    gc_assert(!(page_table[addr_page_index].allocated&OPEN_REGION_PAGE_FLAG));
     /* (Now that we know that addr_page_index is in range, it's
      * safe to index into page_table[] with it.) */
     region_allocation = page_table[addr_page_index].allocated;
@@ -2486,7 +2487,7 @@
 	 * free area in which case it's ignored here. Note it gets
 	 * through the valid pointer test above because the tail looks
 	 * like conses. */
-	if ((page_table[addr_page_index].allocated == FREE_PAGE)
+	if ((page_table[addr_page_index].allocated == FREE_PAGE_FLAG)
 	    || (page_table[addr_page_index].bytes_used == 0)
 	    /* Check the offset within the page. */
 	    || (((unsigned)addr & (PAGE_BYTES - 1))
@@ -2525,7 +2526,7 @@
 	/* Check whether this is the last page in this contiguous block.. */
 	if ((page_table[i].bytes_used < PAGE_BYTES)
 	    /* ..or it is PAGE_BYTES and is the last in the block */
-	    || (page_table[i+1].allocated == FREE_PAGE)
+	    || (page_table[i+1].allocated == FREE_PAGE_FLAG)
 	    || (page_table[i+1].bytes_used == 0) /* next page free */
 	    || (page_table[i+1].gen != from_space) /* diff. gen */
 	    || (page_table[i+1].first_object_offset == 0))
@@ -2559,13 +2560,13 @@
     int num_words = page_table[page].bytes_used / 4;
 
     /* Shouldn't be a free page. */
-    gc_assert(page_table[page].allocated != FREE_PAGE);
+    gc_assert(page_table[page].allocated != FREE_PAGE_FLAG);
     gc_assert(page_table[page].bytes_used != 0);
 
     /* Skip if it's already write-protected, pinned, or unboxed */
     if (page_table[page].write_protected
 	|| page_table[page].dont_move
-	|| (page_table[page].allocated & UNBOXED_PAGE))
+	|| (page_table[page].allocated & UNBOXED_PAGE_FLAG))
 	return (0);
 
     /* Scan the page for pointers to younger generations or the
@@ -2578,7 +2579,7 @@
 	/* Check that it's in the dynamic space */
 	if (index != -1)
 	    if (/* Does it point to a younger or the temp. generation? */
-		((page_table[index].allocated != FREE_PAGE)
+		((page_table[index].allocated != FREE_PAGE_FLAG)
 		 && (page_table[index].bytes_used != 0)
 		 && ((page_table[index].gen < gen)
 		     || (page_table[index].gen == NUM_GENERATIONS)))
@@ -2653,7 +2654,7 @@
 #endif
 
     for (i = 0; i < last_free_page; i++) {
-	if ((page_table[i].allocated & BOXED_PAGE)
+	if ((page_table[i].allocated & BOXED_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == generation)) {
 	    int last_page,j;
@@ -2668,7 +2669,7 @@
 		    write_protected && page_table[last_page].write_protected;
 		if ((page_table[last_page].bytes_used < PAGE_BYTES)
 		    /* Or it is PAGE_BYTES and is the last in the block */
-		    || (!(page_table[last_page+1].allocated & BOXED_PAGE))
+		    || (!(page_table[last_page+1].allocated & BOXED_PAGE_FLAG))
 		    || (page_table[last_page+1].bytes_used == 0)
 		    || (page_table[last_page+1].gen != generation)
 		    || (page_table[last_page+1].first_object_offset == 0))
@@ -2699,7 +2700,7 @@
     /* Check that none of the write_protected pages in this generation
      * have been written to. */
     for (i = 0; i < NUM_PAGES; i++) {
-	if ((page_table[i].allocation ! =FREE_PAGE)
+	if ((page_table[i].allocation != FREE_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == generation)
 	    && (page_table[i].write_protected_cleared != 0)) {
@@ -2753,7 +2754,7 @@
 	   generation));
     for (i = 0; i < last_free_page; i++) {
 	/* Note that this skips over open regions when it encounters them. */
-	if ((page_table[i].allocated & BOXED_PAGE)
+	if ((page_table[i].allocated & BOXED_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == generation)
 	    && ((page_table[i].write_protected == 0)
@@ -2781,7 +2782,7 @@
 		 * contiguous block */
 		if ((page_table[last_page].bytes_used < PAGE_BYTES)
 		    /* Or it is PAGE_BYTES and is the last in the block */
-		    || (!(page_table[last_page+1].allocated & BOXED_PAGE))
+		    || (!(page_table[last_page+1].allocated & BOXED_PAGE_FLAG))
 		    || (page_table[last_page+1].bytes_used == 0)
 		    || (page_table[last_page+1].gen != generation)
 		    || (page_table[last_page+1].first_object_offset == 0))
@@ -2922,7 +2923,7 @@
     /* Check that none of the write_protected pages in this generation
      * have been written to. */
     for (i = 0; i < NUM_PAGES; i++) {
-	if ((page_table[i].allocation != FREE_PAGE)
+	if ((page_table[i].allocation != FREE_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == generation)
 	    && (page_table[i].write_protected_cleared != 0)
@@ -2945,7 +2946,7 @@
     int i;
 
     for (i = 0; i < last_free_page; i++) {
-	if ((page_table[i].allocated != FREE_PAGE)
+	if ((page_table[i].allocated != FREE_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == from_space)) {
 	    void *page_start;
@@ -2978,7 +2979,7 @@
     do {
 	/* Find a first page for the next region of pages. */
 	while ((first_page < last_free_page)
-	       && ((page_table[first_page].allocated == FREE_PAGE)
+	       && ((page_table[first_page].allocated == FREE_PAGE_FLAG)
 		   || (page_table[first_page].bytes_used == 0)
 		   || (page_table[first_page].gen != from_space)))
 	    first_page++;
@@ -2994,7 +2995,7 @@
 	    bytes_freed += page_table[last_page].bytes_used;
 	    generations[page_table[last_page].gen].bytes_allocated -=
 		page_table[last_page].bytes_used;
-	    page_table[last_page].allocated = FREE_PAGE;
+	    page_table[last_page].allocated = FREE_PAGE_FLAG;
 	    page_table[last_page].bytes_used = 0;
 
 	    /* Remove any write-protection. We should be able to rely
@@ -3010,7 +3011,7 @@
 	    last_page++;
 	}
 	while ((last_page < last_free_page)
-	       && (page_table[last_page].allocated != FREE_PAGE)
+	       && (page_table[last_page].allocated != FREE_PAGE_FLAG)
 	       && (page_table[last_page].bytes_used != 0)
 	       && (page_table[last_page].gen == from_space));
 
@@ -3111,7 +3112,7 @@
 	    if (page_index != -1) {
 		/* If it's within the dynamic space it should point to a used
 		 * page. XX Could check the offset too. */
-		if ((page_table[page_index].allocated != FREE_PAGE)
+		if ((page_table[page_index].allocated != FREE_PAGE_FLAG)
 		    && (page_table[page_index].bytes_used == 0))
 		    lose ("Ptr %x @ %x sees free page.", thing, start);
 		/* Check that it doesn't point to a forwarding pointer! */
@@ -3326,7 +3327,7 @@
     int i;
 
     for (i = 0; i < last_free_page; i++) {
-	if ((page_table[i].allocated != FREE_PAGE)
+	if ((page_table[i].allocated != FREE_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == generation)) {
 	    int last_page;
@@ -3365,7 +3366,7 @@
     int page;
 
     for (page = 0; page < last_free_page; page++) {
-	if (page_table[page].allocated == FREE_PAGE) {
+	if (page_table[page].allocated == FREE_PAGE_FLAG) {
 	    /* The whole page should be zero filled. */
 	    int *start_addr = (int *)page_address(page);
 	    int size = 1024;
@@ -3423,7 +3424,7 @@
     gc_assert(generation < NUM_GENERATIONS);
 
     for (i = 0; i < last_free_page; i++)
-	if ((page_table[i].allocated == BOXED_PAGE)
+	if ((page_table[i].allocated == BOXED_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0)
 	    && !page_table[i].dont_move
 	    && (page_table[i].gen == generation))  {
@@ -3708,7 +3709,7 @@
     int i;
 
     for (i = 0; i < NUM_PAGES; i++)
-	if ((page_table[i].allocated != FREE_PAGE)
+	if ((page_table[i].allocated != FREE_PAGE_FLAG)
 	    && (page_table[i].bytes_used != 0))
 	    last_page = i;
 
@@ -3859,15 +3860,15 @@
 
     for (page = 0; page < NUM_PAGES; page++) {
 	/* Skip free pages which should already be zero filled. */
-	if (page_table[page].allocated != FREE_PAGE) {
+	if (page_table[page].allocated != FREE_PAGE_FLAG) {
 	    void *page_start, *addr;
 
 	    /* Mark the page free. The other slots are assumed invalid
-	     * when it is a FREE_PAGE and bytes_used is 0 and it
+	     * when it is a FREE_PAGE_FLAG and bytes_used is 0 and it
 	     * should not be write-protected -- except that the
 	     * generation is used for the current region but it sets
 	     * that up. */
-	    page_table[page].allocated = FREE_PAGE;
+	    page_table[page].allocated = FREE_PAGE_FLAG;
 	    page_table[page].bytes_used = 0;
 
 	    /* Zero the page. */
@@ -3887,7 +3888,7 @@
 	} else if (gencgc_zero_check_during_free_heap) {
 	    /* Double-check that the page is zero filled. */
 	    int *page_start, i;
-	    gc_assert(page_table[page].allocated == FREE_PAGE);
+	    gc_assert(page_table[page].allocated == FREE_PAGE_FLAG);
 	    gc_assert(page_table[page].bytes_used == 0);
 	    page_start = (int *)page_address(page);
 	    for (i=0; i<1024; i++) {
@@ -3947,7 +3948,7 @@
     /* Initialize each page structure. */
     for (i = 0; i < NUM_PAGES; i++) {
 	/* Initialize all pages as free. */
-	page_table[i].allocated = FREE_PAGE;
+	page_table[i].allocated = FREE_PAGE_FLAG;
 	page_table[i].bytes_used = 0;
 
 	/* Pages are not write-protected at startup. */
@@ -3997,7 +3998,7 @@
 
     do {
 	lispobj *first,*ptr= (lispobj *)page_address(page);
-	page_table[page].allocated = BOXED_PAGE;
+	page_table[page].allocated = BOXED_PAGE_FLAG;
 	page_table[page].gen = 0;
 	page_table[page].bytes_used = PAGE_BYTES;
 	page_table[page].large_object = 0;

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

Modified Files:
	late-type.lisp 
Log Message:
0.8.7.32:
	renamed FOO_PAGE masks to FOO_PAGE_MASK in hopes of reducing
		future confusion between wordwise equality and bitwise
		flag testing (which seemed to be implicit in one of the
		GC fixes in 0.8.7.whatever)



Index: late-type.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/late-type.lisp,v
retrieving revision 1.101
retrieving revision 1.102
diff -u -d -r1.101 -r1.102
--- late-type.lisp	11 Dec 2003 13:34:25 -0000	1.101
+++ late-type.lisp	30 Jan 2004 20:55:52 -0000	1.102
@@ -2092,7 +2092,7 @@
       (multiple-value-bind (equalp certainp)
 	  (type= (array-type-element-type type1)
 		 (array-type-element-type type2))
-	;; by its nature, the call to TYPE= should never return NIL,
+	;; By its nature, the call to TYPE= should never return NIL,
 	;; T, as we don't know what the UNKNOWN-TYPE will grow up to
 	;; be.  -- CSR, 2002-08-19
 	(aver (not (and (not equalp) certainp)))
@@ -2108,7 +2108,7 @@
 (!define-type-method (array :negate) (type)
   ;; FIXME (and hint to PFD): we're vulnerable here to attacks of the
   ;; form "are (AND ARRAY (NOT (ARRAY T))) and (OR (ARRAY BIT) (ARRAY
-  ;; NIL) (ARRAY CHAR) ...) equivalent?  -- CSR, 2003-12-10
+  ;; NIL) (ARRAY CHAR) ...) equivalent?" -- CSR, 2003-12-10
   (make-negation-type :type type))
 
 (!define-type-method (array :unparse) (type)

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

Modified Files:
	NEWS version.lisp-expr 
Log Message:
0.8.7.28:
	I hate pathnames.
	... fix DIRECTORY on logical pathnames

	WARNING WARNING WARNING

	The fix here is based on a somewhat speculative (but, I believe,
	correct) interpretation of the specification.  At issue is something
	that will probably not be encountered by most users (particularly
	since the only bug report on this issue ever received is, surprise
	surprise, from PFD's test suit) but that causes my eyes to go
	funny every time I think about it.

	If you are in the habit of taking the directory of logical pathnames
	on hosts with multiple translations, you may see different results
	from what you expect.  Please feel free to discuss them.

	Users of DIRECTORY without such bizarre modi operandorum will
	probably either not notice anything, or will suddenly have more
	workingness.  Yay.
	... fix PRINT-OBJECT on LOGICAL-PATHNAMEs (:NAME and :TYPE not
		:FILE and :NAME, and respect *read-eval*/*print-readably*)


Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.471
retrieving revision 1.472
diff -u -d -r1.471 -r1.472
--- NEWS	27 Jan 2004 12:02:43 -0000	1.471
+++ NEWS	28 Jan 2004 22:42:45 -0000	1.472
@@ -2285,6 +2285,7 @@
        FILE-ERROR.
     ** OPEN :DIRECTION :IO no longer fails to work on non-existent
        files.
+    ** DIRECTORY on logical pathnames is more correct.
 
 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.1443
retrieving revision 1.1444
diff -u -d -r1.1443 -r1.1444
--- version.lisp-expr	28 Jan 2004 22:02:05 -0000	1.1443
+++ version.lisp-expr	28 Jan 2004 22:42:45 -0000	1.1444
@@ -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.7.27"
+"0.8.7.28"

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

Modified Files:
	gencgc.c interrupt.c thread.c 
Log Message:
0.8.7.29:
	merged dan_b patches from sbcl-devel 2004-01-22:
		"GC fixes: splay.lisp and SIGSTOP"
		"Another one for the collection [bug 108]"


Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -d -r1.48 -r1.49
--- gencgc.c	23 Jan 2004 16:54:31 -0000	1.48
+++ gencgc.c	29 Jan 2004 04:09:53 -0000	1.49
@@ -2752,7 +2752,7 @@
 	   "/starting one full scan of newspace generation %d\n",
 	   generation));
     for (i = 0; i < last_free_page; i++) {
-	/* note that this skips over open regions when it encounters them */
+	/* Note that this skips over open regions when it encounters them. */
 	if ((page_table[i].allocated & BOXED_PAGE)
 	    && (page_table[i].bytes_used != 0)
 	    && (page_table[i].gen == generation)

Index: interrupt.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.c,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- interrupt.c	20 Dec 2003 12:08:11 -0000	1.53
+++ interrupt.c	29 Jan 2004 04:09:53 -0000	1.54
@@ -544,19 +544,26 @@
     os_context_t *context = arch_os_get_context(&void_context);
     struct thread *thread=arch_os_get_current_thread();
     struct interrupt_data *data=thread->interrupt_data;
-
+    sigset_t ss;
+    int i;
     
     if(maybe_defer_handler(sig_stop_for_gc_handler,data,
-			   signal,info,context)){
+			   signal,info,context)) {
 	return;
     }
     /* need the context stored so it can have registers scavenged */
     fake_foreign_function_call(context); 
 
+    sigemptyset(&ss);
+    for(i=1;i<NSIG;i++) sigaddset(&ss,i); /* Block everything. */
+    sigprocmask(SIG_BLOCK,&ss,0);
+
     get_spinlock(&all_threads_lock,thread->pid);
     thread->state=STATE_STOPPED;
     release_spinlock(&all_threads_lock);
-    kill(thread->pid,SIGSTOP);
+
+    sigemptyset(&ss); sigaddset(&ss,SIG_STOP_FOR_GC);
+    sigwaitinfo(&ss,0);
 
     undo_fake_foreign_function_call(context);
 }

Index: thread.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- thread.c	13 Dec 2003 15:55:56 -0000	1.22
+++ thread.c	29 Jan 2004 04:09:53 -0000	1.23
@@ -347,7 +347,7 @@
     for(p=all_threads;p;p=p->next) {
 	if(p==th) continue;
 	p->state=STATE_RUNNING;
-	kill(p->pid,SIGCONT);
+	kill(p->pid,SIG_STOP_FOR_GC);
     }
     release_spinlock(&all_threads_lock);
 }

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

Modified Files:
	version.lisp-expr NEWS 
Log Message:
0.8.7.21:
	Dan's GC fragmentation fix
	... & BOXED_REGION
	... it builds, builds itself, doesn't break on PFD's tests; 
		that's good enough for me :-)
	... I think I've summarized the "bug fix" right in NEWS, but
		do correct if not.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1436
retrieving revision 1.1437
diff -u -d -r1.1436 -r1.1437
--- version.lisp-expr	20 Jan 2004 18:24:02 -0000	1.1436
+++ version.lisp-expr	23 Jan 2004 16:52:28 -0000	1.1437
@@ -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.7.20"
+"0.8.7.21"

Index: NEWS
===================================================================
RCS file: /cvsroot/sbcl/sbcl/NEWS,v
retrieving revision 1.468
retrieving revision 1.469
diff -u -d -r1.468 -r1.469
--- NEWS	20 Jan 2004 18:24:02 -0000	1.468
+++ NEWS	23 Jan 2004 16:53:54 -0000	1.469
@@ -2237,15 +2237,19 @@
   * bug fix: DECODE-UNIVERSAL-TIME now accepts timezone arguments with
     second-resolution: integer multiples of 1/3600 between -24 and 24.
     (thanks to Vincent Arkesteijn)
+  * bug fix: functions =, /=, <, <=, >, >= did not check the argument
+    type when called with 1 argument; PEEK-CHAR checked type of
+    PEEK-TYPE only after having read first character from a
+    stream.  (reported by Peter Graves)
+  * bug fix: the garbage collector now has much better locality
+    behaviour, and in particular no longer treats all memory as being
+    exhausted when many small objects point to each other in a deeply
+    recursive manner.
   * optimization: implemented multiplication as a modular
     (UNSIGNED-BYTE 32) operation on the x86 backend.
   * optimization: SEARCH on simple-base-strings can now be open-coded.
     (see also contrib/compiler-extras.lisp for inspiration for
     teaching the compiler about the Boyer-Moore algorithm).
-  * bug fix: functions =, /=, <, <=, >, >= did not check the argument
-    type when called with 1 argument; PEEK-CHAR checked type of
-    PEEK-TYPE only after having read first character from a
-    stream. (reported by Peter Graves)
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** in stack analysis liveness information is propagated from
        non-local entry points.

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.7.26:
	* doc/catalogs/catalog-debian.xsl: Update for changes in Debian XML
	packages. Retain old catalog as catalog-debian-old.xsl. FIXME: have
	Makefile automatically select which version of catalog to use on Debian
	based on presence of files in new location.



Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1441
retrieving revision 1.1442
diff -u -d -r1.1441 -r1.1442
--- version.lisp-expr	27 Jan 2004 20:36:07 -0000	1.1441
+++ version.lisp-expr	28 Jan 2004 18:03:02 -0000	1.1442
@@ -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.7.25"
+"0.8.7.26"

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

Modified Files:
	filesys.lisp target-pathname.lisp 
Log Message:
0.8.7.28:
	I hate pathnames.
	... fix DIRECTORY on logical pathnames

	WARNING WARNING WARNING

	The fix here is based on a somewhat speculative (but, I believe,
	correct) interpretation of the specification.  At issue is something
	that will probably not be encountered by most users (particularly
	since the only bug report on this issue ever received is, surprise
	surprise, from PFD's test suit) but that causes my eyes to go
	funny every time I think about it.

	If you are in the habit of taking the directory of logical pathnames
	on hosts with multiple translations, you may see different results
	from what you expect.  Please feel free to discuss them.

	Users of DIRECTORY without such bizarre modi operandorum will
	probably either not notice anything, or will suddenly have more
	workingness.  Yay.
	... fix PRINT-OBJECT on LOGICAL-PATHNAMEs (:NAME and :TYPE not
		:FILE and :NAME, and respect *read-eval*/*print-readably*)


Index: filesys.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/filesys.lisp,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -d -r1.44 -r1.45
--- filesys.lisp	27 Jan 2004 10:34:58 -0000	1.44
+++ filesys.lisp	28 Jan 2004 22:42:46 -0000	1.45
@@ -805,6 +805,148 @@
 
 (/show0 "filesys.lisp 800")
 
+;;; NOTE: There is a fair amount of hair below that is probably not
+;;; strictly necessary.
+;;;
+;;; The issue is the following: what does (DIRECTORY "SYS:*;") mean?
+;;; Until 2004-01, SBCL's behaviour was unquestionably wrong, as it
+;;; did not translate the logical pathname at all, but instead treated
+;;; it as a physical one.  Other Lisps seem to to treat this call as
+;;; equivalent to (DIRECTORY (TRANSLATE-LOGICAL-PATHNAME "SYS:*;")),
+;;; which is fine as far as it goes, but not very interesting, and
+;;; arguably counterintuitive.  (PATHNAME-MATCH-P "SYS:SRC;" "SYS:*;")
+;;; is true, so why should "SYS:SRC;" not show up in the call to
+;;; DIRECTORY?  (assuming the physical pathname corresponding to it
+;;; exists, of course).
+;;;
+;;; So, the interpretation that I am pushing is for all pathnames
+;;; matching the input pathname to be queried.  This means that we
+;;; need to compute the intersection of the input pathname and the
+;;; logical host FROM translations, and then translate the resulting
+;;; pathname using the host to the TO translation; this treatment is
+;;; recursively invoked until we get a physical pathname, whereupon
+;;; our physical DIRECTORY implementation takes over.
+
+;;; FIXME: this is an incomplete implementation.  It only works when
+;;; both are logical pathnames (which is OK, because that's the only
+;;; case when we call it), but there are other pitfalls as well: see
+;;; the DIRECTORY-HELPER below for some, but others include a lack of
+;;; pattern handling.
+(defun pathname-intersections (one two)
+  (aver (logical-pathname-p one))
+  (aver (logical-pathname-p two))
+  (labels
+      ((intersect-version (one two)
+	 (aver (typep one '(or null (member :newest :wild :unspecific)
+			    integer)))
+	 (aver (typep two '(or null (member :newest :wild :unspecific)
+			    integer)))
+	 (cond
+	   ((eq one :wild) two)
+	   ((eq two :wild) one)
+	   ((or (null one) (eq one :unspecific)) two)
+	   ((or (null two) (eq two :unspecific)) one)
+	   ((eql one two) one)
+	   (t nil)))
+       (intersect-name/type (one two)
+	 (aver (typep one '(or null (member :wild :unspecific) string)))
+	 (aver (typep two '(or null (member :wild :unspecific) string)))
+	 (cond
+	   ((eq one :wild) two)
+	   ((eq two :wild) one)
+	   ((or (null one) (eq one :unspecific)) two)
+	   ((or (null two) (eq two :unspecific)) one)
+	   ((string= one two) one)
+	   (t nil)))
+       (intersect-directory (one two)
+	 (aver (typep one '(or null (member :wild :unspecific) list)))
+	 (aver (typep two '(or null (member :wild :unspecific) list)))
+	 (cond
+	   ((eq one :wild) two)
+	   ((eq two :wild) one)
+	   ((or (null one) (eq one :unspecific)) two)
+	   ((or (null two) (eq two :unspecific)) one)
+	   (t (aver (eq (car one) (car two)))
+	      (mapcar
+	       (lambda (x) (cons (car one) x))
+	       (intersect-directory-helper (cdr one) (cdr two)))))))
+    (let ((version (intersect-version
+		    (pathname-version one) (pathname-version two)))
+	  (name (intersect-name/type
+		 (pathname-name one) (pathname-name two)))
+	  (type (intersect-name/type
+		 (pathname-type one) (pathname-type two)))
+	  (host (pathname-host one)))
+      (mapcar (lambda (d)
+		(make-pathname :host host :name name :type type
+			       :version version :directory d))
+	      (intersect-directory
+	       (pathname-directory one) (pathname-directory two))))))
+
+;;; FIXME: written as its own function because I (CSR) don't
+;;; understand it, so helping both debuggability and modularity.  In
+;;; case anyone is motivated to rewrite it, it returns a list of
+;;; sublists representing the intersection of the two input directory
+;;; paths (excluding the initial :ABSOLUTE or :RELATIVE).
+;;;
+;;; FIXME: Does not work with :UP or :BACK
+;;; FIXME: Does not work with patterns
+;;;
+;;; FIXME: PFD suggests replacing this implementation with a DFA
+;;; conversion of a NDFA.  Find out (a) what this means and (b) if it
+;;; turns out to be worth it.
+(defun intersect-directory-helper (one two)
+  (flet ((simple-intersection (cone ctwo)
+	   (cond
+	     ((eq cone :wild) ctwo)
+	     ((eq ctwo :wild) cone)
+	     (t (aver (typep cone 'string))
+		(aver (typep ctwo 'string))
+		(if (string= cone ctwo) cone nil)))))
+    (macrolet
+	((loop-possible-wild-inferiors-matches
+	     (lower-bound bounding-sequence order)
+	   (let ((index (gensym)) (g2 (gensym)) (g3 (gensym)) (l (gensym)))
+	     `(let ((,l (length ,bounding-sequence)))
+	       (loop for ,index from ,lower-bound to ,l
+		append (mapcar (lambda (,g2)
+				 (append
+				  (butlast ,bounding-sequence (- ,l ,index))
+				  ,g2))
+			(mapcar
+			 (lambda (,g3)
+			   (append
+			    (if (eq (car (nthcdr ,index ,bounding-sequence))
+				    :wild-inferiors)
+				'(:wild-inferiors)
+				nil) ,g3))
+			 (intersect-directory-helper
+			  ,@(if order
+				`((nthcdr ,index one) (cdr two))
+				`((cdr one) (nthcdr ,index two)))))))))))
+      (cond
+	((and (eq (car one) :wild-inferiors)
+	      (eq (car two) :wild-inferiors))
+	 (delete-duplicates
+	  (append (mapcar (lambda (x) (cons :wild-inferiors x))
+			  (intersect-directory-helper (cdr one) (cdr two)))
+		  (loop-possible-wild-inferiors-matches 2 one t)
+		  (loop-possible-wild-inferiors-matches 2 two nil))
+	  :test 'equal))
+	((eq (car one) :wild-inferiors)
+	 (delete-duplicates (loop-possible-wild-inferiors-matches 0 two nil)
+			    :test 'equal))
+	((eq (car two) :wild-inferiors)
+	 (delete-duplicates (loop-possible-wild-inferiors-matches 0 one t)
+			    :test 'equal))
+	((and (null one) (null two)) (list nil))
+	((null one) nil)
+	((null two) nil)
+	(t (and (simple-intersection (car one) (car two))
+		(mapcar (lambda (x) (cons (simple-intersection
+					   (car one) (car two)) x))
+			(intersect-directory-helper (cdr one) (cdr two)))))))))
+
 (defun directory (pathname &key)
   #!+sb-doc
   "Return a list of PATHNAMEs, each the TRUENAME of a file that matched the
@@ -817,19 +959,35 @@
 	;; (which can arise when e.g. multiple symlinks map to the
 	;; same truename).
 	(truenames (make-hash-table :test #'equal))
+	;; FIXME: Possibly this MERGE-PATHNAMES call should only
+	;; happen once we get a physical pathname.
         (merged-pathname (merge-pathnames pathname)))
-    (!enumerate-matches (match merged-pathname)
-      (let* ((*ignore-wildcards* t)
-	     ;; FIXME: Why not TRUENAME?  As reported by Milan Zamazal
-	     ;; sbcl-devel 2003-10-05, using TRUENAME causes a race
-	     ;; condition whereby removal of a file during the
-	     ;; directory operation causes an error.  It's not clear
-	     ;; what the right thing to do is, though.  -- CSR,
-	     ;; 2003-10-13
-	     (truename (probe-file match)))
-	(when truename
-	  (setf (gethash (namestring truename) truenames)
-		truename))))
+    (labels ((do-physical-directory (pathname)
+	       (aver (not (logical-pathname-p pathname)))
+	       (!enumerate-matches (match pathname)
+		 (let* ((*ignore-wildcards* t)
+			;; FIXME: Why not TRUENAME?  As reported by
+			;; Milan Zamazal sbcl-devel 2003-10-05, using
+			;; TRUENAME causes a race condition whereby
+			;; removal of a file during the directory
+			;; operation causes an error.  It's not clear
+			;; what the right thing to do is, though.  --
+			;; CSR, 2003-10-13
+			(truename (probe-file match)))
+		   (when truename
+		     (setf (gethash (namestring truename) truenames)
+			   truename)))))
+	     (do-directory (pathname)
+	       (if (logical-pathname-p pathname)
+		   (let ((host (intern-logical-host (pathname-host pathname))))
+		     (dolist (x (logical-host-canon-transls host))
+		       (destructuring-bind (from to) x
+			 (let ((intersections
+				(pathname-intersections pathname from)))
+			   (dolist (p intersections)
+			     (do-directory (translate-pathname p from to)))))))
+		   (do-physical-directory pathname))))
+      (do-directory merged-pathname))
     (mapcar #'cdr
 	    ;; Sorting isn't required by the ANSI spec, but sorting
 	    ;; into some canonical order seems good just on the

Index: target-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-pathname.lisp,v
retrieving revision 1.41
retrieving revision 1.42
diff -u -d -r1.41 -r1.42
--- target-pathname.lisp	28 Jan 2004 22:02:05 -0000	1.41
+++ target-pathname.lisp	28 Jan 2004 22:42:46 -0000	1.42
@@ -68,12 +68,12 @@
 (def!method print-object ((pathname logical-pathname) stream)
   (let ((namestring (handler-case (namestring pathname)
 		      (error nil))))
-    (if namestring
+    (if (and namestring (or *read-eval* (not *print-readably*)))
 	(format stream "#.(CL:LOGICAL-PATHNAME ~S)" namestring)
 	(print-unreadable-object (pathname stream :type t)
 	  (format
 	   stream
-	   "~_:HOST ~S ~_:DIRECTORY ~S ~_:FILE ~S ~_:NAME ~S ~_:VERSION ~S"
+	   "~_:HOST ~S ~_:DIRECTORY ~S ~_:NAME ~S ~_:TYPE ~S ~_:VERSION ~S"
 	   (%pathname-host pathname)
 	   (%pathname-directory pathname)
 	   (%pathname-name pathname)

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.7.27:
	src/code/target-pathname.lisp: Patch from Christophe Rhodes for unparsing
	logical pathnames


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1442
retrieving revision 1.1443
diff -u -d -r1.1442 -r1.1443
--- version.lisp-expr	28 Jan 2004 18:03:02 -0000	1.1442
+++ version.lisp-expr	28 Jan 2004 22:02:05 -0000	1.1443
@@ -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.7.26"
+"0.8.7.27"

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

Modified Files:
	target-pathname.lisp 
Log Message:
0.8.7.27:
	src/code/target-pathname.lisp: Patch from Christophe Rhodes for unparsing
	logical pathnames


Index: target-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-pathname.lisp,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -d -r1.40 -r1.41
--- target-pathname.lisp	27 Jan 2004 14:24:06 -0000	1.40
+++ target-pathname.lisp	28 Jan 2004 22:02:05 -0000	1.41
@@ -1399,6 +1399,7 @@
 
 (defun unparse-logical-piece (thing)
   (etypecase thing
+    ((member :wild) "*")
     (simple-string thing)
     (pattern
      (collect ((strings))

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

Modified Files:
	catalog-debian.xml 
Added Files:
	catalog-debian-old.xml 
Log Message:
0.8.7.26:
	* doc/catalogs/catalog-debian.xsl: Update for changes in Debian XML
	packages. Retain old catalog as catalog-debian-old.xsl. FIXME: have
	Makefile automatically select which version of catalog to use on Debian
	based on presence of files in new location.



--- NEW FILE: catalog-debian-old.xml ---
<?xml version="1.0" encoding="iso-8859-1"?>
<!DOCTYPE catalog
   PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
   "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">

<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">

  <!-- The directory DTD and stylesheet files are installed under -->
  <group  xml:base="file:///usr/share/sgml/docbook/" >

    <!-- Resolve DTD URL system ID to local file -->
    <rewriteSystem
        systemIdStartString="http://www.oasis-open.org/docbook/xml/4.1/"
        rewritePrefix="dtd/xml/4.1/" />
    <!-- Resolve stylesheet URL to local file -->
    <rewriteURI
        uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
        rewritePrefix="stylesheet/xsl/nwalsh/" />

    <!-- Resolve DTD PUBLIC identifiers -->
    <nextCatalog  catalog="dtd/xml/4.1/catalog.xml" />

    <!-- To resolve simple DTD SYSTEM identifiers. -->
    <!-- Note: this does not work with Java resolver -->
    <!--   classes in Saxon or Xalan -->
    <system
         systemId="docbook.dtd"
         uri="dtd/xml/4.1/xml/docbookx.dtd" />

    <!-- To resolve short stylesheet references -->
    <uri
        name="docbook_html.xsl"
        uri="stylesheet/xsl/nwalsh/xhtml/docbook.xsl" />
    <uri 
        name="docbook_chunk.xsl"
        uri="stylesheet/xsl/nwalsh/xhtml/chunk.xsl" />
    <uri
        name="docbook_fo.xsl"
        uri="stylesheet/xsl/nwalsh/fo/docbook.xsl" />

  </group>

</catalog>

Index: catalog-debian.xml
===================================================================
RCS file: /cvsroot/sbcl/sbcl/doc/catalogs/catalog-debian.xml,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- catalog-debian.xml	5 Dec 2003 11:06:05 -0000	1.1
+++ catalog-debian.xml	28 Jan 2004 18:03:08 -0000	1.2
@@ -6,7 +6,8 @@
 <catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
 
   <!-- The directory DTD and stylesheet files are installed under -->
-  <group  xml:base="file:///usr/share/sgml/docbook/" >
+  <!-- Older Deb: <group  xml:base="file:///usr/share/sgml/docbook/" > -->
+  <group  xml:base="file:///usr/share/xml/docbook/" >
 
     <!-- Resolve DTD URL system ID to local file -->
     <rewriteSystem
@@ -15,7 +16,7 @@
     <!-- Resolve stylesheet URL to local file -->
     <rewriteURI
         uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
-        rewritePrefix="stylesheet/xsl/nwalsh/" />
+        rewritePrefix="stylesheet/nwalsh/" />
 
     <!-- Resolve DTD PUBLIC identifiers -->
     <nextCatalog  catalog="dtd/xml/4.1/catalog.xml" />
@@ -30,13 +31,13 @@
     <!-- To resolve short stylesheet references -->
     <uri
         name="docbook_html.xsl"
-        uri="stylesheet/xsl/nwalsh/xhtml/docbook.xsl" />
+        uri="stylesheet/nwalsh/xhtml/docbook.xsl" />
     <uri 
         name="docbook_chunk.xsl"
-        uri="stylesheet/xsl/nwalsh/xhtml/chunk.xsl" />
+        uri="stylesheet/nwalsh/xhtml/chunk.xsl" />
     <uri
         name="docbook_fo.xsl"
-        uri="stylesheet/xsl/nwalsh/fo/docbook.xsl" />
+        uri="stylesheet/nwalsh/fo/docbook.xsl" />
 
   </group>

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

Modified Files:
	pathnames.impure.lisp 
Log Message:
0.8.7.24:
	More pathname fun, *sigh*
	... make logical pathnames respect print/read consistency (version
		*is* significant for them)
	... adjust the pathname tests so that they test equality rather
		than namestring equality, but minus version testing
		because that's too complicated right now.


Index: pathnames.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/pathnames.impure.lisp,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- pathnames.impure.lisp	27 Jan 2004 10:34:59 -0000	1.19
+++ pathnames.impure.lisp	27 Jan 2004 14:24:06 -0000	1.20
@@ -264,8 +264,13 @@
 
         ;; FIXME: test version handling in LPNs
         )
-      do (assert (string= (namestring (apply #'merge-pathnames params))
-                          (namestring expected-result))))
+      do (let ((result (apply #'merge-pathnames params)))
+	   (macrolet ((frob (op)
+			`(assert (equal (,op result) (,op expected-result)))))
+	     (frob pathname-host)
+	     (frob pathname-directory)
+	     (frob pathname-name)
+	     (frob pathname-type))))
 
 ;;; host-namestring testing
 (assert (string=
@@ -293,5 +298,21 @@
 (assert (raises-error? (merge-pathnames (make-string-output-stream))
 		       type-error))
 
+;;; ensure read/print consistency (or print-not-readable-error) on
+;;; pathnames:
+(let ((pathnames (list
+		  (make-pathname :name "foo" :type "txt" :version :newest)
+		  (make-pathname :name "foo" :type "txt" :version 1)
+		  (make-pathname :name "foo" :type ".txt")
+		  (make-pathname :name "foo." :type "txt")
+		  (parse-namestring "SCRATCH:FOO.TXT.1")
+		  (parse-namestring "SCRATCH:FOO.TXT.NEWEST")
+		  (parse-namestring "SCRATCH:FOO.TXT"))))
+  (dolist (p pathnames)
+    (handler-case
+	(let ((*print-readably* t))
+	  (assert (equal (read-from-string (format nil "~S" p)) p)))
+      (print-not-readable () nil))))
+
 ;;;; success
 (quit :unix-status 104)

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

Modified Files:
	pathname.lisp target-pathname.lisp 
Log Message:
0.8.7.24:
	More pathname fun, *sigh*
	... make logical pathnames respect print/read consistency (version
		*is* significant for them)
	... adjust the pathname tests so that they test equality rather
		than namestring equality, but minus version testing
		because that's too complicated right now.


Index: pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/pathname.lisp,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- pathname.lisp	5 May 2003 14:09:08 -0000	1.14
+++ pathname.lisp	27 Jan 2004 14:24:06 -0000	1.15
@@ -37,7 +37,7 @@
 			(lambda (x)
 			  (logical-host-name (%pathname-host x))))
 		       (unparse-directory #'unparse-logical-directory)
-		       (unparse-file #'unparse-unix-file)
+		       (unparse-file #'unparse-logical-file)
 		       (unparse-enough #'unparse-enough-namestring)
 		       (customary-case :upper)))
   (name "" :type simple-base-string)

Index: target-pathname.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/target-pathname.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- target-pathname.lisp	27 Jan 2004 10:34:59 -0000	1.39
+++ target-pathname.lisp	27 Jan 2004 14:24:06 -0000	1.40
@@ -1413,6 +1413,36 @@
 		  (t (error "invalid keyword: ~S" piece))))))
        (apply #'concatenate 'simple-string (strings))))))
 
+(defun unparse-logical-file (pathname)
+  (declare (type pathname pathname))
+    (collect ((strings))
+    (let* ((name (%pathname-name pathname))
+	   (type (%pathname-type pathname))
+	   (version (%pathname-version pathname))
+	   (type-supplied (not (or (null type) (eq type :unspecific))))
+	   (version-supplied (not (or (null version)
+				      (eq version :unspecific)))))
+      (when name
+	(when (and (null type) (position #\. name :start 1))
+	  (error "too many dots in the name: ~S" pathname))
+	(strings (unparse-logical-piece name)))
+      (when type-supplied
+	(unless name
+	  (error "cannot specify the type without a file: ~S" pathname))
+	(when (typep type 'simple-base-string)
+	  (when (position #\. type)
+	    (error "type component can't have a #\. inside: ~S" pathname)))
+	(strings ".")
+	(strings (unparse-logical-piece type)))
+      (when version-supplied
+	(unless type-supplied
+	  (error "cannot specify the version without a type: ~S" pathname))
+	(etypecase version
+	  ((member :newest) (strings ".NEWEST"))
+	  ((member :wild) (strings ".*"))
+	  (fixnum (strings ".") (strings (format nil "~D" version))))))
+    (apply #'concatenate 'simple-string (strings))))
+
 ;;; Unparse a logical pathname string.
 (defun unparse-enough-namestring (pathname defaults)
   (let* ((path-directory (pathname-directory pathname))
@@ -1449,7 +1479,7 @@
   (concatenate 'simple-string
 	       (logical-host-name (%pathname-host pathname)) ":"
 	       (unparse-logical-directory pathname)
-	       (unparse-unix-file pathname)))
+	       (unparse-logical-file pathname)))
 
 ;;;; logical pathname translations

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.7.24:
	More pathname fun, *sigh*
	... make logical pathnames respect print/read consistency (version
		*is* significant for them)
	... adjust the pathname tests so that they test equality rather
		than namestring equality, but minus version testing
		because that's too complicated right now.


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1439
retrieving revision 1.1440
diff -u -d -r1.1439 -r1.1440
--- version.lisp-expr	27 Jan 2004 12:02:44 -0000	1.1439
+++ version.lisp-expr	27 Jan 2004 14:23:57 -0000	1.1440
@@ -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.7.23"
+"0.8.7.24"

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

Modified Files:
	version.lisp-expr 
Log Message:
0.8.7.25:
	* contrib/sb-aclrepl/repl.lisp: Use *command-char* when printing
	help message


Index: version.lisp-expr
===================================================================
RCS file: /cvsroot/sbcl/sbcl/version.lisp-expr,v
retrieving revision 1.1440
retrieving revision 1.1441
diff -u -d -r1.1440 -r1.1441
--- version.lisp-expr	27 Jan 2004 14:23:57 -0000	1.1440
+++ version.lisp-expr	27 Jan 2004 20:36:07 -0000	1.1441
@@ -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.7.24"
+"0.8.7.25"

Update of /cvsroot/sbcl/sbcl/contrib/sb-aclrepl
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17499/contrib/sb-aclrepl

Modified Files:
	repl.lisp 
Log Message:
0.8.7.25:
	* contrib/sb-aclrepl/repl.lisp: Use *command-char* when printing
	help message


Index: repl.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/repl.lisp,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- repl.lisp	20 Jan 2004 18:10:23 -0000	1.23
+++ repl.lisp	27 Jan 2004 20:36:12 -0000	1.24
@@ -811,7 +811,7 @@
 	((eq (user-cmd-func user-cmd) :cmd-error)
 	 (format *output* "Unknown top-level command: ~s.~%"
 		 (user-cmd-input user-cmd))
-	 (format *output* "Type `:help' for the list of commands.~%")
+	 (format *output* "Type `~Ahelp' for the list of commands.~%" *command-char*)
 	 t)
 	((eq (user-cmd-func user-cmd) :history-error)
 	 (format *output* "Input numbered ~d is not on the history list~%"

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

Modified Files:
	fd-stream.lisp 
Log Message:
0.8.7.23:
	Fix some OPEN tests
	... :DIRECTION :IO didn't work if the file didn't exist, despite
		default being :CREATE
	... adjust filesys test to cope with new disallowed
		:WILD-INFERIORS :UP
	... we still fail some OPEN tests in PFD's suite: some are because
		of not supporting (unsigned-byte 33) streams, while the
		rest are because DIRECTORY is broken on logical pathnames,
		*sigh*


Index: fd-stream.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/code/fd-stream.lisp,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -d -r1.42 -r1.43
--- fd-stream.lisp	27 Jan 2004 10:34:58 -0000	1.42
+++ fd-stream.lisp	27 Jan 2004 12:02:46 -0000	1.43
@@ -1106,6 +1106,8 @@
 	   (namestring
 	    (cond ((unix-namestring pathname input))
 		  ((and input (eq if-does-not-exist :create))
+		   (unix-namestring pathname nil))
+		  ((and (eq direction :io) (not if-does-not-exist-given))
 		   (unix-namestring pathname nil)))))
       ;; Process if-exists argument if we are doing any output.
       (cond (output

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

Modified Files:
	filesys.test.sh stream.impure.lisp 
Log Message:
0.8.7.23:
	Fix some OPEN tests
	... :DIRECTION :IO didn't work if the file didn't exist, despite
		default being :CREATE
	... adjust filesys test to cope with new disallowed
		:WILD-INFERIORS :UP
	... we still fail some OPEN tests in PFD's suite: some are because
		of not supporting (unsigned-byte 33) streams, while the
		rest are because DIRECTORY is broken on logical pathnames,
		*sigh*


Index: filesys.test.sh
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/filesys.test.sh,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- filesys.test.sh	4 Dec 2002 15:23:03 -0000	1.8
+++ filesys.test.sh	27 Jan 2004 12:02:46 -0000	1.9
@@ -177,11 +177,13 @@
     (need-match "animal/vertebrate/**/*.*" vertebrates)
     (need-match "animal/vertebrate/mammal/../**/*.*" vertebrates)
     (need-match "animal/vertebrate/mammal/../**/**/*.*" vertebrates)
+    #+nil
     (need-match "animal/vertebrate/mammal/mythical/../**/../**/*.*"
 		vertebrates))
   (need-match "animal/vertebrate/**/robot.*" nil)
   (need-match "animal/vertebrate/mammal/../**/*.robot" nil)
   (need-match "animal/vertebrate/mammal/../**/robot/*.*" nil)
+  #+nil
   (need-match "animal/vertebrate/mammal/robot/../**/../**/*.*" nil))
 (need-matches)
 (sb-ext:quit :unix-status 52)

Index: stream.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/stream.impure.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- stream.impure.lisp	29 Nov 2003 11:25:32 -0000	1.8
+++ stream.impure.lisp	27 Jan 2004 12:02:46 -0000	1.9
@@ -93,5 +93,16 @@
   (with-open-file (s p)
     (assert (string= (read-line s) "THESE INSERTMBOLS")))
   (delete-file p))
+
+;;; :DIRECTION :IO didn't work on non-existent pathnames
+(let ((p "direction-io-test"))
+  (ignore-errors (delete-file p))
+  (with-open-file (s p :direction :io)
+    (format s "1")
+    (finish-output s)
+    (file-position s :start)
+    (assert (char= (read-char s) #\1)))
+  (delete-file p))
+
 ;;; success
 (quit :unix-status 104)

Update of /cvsroot/sbcl/sbcl/contrib/sb-simple-streams
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20507/contrib/sb-simple-streams

Modified Files:
	internal.lisp 
Log Message:
0.8.7.23:
	Fix some OPEN tests
	... :DIRECTION :IO didn't work if the file didn't exist, despite
		default being :CREATE
	... adjust filesys test to cope with new disallowed
		:WILD-INFERIORS :UP
	... we still fail some OPEN tests in PFD's suite: some are because
		of not supporting (unsigned-byte 33) streams, while the
		rest are because DIRECTORY is broken on logical pathnames,
		*sigh*


Index: internal.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-simple-streams/internal.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- internal.lisp	27 Jan 2004 10:34:58 -0000	1.7
+++ internal.lisp	27 Jan 2004 12:02:46 -0000	1.8
@@ -473,6 +473,8 @@
     (declare (type sb-int:index mask))
     (let ((name (cond ((sb-int:unix-namestring pathname input))
 		      ((and input (eq if-does-not-exist :create))
+		       (sb-int:unix-namestring pathname nil))
+		      ((and (eq direction :io) (not if-does-not-exist-given))
 		       (sb-int:unix-namestring pathname nil)))))
       ;; Process if-exists argument if we are doing any output.
       (cond (output