;;; -*- 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))))))))) ))