;;; -*- Mode:LISP; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.16
;;; Reason:
;;;  Added *FASD-INDIRECT-ARRAY* in preparation for further cross-compilation changes.
;;; Written 8-Aug-88 16:48:36 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.15, ZWEI 125.11, ZMail 73.2, Local-File 75.2, File-Server 24.1, Unix-Interface 13.0, Tape 24.2, Lambda-Diag 17.0, microcode 1762, SDU Boot Tape 3.12, SDU ROM 102, kold 4aug88.



; From modified file DJ: L.SYS; QCFASD.LISP#261 at 8-Aug-88 16:49:58
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFASD  "


(defvar *fasd-indirect-array* nil
  "Bind to an indirect array if we use an 8-bit output stream")

))

; From modified file DJ: L.SYS; QCFASD.LISP#261 at 8-Aug-88 16:50:09
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFASD  "

(defmacro with-open-fasd-file ((stream-variable filename &optional attribute-list) &body body)
  "Open filename and bind stream-variable to a fasd-stream.
No output operations should be performed on the fasd-stream except as a side-affect of
invoking dump-forms-to-fasd-stream."
  (once-only (attribute-list)
    `(with-open-stream (,stream-variable (open-fasd-file ,filename))
       (let ((fasd-stream ,stream-variable))
	 (with-fasd-indirect-array (,stream-variable)
	   (let ((fasd-package nil))		;in case fasd-attributes-list bashes it
	     (locking-resources
	       (fasd-initialize)
	       (fasd-start-file)
	       (fasd-attributes-list
		 (if (getl (locf ,attribute-list) '(:package))
		     ,attribute-list
		   (list* ':package ':user ,attribute-list)))
	       ,@body
	       (fasd-end-whack)
	       (fasd-end-file))))))))

))

; From modified file DJ: L.SYS; QCFASD.LISP#261 at 8-Aug-88 16:50:11
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFASD  "


(defmacro with-fasd-indirect-array ((stream) &body body)
  `(let ((*fasd-indirect-array* (ecase (send ,stream :get :byte-size)
				  (8. (make-array 4096 :element-type '(unsigned-byte 8) :displaced-to "" 
						  :displaced-index-offset 0.))
				  (16. nil))))
     ,@body))


;; Copied from LAD: RELEASE-3.SYS; QCFASD.LISP#258 on 2-Oct-86 05:07:34

))