-;;; Give an IR2-Environment structure to Fun. We make the TNs which hold
-;;; environment values and the old-FP/return-PC.
-(defun assign-ir2-environment (fun)
- (declare (type clambda fun))
- (let ((env (lambda-environment fun)))
- (collect ((env))
- (dolist (thing (environment-closure env))
- (let ((ptype (etypecase thing
- (lambda-var
- (if (lambda-var-indirect thing)
- *backend-t-primitive-type*
- (primitive-type (leaf-type thing))))
- (nlx-info *backend-t-primitive-type*))))
- (env (cons thing (make-normal-tn ptype)))))
-
- (let ((res (make-ir2-environment
- :environment (env)
- :return-pc-pass (make-return-pc-passing-location
- (external-entry-point-p fun)))))
- (setf (environment-info env) res)
- (setf (ir2-environment-old-fp res)
- (make-old-fp-save-location env))
- (setf (ir2-environment-return-pc res)
- (make-return-pc-save-location env)))))
+;;; Give CLAMBDA an IR2-PHYSENV structure. (And in order to
+;;; properly initialize the new structure, we make the TNs which hold
+;;; environment values and the old-FP/return-PC.)
+(defun assign-ir2-physenv (clambda)
+ (declare (type clambda clambda))
+ (let ((lambda-physenv (lambda-physenv clambda))
+ (reversed-ir2-physenv-alist nil))
+ ;; FIXME: should be MAPCAR, not DOLIST
+ (dolist (thing (physenv-closure lambda-physenv))
+ (let ((ptype (etypecase thing
+ (lambda-var
+ (if (lambda-var-indirect thing)
+ *backend-t-primitive-type*
+ (primitive-type (leaf-type thing))))
+ (nlx-info *backend-t-primitive-type*)
+ (clambda *backend-t-primitive-type*))))
+ (push (cons thing (make-normal-tn ptype))
+ reversed-ir2-physenv-alist)))
+
+ (let ((res (make-ir2-physenv
+ :closure (nreverse reversed-ir2-physenv-alist)
+ :return-pc-pass (make-return-pc-passing-location
+ (xep-p clambda)))))
+ (setf (physenv-info lambda-physenv) res)
+ (setf (ir2-physenv-old-fp res)
+ (make-old-fp-save-location lambda-physenv))
+ (setf (ir2-physenv-return-pc res)
+ (make-return-pc-save-location lambda-physenv))))