;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*-
;;; Patch file for System version 121.29
;;; Reason:
;;;  Fix bug in FSIGNAL and other minor fixups in error handler.
;;; Written 11-Feb-87 16:15:43 by rg at site LMI Cambridge
;;; while running on Curley from band 2
;;; with Experimental System 121.22, Experimental Lambda-Diag 15.0, Experimental ZMail 70.2, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, Experimental DOE-Macsyma 22.0, microcode 1741, SDU Boot Tape 3.14, SDU ROM 103.



; From modified file DJ: L.DEBUGGER; EHF.LISP#291 at 11-Feb-87 16:15:44
#8R EH#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "EH")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: DEBUGGER; EHF  "

(defun fsignal (format-string &rest args)
  (declare (error-reporter))
  (check-type format-string string)
  (apply 'cerror "Simply proceed." format-string args))

))

; From modified file DJ: L.DEBUGGER; EHF.LISP#291 at 11-Feb-87 19:04:49
#8R EH#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "EH")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: DEBUGGER; EHF  "

(defun make-condition (signal-name &rest args)
  "Create a condition object using flavor or signal name SIGNAL-NAME.
If SIGNAL-NAME is a signal name defined with DEFSIGNAL or DEFSIGNAL-EXPLICIT,
the ARGS are interpreted according to what was specified in the definition.

If SIGNAL-NAME is a flavor name, the ARGS are init options to pass to MAKE-INSTANCE."
  (if (typep signal-name 'instance)
      signal-name
    (apply (cond ((and (not (stringp signal-name))
		       (get signal-name 'make-condition-function)))
		 ((and (not (stringp signal-name))
		       (get signal-name 'si:flavor) #'make-instance))
		 (t #'make-condition-default))
	   signal-name args)))

(defvar *make-condition-default-restrictive* NIL)

;Nothing reasonable will happen if format-string is not present, but
; at least it will not bomb out internal to the system on a wrong number of args.
(defun make-condition-default (signal-name &optional format-string &rest args)
  (declare (dbg:error-reporter))
  (COND (*make-condition-default-restrictive*
	 (ferror "~S is not a known condition flavor or signal name"
		 signal-name))
	('else
	 (make-instance 'ferror
			:condition-names (list signal-name)
			:format-string format-string
			:format-args (copy-list args)))))
))