;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 126.59
;;; Reason:
;;;  Improved compiler internal error messages.
;;; Written 22-Aug-88 11:08:15 by smh (Steve Haflich) at site Gigamos Cambridge
;;; while running on Harpo from band 3
;;; with Experimental System 126.51, ZWEI 125.16, 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; QCDEFS.LISP#247 at 22-Aug-88 11:09:09
#8R COMPILER#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "COMPILER")))
  (PATCH-SOURCE-FILE "SYS: SYS; QCDEFS  "


(defun print-open-frame (open-frame stream level)
  (ignore level)
  (printing-random-object (open-frame stream :type)
    (format stream "~A~:[ (Unfinished)~]~:[~; (Tail-called)~]~:[~; ~A~A~]"
	    (open-frame-open-instruction open-frame)
	    (open-frame-there-p open-frame)
	    (open-frame-tail-p open-frame)
	    (or (open-frame-pdest open-frame)
		(open-frame-idest open-frame))
	    (or (open-frame-pdest open-frame) "??")
	    (or (open-frame-idest open-frame) "??"))))

;;; Use this macro when we do something which creates an open frame.
;;; The cleanup-body is queued up to be run when we're finished with
;;; the open frame.  It may be run many times, in the presence of
;;; conditional branching or returning.

))

; From modified file DJ: L.SYS; QCDEFS.LISP#247 at 22-Aug-88 11:09:13
#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"))
	(original-dest (gensymbol "ORIGINAL-DESTINATION"))
	(new-frame-symbol (gensymbol "NEW-FRAME")))
    `(let* ((,original-open *open-frames*)
	    (,original-dest ,dest)
	    (,new-frame-symbol ,new-frame)
	    (,dest (or ,new-frame-symbol ,dest)))
       (multiple-value-prog1
	 (progn (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*)
		       (eq *open-frames* ,original-open))
	     (fsignal "Internal error: frame botch in OPENING-FRAMES: ~s ~s" *open-frames* ,original-open)
	     (clean-up-open-frames ,original-open nil ,dest)))))))

;;; Call this when doing a "temporary" discard of excess stack.
;;; For example, when generating a branch or return.
;;; Note that this adjusts the frame level *before* running the body.
;;; Do not call P2 from within!

))