;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 124.127
;;; Reason:
;;;  SI:MAKE-DMA-BUFFER was working by accident.  Discovered as a problem
;;;  running TAPE software.
;;;  
;;;  This is the only occurrence in the SYSTEM system I can find that was
;;;  making the mistaken assumption that an array's named-structure-symbol
;;;  was by default stored in the array leader.  (See the recent patch to
;;;  MAKE-ARRAY.)
;;;  
;;;  Solution: wherever you want the NAMED-STRUCTURE-SYMBOL stored in the
;;;  array leader, specify a postive :LEADER-LENGTH also.
;;; Written 5-Jul-88 21:40:54 by keith at site Gigamos Cambridge
;;; while running on Breaking Glass from band 1
;;; with Experimental System 124.124, Experimental Local-File 74.3, Experimental File-Server 23.1, Unix-Interface 12.0, Experimental ZMail 72.1, Experimental Tape 23.6, Experimental Lambda-Diag 16.2, Tiger 28.0, microcode 1761, SDU Boot Tape 3.14, SDU ROM 103, Beta 3 plus patches.



; From modified file DJ: L.IO; NEW-DISK.LISP#56 at 5-Jul-88 21:40:55
#8R SYSTEM-INTERNALS#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: IO; NEW-DISK  "

(defun make-dma-buffer (ignore n-pages)
  (let ((dma-buffer (make-wireable-array n-pages
					 'art-32b
					 'dma-buffer)))
    (setf (dma-buffer-16b dma-buffer)
	  (make-array (* n-pages page-size 2)
		      :type :art-16b
		      :displaced-to dma-buffer
		      :leader-length 2
		      :named-structure-symbol 'dma-buffer-16b))
    (setf (dma-buffer-8b dma-buffer)
	  (make-array (* n-pages page-size 4)
		      :type :art-8b
		      :displaced-to dma-buffer
		      :leader-length 2
		      :named-structure-symbol 'dma-buffer-8b))
    (setf (dma-buffer-string dma-buffer)
	  (make-array (* n-pages page-size 4)
		      :type :art-string
		      :displaced-to dma-buffer
		      :leader-length 2
		      :named-structure-symbol 'dma-buffer-string))
    ;;
    (setf (dma-buffer-size-in-pages dma-buffer) n-pages)
    (setf (dma-buffer-data-vadr dma-buffer)
	  (%pointer-plus dma-buffer (array-data-offset dma-buffer)))
    dma-buffer))

))