;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.64
;;; Reason:
;;;  (array-initialize), which is called by (make-array) did the wrong thing for zero
;;;  dimensional arrays.
;;; Written 16-Jun-88 12:59:58 by pld (Peter L. DeWolf) at site Gigamos Cambridge
;;; while running on Azathoth from band 1
;;; with Experimental System 124.63, 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 1759, SDU Boot Tape 3.14, SDU ROM 8, the old ones.



; From modified file DJ: L.SYS; QRAND.LISP#497 at 16-Jun-88 12:59:58
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: SYS; QRAND  "

(DEFUN ARRAY-INITIALIZE (ORIGINAL-ARRAY VALUE &OPTIONAL (START 0) END
			 &AUX (ARRAY ORIGINAL-ARRAY) (UNFORWARDED-ARRAY ORIGINAL-ARRAY)
			 (OFFSET 0))
  "Set all the elements of ARRAY to VALUE, or all elements from START to END.
If END is NIL or not specified, the active length of ARRAY is used."
  (OR END (SETQ END (LENGTH ARRAY)))
  (ASSERT ( 0 START END (ARRAY-LENGTH ARRAY)) (START END)
	  "START is ~S and END is ~S, for ~S." START END ARRAY)
  (cond ((zerop (array-rank array))
	 (setf (aref array) value))
	((< END (+ START 30.))
	 ;; If number of elements to be hacked is small, just do them.
	 (DO ((I START (1+ I))) (( I END))
	   (SETF (AR-1-FORCE ARRAY I) VALUE)))
	(t
	 ;; Handle indirect arrays by finding the array indirected to
	 ;; and updating the start and end indices if appropriate.
	 (DO () ((NOT (ARRAY-INDIRECT-P ARRAY)))
	   (AND (ARRAY-INDEX-OFFSET ARRAY)
		(INCF OFFSET (ARRAY-INDEX-OFFSET ARRAY)))
	   (SETQ ARRAY (ARRAY-INDIRECT-TO ARRAY)))
	 ;; Handle forwarded arrays.
	 (UNLESS (= (%P-DATA-TYPE ARRAY) DTP-ARRAY-HEADER)
	   (SETQ ARRAY (FOLLOW-STRUCTURE-FORWARDING ARRAY)))
	 (UNLESS (= (%P-DATA-TYPE UNFORWARDED-ARRAY) DTP-ARRAY-HEADER)
	   (SETQ UNFORWARDED-ARRAY (FOLLOW-STRUCTURE-FORWARDING UNFORWARDED-ARRAY)))
	 (LET* ((ENTRIES-PER-Q (ARRAY-ELEMENTS-PER-Q (%P-LDB %%ARRAY-TYPE-FIELD UNFORWARDED-ARRAY)))
		(BITS-PER-ELEMENT (ARRAY-BITS-PER-ELEMENT (%P-LDB %%ARRAY-TYPE-FIELD UNFORWARDED-ARRAY)))
		(START (+ START OFFSET))
		(END (+ END OFFSET))
		(DATA-OFFSET (ARRAY-DATA-OFFSET ARRAY))
		;; Compute how many words are in the repeating unit that we replicate with %BLT.
		;; This is 1 word unless an element is bigger than that.
		(BLT-DISTANCE (IF (PLUSP ENTRIES-PER-Q) 1 (- ENTRIES-PER-Q)))
		;; This is how many elements it takes to make BLT-DISTANCE words.
		(Q-BOUNDARY-ELTS (MAX 1 ENTRIES-PER-Q))
		;; We must deposit element by element until this element
		;; in order to make sure we have a full word of elements stored
		;; Beyond this, we can blt entire words.
		(STOP-ELEMENT-BY-ELEMENT
		  (MIN END
		       (* Q-BOUNDARY-ELTS
			  (1+ (CEILING START Q-BOUNDARY-ELTS)))))
		;; We must stop our word-wise copying before this element number
		;; to avoid clobbering any following elements which are beyond END.
		(END-WORD-WISE
		  (MAX START (* Q-BOUNDARY-ELTS (FLOOR END Q-BOUNDARY-ELTS))))
		;; Compute index in words, wrt array data, of the first data word
		;; that we will not fill up an element at a time.
		(UNINITIALIZED-DATA-OFFSET
		  (+ DATA-OFFSET
		     (* BLT-DISTANCE (CEILING STOP-ELEMENT-BY-ELEMENT Q-BOUNDARY-ELTS))))
		;; Compute the length of the data in the array, in Qs, if caller didn't supply it.
		(DATA-LENGTH
		  (IF (PLUSP ENTRIES-PER-Q)
		      (TRUNCATE END-WORD-WISE ENTRIES-PER-Q)
		    (* END-WORD-WISE (- ENTRIES-PER-Q)))))
	   ;; Fill in any elements in an incomplete first word,
	   ;; plus one full word's worth.
	   ;; We must use the original array to store element by element,
	   ;; since the element size of the array indirected to may be different.
	   (DO ((I START (1+ I)))
	       ((= I STOP-ELEMENT-BY-ELEMENT))
	     (SETF (AR-1-FORCE ORIGINAL-ARRAY (- I OFFSET)) VALUE))
	   ;; Now fill in the elements in the incomplete last word.
	   (DO ((I END-WORD-WISE (1+ I)))
	       (( I END))
	     (SETF (AR-1-FORCE ORIGINAL-ARRAY (- I OFFSET)) VALUE))
	   ;; Now copy the data word by word (or by two words for ART-FLOAT!)
	   ;; There is no hope of passing %BLT pointers that are GC-safe.
	   (IF (PLUSP (- DATA-LENGTH (- UNINITIALIZED-DATA-OFFSET DATA-OFFSET)))
	       (WITHOUT-INTERRUPTS
		 ;; If the array is displaced to a random location, use that location
		 ;; as the data start.  Arrays displaced to other arrays
		 ;; were handled above.
		 (IF (ARRAY-DISPLACED-P ARRAY)
		     (SETQ ARRAY (- (%POINTER (ARRAY-INDIRECT-TO ARRAY)) DATA-OFFSET)))
		 (IF BITS-PER-ELEMENT
		     ;; Numeric array.
		     (%BLT (%MAKE-POINTER-OFFSET DTP-LOCATIVE
						 ARRAY (- UNINITIALIZED-DATA-OFFSET BLT-DISTANCE))
			   (%MAKE-POINTER-OFFSET DTP-LOCATIVE
						 ARRAY UNINITIALIZED-DATA-OFFSET)
			   (- DATA-LENGTH (- UNINITIALIZED-DATA-OFFSET DATA-OFFSET))
			   1)
		   (%BLT-TYPED (%MAKE-POINTER-OFFSET DTP-LOCATIVE
						     ARRAY (- UNINITIALIZED-DATA-OFFSET BLT-DISTANCE))
			       (%MAKE-POINTER-OFFSET DTP-LOCATIVE
						     ARRAY UNINITIALIZED-DATA-OFFSET)
			       (- DATA-LENGTH (- UNINITIALIZED-DATA-OFFSET DATA-OFFSET))
			       1)))))))
  ORIGINAL-ARRAY)

))