;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.71
;;; Reason:
;;;  Patch 124.63 caused bit arrays created by the reader via #*10101... to have
;;;  fill pointers.
;;; Written 17-Jun-88 18:44:41 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Cthulhu from band 1
;;; with Experimental System 124.65, Experimental Local-File 74.2, Experimental File-Server 23.1, Experimental Unix-Interface 12.0, Experimental ZMail 72.0, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, microcode 1760, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.IO; READ.LISP#462 at 17-Jun-88 18:45:11
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; READ  "

(defun xr-#*-macro (stream ignore &optional length)
  (if *read-suppress*
      (progn (internal-read stream t nil t) nil)
    (do ((bit-vector (make-array (or length 32.) :element-type 'bit :fill-pointer 0))
	 elt)
	(())
      (multiple-value-bind (char index actual) (xr-xrtyi stream nil t)
	(case char
	  ((#/0 #/1)
	   (setq elt (if (= char #/0) 0 1))
	   (cond ((null length)
		  (vector-push-extend elt bit-vector))
		 ((vector-push elt bit-vector))
		 (t (read-error
		      "Number of data bits exceeds specified length in /"#*/" bit vector construct.")
		    (vector-push-extend elt bit-vector)
		    (setq length nil))))
	  (t
	   (xr-xruntyi stream actual index)
	   (if (and length (plusp length) (zerop (fill-pointer bit-vector)))
	       (read-error "The construct #~D* is illegal; at least one bit must be given."
			   length))
	   (if length
	       ;; VECTOR-PUSH returns NIL when the fill pointer is at the end of the array.
	       (do () ((vector-push elt bit-vector))))
	   (return (values (make-array (length bit-vector) :element-type 'bit :initial-contents bit-vector)))))))))

))
