diff --git a/ansi-tests/random-int-form.lsp b/ansi-tests/random-int-form.lsp
index 93ad0b6b8701fd4ff41a00ebbb4fff5bf6801efc..504b8103cc404a86f85acf4ac3303ffd8bf5439c 100644
--- a/ansi-tests/random-int-form.lsp
+++ b/ansi-tests/random-int-form.lsp
@@ -33,15 +33,19 @@
 ;;;
 
 (declaim (special *optimized-fn-src* *unoptimized-fn-src* *int-form-vals*
-		  *opt-result* *unopt-result* $x $y $z))
+		  *opt-result* *unopt-result* $x $y $z
+		  *compile-unoptimized-form*))
 
 (defun f (i) (let ((plist (elt $y i)))
 	       (apply (compile nil (getf plist :optimized-lambda-form))
 		      (getf plist :vals))))
 
 (defun g (i) (let ((plist (elt $y i)))
-	       (apply (compile nil (getf plist :unoptimized-lambda-form))
-		      (getf plist :vals))))
+	       (if *compile-unoptimized-form*
+		   (apply (compile nil (getf plist :unoptimized-lambda-form))
+			  (getf plist :vals))
+		 (apply (eval `(function ,(getf plist :unoptimized-lambda-form)))
+			(getf plist :vals)))))
 
 (defun loop-random-int-forms (&optional (size 200) (nvars 3))
   (unless (boundp '$x) (setq $x nil))
@@ -60,6 +64,7 @@
      (terpri))))
 
 (defvar *random-int-form-blocks* nil)
+(defvar *random-int-form-catch-tags* nil)
 
 (defvar *maximum-random-int-bits* 45)
 
@@ -117,7 +122,9 @@
 	 (form (let ((*vars* (loop for v in vars
 				   for tp in var-types
 				   collect (make-var-desc :name v
-							  :type tp))))
+							  :type tp)))
+		     (*random-int-form-blocks* nil)
+		     (*random-int-form-catch-tags* nil))
 		 (make-random-integer-form size)))
 	 (vals-list
 	  (loop repeat 20
@@ -241,12 +248,13 @@
      (4
       (let ((arg (let ((*flet-names* nil)
 		       (*vars* nil)
-		       (*random-int-form-blocks* nil))
+		       (*random-int-form-blocks* nil)
+		       (*random-int-form-catch-tags* nil))
 		   (make-random-integer-form (1- size)))))
 	(rcase
 	 (2 `(load-time-value ,arg t))
 	 (1 `(load-time-value ,arg))
-	 (1 `(load-time-value ,arg nil)))))	     
+	 (1 `(load-time-value ,arg nil)))))
 
      #-(or cmu allegro)
      (2
@@ -335,10 +343,17 @@
 	     (2 `(multiple-value-bind (,var) ,e1 ,e2)))))))
      
      (4 `(let () ,(make-random-integer-form (1- size))))
+
      (10
       (let* ((name (random-from-seq #(b1 b2 b3 b4 b5 b6 b7 b8)))
 	     (*random-int-form-blocks* (adjoin name *random-int-form-blocks*)))
 	`(block ,name ,(make-random-integer-form (1- size)))))
