+;;; FIXME: this is the interface of the CMUCL WITH-DYNAMIC-EXTENT
+;;; macro. It is slightly confusing, in that START and BODY-START are
+;;; already-existing CTRANs (and FIXME: probably deserve a ONCE-ONLY),
+;;; whereas NEXT is a variable naming a CTRAN in the body. -- CSR,
+;;; 2004-03-30.
+(defmacro with-dynamic-extent ((start body-start next kind) &body body)
+ (declare (ignore kind))
+ (with-unique-names (cleanup next-ctran)
+ `(progn
+ (ctran-starts-block ,body-start)
+ (let ((,cleanup (make-cleanup :kind :dynamic-extent))
+ (,next-ctran (make-ctran))
+ (,next (make-ctran)))
+ (ir1-convert ,start ,next-ctran nil '(%dynamic-extent-start))
+ (setf (cleanup-mess-up ,cleanup) (ctran-use ,next-ctran))
+ (let ((*lexenv* (make-lexenv :cleanup ,cleanup)))
+ (ir1-convert ,next-ctran ,next nil '(%cleanup-point))
+ (locally ,@body))))))
+