From 097529bb958c914faf66036f2fda87f244fff0ab Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Mon, 1 Mar 1993 18:25:16 +0000 Subject: [PATCH] Spin VOP MAKE-VALUE-CELL off into a sub-function & add an event counter for each creation. --- compiler/ir2tran.lisp | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index d19d42480..5a9e62cea 100644 --- a/compiler/ir2tran.lisp +++ b/compiler/ir2tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.46 1993/02/26 08:38:47 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.47 1993/03/01 18:25:16 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -68,6 +68,16 @@ (emit-move-template node block (type-check-template type) value result) (undefined-value)) +;;; MAKE-VALUE-CELL -- Internal +;;; +;;; Allocate an indirect value cell. Maybe do some clever stack allocation +;;; someday. +;;; +(defevent make-value-cell "Allocate heap value cell for lexical var.") +(defun make-value-cell (node block value res) + (event make-value-cell node) + (vop make-value-cell node block value res)) + ;;;; Leaf reference: @@ -685,7 +695,7 @@ (let ((src (continuation-tn node block arg)) (dest (leaf-info var))) (if (lambda-var-indirect var) - (vop make-value-cell node block src dest) + (make-value-cell node block src dest) (emit-move node block src dest))))) (lambda-vars fun) (basic-combination-args node)) (undefined-value)) @@ -724,7 +734,7 @@ ((lambda-var-indirect var) (let ((temp (make-normal-tn (backend-any-primitive-type *backend*)))) - (vop make-value-cell node block actual temp) + (make-value-cell node block actual temp) (temps temp))) ((member actual (locs)) (let ((temp (make-normal-tn (tn-primitive-type loc)))) @@ -1118,7 +1128,7 @@ (let ((pass (standard-argument-location n)) (home (leaf-info arg))) (if (lambda-var-indirect arg) - (vop make-value-cell node block pass home) + (make-value-cell node block pass home) (emit-move node block pass home)))) (incf n)))) @@ -1249,7 +1259,7 @@ (when (leaf-refs var) (let ((dest (leaf-info var))) (if (lambda-var-indirect var) - (vop make-value-cell node block src dest) + (make-value-cell node block src dest) (emit-move node block src dest))))) (continuation-tns node block cont (mapcar #'(lambda (x) @@ -1475,7 +1485,7 @@ (ecase kind ((:block :tagbody) - (vop make-value-cell node block res (ir2-nlx-info-home 2info))) + (make-value-cell node block res (ir2-nlx-info-home 2info))) (:unwind-protect (vop set-unwind-protect node block block-tn)) (:catch))) -- GitLab