From badfaf41ec743d363abe237e79bc305ee3128295 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Tue, 21 Jul 1992 17:29:50 +0000
Subject: [PATCH] Added checking for potentially TR local calls with different
 tail sets.  Added BARF restart which allows conditional ignoring of
 particular error messages.

---
 compiler/debug.lisp | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/compiler/debug.lisp b/compiler/debug.lisp
index 7449663ec..d7ca48a6e 100644
--- a/compiler/debug.lisp
+++ b/compiler/debug.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug.lisp,v 1.21 1992/06/09 06:57:36 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/debug.lisp,v 1.23 1992/07/21 17:38:54 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -25,6 +25,8 @@
   "This variable is bound to the format arguments when an error is signalled
   by Barf or Burp.")
 
+(defvar *ignored-errors* (make-hash-table :test #'equal))
+
 ;;; Barf  --  Interface
 ;;;
 ;;;    A definite inconsistency has been detected.  Signal an error with
@@ -32,7 +34,14 @@
 ;;;
 (proclaim '(function barf (string &rest t) void))
 (defun barf (string &rest *args*)
-  (apply #'cerror "Skip this error." string *args*))
+  (unless (gethash string *ignored-errors*)
+    (restart-case
+	(apply #'error string *args*)
+      (continue ()
+	:report "Ignore this error.")
+      (ignore-all ()
+	:report "Ignore this and all future occurrences of this error."
+	(setf (gethash string *ignored-errors*) t)))))
 
 (defvar *burp-action* :warn
   "Action taken by the Burp function when a possible compiler bug is detected.
@@ -555,7 +564,15 @@
 			       (basic-combination-fun node)))))
 	   (when (leaf-refs (elt (lambda-vars fun)
 				 (position arg (basic-combination-args node))))
-	     (barf "Flushed arg for referenced var in ~S." node)))))))
+	     (barf "Flushed arg for referenced var in ~S." node))))))
+
+     (let ((dest (continuation-dest (node-cont node))))
+       (when (and (return-p dest)
+		  (eq (basic-combination-kind node) :local)
+		  (not (eq (lambda-tail-set (combination-lambda node))
+			   (lambda-tail-set (return-lambda dest)))))
+	 (barf "Tail local call to function with different tail set:~%  ~S"
+	       node))))
     (cif
      (check-dest (if-test node) node)
      (unless (eq (block-last (node-block node)) node)
-- 
GitLab