+
+     (20
+      (let* ((tag (list 'quote (random-from-seq #(ct1 ct2 ct2 ct4 ct5 ct6 ct7 ct8))))
+	     (*random-int-form-catch-tags* (cons tag *random-int-form-catch-tags*)))
+	`(catch ,tag ,(make-random-integer-form (1- size)))))
+     
      (4 ;; setq
       (if *vars*
 	  (let* ((vdesc (random-from-seq *vars*))
@@ -364,6 +379,14 @@
 	;; No blocks -- try again
 	(make-random-integer-form size)))
 
+     (20
+      (if *random-int-form-catch-tags*
+	  (let ((tag (random-from-seq *random-int-form-catch-tags*))
+		(form (make-random-integer-form (1- size))))
+	    `(throw ,tag ,form))
+	;; No catch tags -- try again
+	(make-random-integer-form size)))
+
      (5
       (if *random-int-form-blocks*
 	  (destructuring-bind (s1 s2 s3) (random-partition (1- size) 3)
@@ -415,7 +438,9 @@
 	(make-random-integer-form size)
       (let* ((op (random-from-seq #(flet labels)))
 	     (minargs (random 4))
-	     (maxargs (rcase
+	     (maxargs #+:allegro minargs
+		      #-:allegro
+		      (rcase
 		       (1 minargs)
 		       (1 (+ minargs (random 4)))))
 	     (arg-names (loop for i from 1 to maxargs
@@ -598,7 +623,7 @@
      #+cmu (declare (optimize (extensions:inhibit-warnings 3)))
      (declare (optimize (safety 3)))
      (declare (optimize (speed 0)))
-     (declare (optimize (debug 0)))
+     (declare (optimize (debug 3)))
      ,form))
 
 (defvar *compile-using-defun*
@@ -752,18 +777,20 @@
   (when (gethash form *prune-table*)
     (return-from prune nil))
   (flet ((try (x) (funcall try-fn x)))
-    (when (consp form)
+    (cond
+     ((keywordp form) nil)
+     ((integerp form)
+      (unless (zerop form) (try 0)))
+     ((consp form)
       (let* ((op (car form))
 	     (args (cdr form))
 	     (nargs (length args)))
 	(case op
 	 
 	 ((signum integer-length logcount
-		  gcd lcm logandc1 logandc2 lognand lognor logorc1 logorc2
+		  logandc1 logandc2 lognand lognor logorc1 logorc2
 		  realpart imagpart)
 	  (mapc #'try args)
-	  (try 0)
-	  (try -1)
 	  (prune-fn form try-fn))
 	 
 	 ((abs 1+ 1- identity values progn prog1 multiple-value-prog1 unwind-protect
@@ -773,7 +800,7 @@
 
 	 ((typep)
 	  (try (car args))
-	  (prune (cadr args)
+	  (prune (car args)
 		 #'(lambda (form) `(,op ,form ,@(cdr args)))))
 
 	 ((load-time-value)
@@ -799,10 +826,20 @@
 	  (when (every #'constantp args)
 	    (try (eval form)))
 	  (mapc try-fn args)
+	  (prune-fn form try-fn)
+	  (try t)
+	  (try nil))
+
+	 ((and or = < > <= >= /=)
+	  (when (every #'constantp args)
+	    (try (eval form)))
+	  (try t)
+	  (try nil)
+	  (mapc try-fn args)
+	  (prune-nary-fn form try-fn)
 	  (prune-fn form try-fn))
 	 
-	 ((- + * min max logand logior logxor logeqv
-	     and or = < > <= >= /=)
+	 ((- + * min max logand logior logxor logeqv gcd lcm)
 	  (when (every #'constantp args)
 	    (try (eval form)))
 	  (mapc try-fn args)
@@ -913,6 +950,38 @@
 		       #'(lambda (x)
 			   (try `(block ,name ,x))))))))
 
+	 ((catch)
+	  (let* ((tag (second form))
+		 (name (if (consp tag) (cadr tag) tag))
+		 (body (cddr form)))
+	    (when (and body (null (cdr body)))
+	      (let ((form1 (first body)))
+
+		;; Try removing the catch entirely if it is not in use
+		;; We make assumptions here about what throws can
+		;; be present.
+		(when (or (not (find-in-tree 'throw body))
+			  (not (find-in-tree name body)))
+		  (try form1))
+		
+		;; Try removing the block if its only use is an immediately
+		;; enclosed return-from: (block <n> (return-from <n> <e>))
+		(when (and (consp form1)
+			   (eq (first form1) 'throw)
+			   (equal (second form1) name)
+			   (not (find-in-tree name (third form1))))
+		  (try (third form1)))
+		
+		;; Otherwise, try to simplify the subexpression
+		(prune form1
+		       #'(lambda (x)
+			   (try `(catch ,tag ,x))))))))
+
+	 ((throw)
+	  (try (second args))
+	  (prune (second args)
+		 #'(lambda (x) (try `(throw ,(first args) ,x)))))
+
 	 ((flet labels)
 	  (prune-flet form try-fn))
 
@@ -988,7 +1057,7 @@
 	    (prune-list fn-args
 			#'prune
 			#'(lambda (args)
-			    (funcall try-fn `(funcall ,fn ,@args))))))
+			    (try `(funcall ,fn ,@args))))))
 
 	 ((apply)
 	  (let ((fn (second form))
@@ -1001,18 +1070,19 @@
 	    (prune-list fn-args
 			#'prune
 			#'(lambda (args)
-			    (funcall try-fn `(apply ,fn ,@args ,list-arg))))
+			    (try `(apply ,fn ,@args ,list-arg))))
 	    (when (and (consp list-arg)
 		       (eq (car list-arg) 'list))
+	      (try `(apply ,fn ,@fn-args ,@(cdr list-arg) nil))
 	      (prune-list (cdr list-arg)
 			#'prune
 			#'(lambda (args)
-			    (funcall try-fn `(apply ,fn ,@fn-args
-						    (list ,@args))))))))
+			    (try `(apply ,fn ,@fn-args
+					 (list ,@args))))))))
 	 
 	 (otherwise
 	  (prune-fn form try-fn))
-	 ))))
+	 )))))
   (setf (gethash form *prune-table*) t)
   nil)