;;; -*- Mode:LISP; Package:SYSTEM-INTERNALS; Base:8; Readtable:ZL -*-

(defun quoted-args-p (fef)
  (let ((args-info (args-info fef)))
    (or (ldb-test %%arg-desc-quoted-rest args-info)
	(ldb-test %%arg-desc-fef-quote-hair args-info))))

(defun find-functions-with-quoted-args (&aux result)
  (gc:without-flipping
    (gc:reclaim-oldspace)
    (for-every-region-in-area (region macro-compiled-program)
      (cond ((zerop (%region-free-pointer region)))
	    (t
	     (do ((adr (%make-pointer dtp-locative (%region-origin region))
		       (%make-pointer-offset dtp-locative adr (%structure-total-size adr))))
		 (())
	       (loop while (and (= (%p-data-type adr) dtp-header)
				(= (%p-ldb %%header-type-field adr) %header-type-list))
		     do (if (<= (%pointer-difference (%region-free-pointer region) adr) 2)
			    
			    (setq adr (%make-pointer-offset dtp-locative adr 1))
			  

	
	

      (let ((start-adr (%make-pointer dtp-locative (%region-origin region))))
	(loop while (and (= (%p-data-type start-adr) dtp-header)
			 (= (%p-ldb %%header-type-field start-adr) %header-type-list))
	      when (>= start-adr (%region-length region)) do (ferror nil "bad region")
	      do (setq start-adr (%make-pointer-offset dtp-locative start-adr 1)))
	(do ((adr start-adr (%make-pointer-offset dtp-locative adr (%sturcture-total-size adr)))
	     (obj (%find-structure-header