;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 130.4
;;; Reason:
;;;  Redefine two callers to ZL:DUMP-FORMS-TO-FILE after package lossage.
;;; Written 14-Nov-88 15:37:17 by keith at site Gigamos Cambridge
;;; while running on Tonic from band 4
;;; with Experimental System 130.2, Experimental ZWEI 128.1, Experimental ZMail 75.0, Experimental Local-File 77.0, Experimental File-Server 26.0, Experimental Unix-Interface 16.0, Experimental Tape 27.0, Experimental Lambda-Diag 19.0, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 102, 11/11.



; From file DJ: L.SYS; QCFILE.LISP#384 at 14-Nov-88 15:37:17
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFILE  "

(defun write-compilation-environment (compilation-environment pathname &aux pvals mvals)
  ;;(print-comp-env compilation-environment)
  (maphash #'(lambda (k v) (push (cons k v) pvals))
	   (compilation-environment-plist-hashtab compilation-environment))
  (maphash #'(lambda (k v) (push (cons k v) mvals))
	   (compilation-environment-macro-hashtab compilation-environment))
  ;; rebind target while writing FENV so it gets written for the right machine.  ||| 28sep88 smh
  (let ((*target-computer* 'lambda-interface))
    (zl:dump-forms-to-file
      (fs:merge-pathname-components pathname nil :default-type :FDEF)
      `((load-to-compilation-environment-internal
	  ',(compilation-environment-target compilation-environment)
	  ',pvals
	  ',mvals))
      `(:package ,(package-name *package*)
		 :readtable ,(car (si:rdtbl-names *readtable*))))))

))

; From file DJ: L.SYS; QCFASD.LISP#273 at 14-Nov-88 15:39:54
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCFASD  "

(DEFUN FASD-FONT (FONT-SYMBOL)
  "Write the font FONT into a QFASL file named SYS: FONTS; name-of-font QFASL."
  (DUMP-FORMS-TO-FILE (FS:MAKE-PATHNAME ':HOST "SYS"
					':DIRECTORY "FONTS"
					':NAME (SYMBOL-NAME FONT-SYMBOL))
		      `((proclaim (special ,font-symbol))
			(SETQ ,FONT-SYMBOL ,(TV::FONT-EVALUATE FONT-SYMBOL)))
		      '(:PACKAGE :FONTS)))

))