(DEFUN SAME-FRINGE-SETUP NIL 
	(SETQ GEN1 (MAKE-STACK-GROUP 'GEN1 'SI:REGULAR-PDL-SIZE 5000))
	(SETQ GEN2 (MAKE-STACK-GROUP 'GEN2 'SI:REGULAR-PDL-SIZE 5000)))

(DEFUN SAME-FRINGE (A B)
  (PROG (END-TEST TEM)
	(SETQ END-TEST '(EXHAUSTED))
	(STACK-GROUP-PRESET GEN1 (FUNCTION GETTER) A END-TEST)
	(STACK-GROUP-PRESET GEN2 (FUNCTION GETTER) B END-TEST)
  L	(SETQ TEM (FUNCALL GEN1))
	(COND ((NOT (EQ TEM (FUNCALL GEN2)))
		(SETQ TEM NIL)
		(GO X))
	      ((NOT (EQ TEM END-TEST))
		(GO L)))
	(SETQ TEM T)
  X	(RETURN TEM)))

(DEFUN GETTER (L END-TEST)
  (PROG NIL 
     L	(COND ((NULL L) (RETURN END-TEST))
	      ((ATOM (CAR L)) 
		(PRINT (LIST SI:%CURRENT-STACK-GROUP (CAR L)))
		(STACK-GROUP-RETURN (CAR L)))
	      (T (GETTER (CAR L) END-TEST)))
	(SETQ L (CDR L))
	(GO L)))