;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.73
;;; Reason:
;;;  Revised OPENING-FRAMES macro (affects cross compiler only).
;;; Written 8-Sep-88 16:28:22 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.68, ZWEI 125.20, 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, K30aug.



; From file DJ: L.SYS; QCDEFS.LISP#254 at 8-Sep-88 16:28:39
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCDEFS  "

(defmacro opening-frames ((dest new-frame) &body body)
  (let ((original-open (gensymbol "ORIGINAL-OPEN-FRAMES"))
	#+ignore (original-dest (gensymbol "ORIGINAL-DESTINATION"))
	(new-frame-symbol (gensymbol "NEW-FRAME")))
    `(let* ((,original-open *open-frames*)
	    #+ignore (,original-dest ,dest)
	    (,new-frame-symbol ,new-frame)
	    (,dest (or ,new-frame-symbol ,dest)))
       (multiple-value-prog1
	 (progn
	   ;; This must be done by frame creator `at the right time' to make p2sbind work. - smh 8sep88
	   #+ignore (when ,new-frame-symbol
		      (setf (open-frame-idest ,new-frame-symbol) ,original-dest)
		      (add-frame ,new-frame-symbol))
	   ,@body)
	 (when ,new-frame-symbol
	   (unless (or (not *dropthru*)				;Why this exclusion?  Is it safe?
		       (eq *open-frames* ,original-open))
	     ;; This is actually a normal occurence if no form is in position to return
	     ;; a value for the new frame.  Check this winner out:  -smh 30aug88
	     ;;(defun strange ()
	     ;;  (LET ((foo T))  ; No form returns a value to this frame!
	     ;;    (declare (special foo))
	     ;;    (block gnarg
	     ;;      (let ()
	     ;;        )))
	     ;;  3)
	     #+ignore (fsignal "Internal error: frame botch in OPENING-FRAMES: ~s ~s" *open-frames* ,original-open)
	     (clean-up-open-frames ,original-open nil ,dest)))))))

))