diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index d938adcff3ed6a94078a6be516dbc3e30674b8cc..b391713a723a23cdf0c43c2b5143b72a3fa16445 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.53 1993/05/19 08:41:36 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.54 1993/08/19 23:14:36 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -176,7 +176,21 @@ (let ((fdefn-tn (make-load-time-constant-tn :fdefinition name))) (if unsafe (vop fdefn-function node block fdefn-tn res) - (vop safe-fdefn-function node block fdefn-tn res)))))))) + (vop safe-fdefn-function node block fdefn-tn res))))))) + (dylan-var + (let* ((arg (standard-argument-location 0)) + (res (standard-argument-location 0)) + (value (make-load-time-constant-tn + :dylan-varinfo-value + (cons name (dylan-var-module-name leaf)))) + (fun (make-load-time-constant-tn :fdefinition + 'dylan::value-datum)) + (fp (make-stack-pointer-tn))) + (emit-move node block value arg) + (vop allocate-full-call-frame node block 1 fp) + (vop* call-named node block (fp fun arg nil) (res nil) (list arg) + 1 1) + (move-continuation-result node block (list res) (node-cont node))))) (move-continuation-result node block locs cont)) (undefined-value)) @@ -252,7 +266,25 @@ (ecase (global-var-kind leaf) ((:special :global) (assert (symbolp (leaf-name leaf))) - (vop set node block (emit-constant (leaf-name leaf)) val))))) + (vop set node block (emit-constant (leaf-name leaf)) val)))) + (dylan-var + (let* ((val-arg (standard-argument-location 0)) + (value-arg (standard-argument-location 1)) + (res (standard-argument-location 0)) + (value (make-load-time-constant-tn + :dylan-varinfo-value + (cons (dylan-var-name leaf) + (dylan-var-module-name leaf)))) + (fun (make-load-time-constant-tn :fdefinition + '(setf dylan::value-datum))) + (fp (make-stack-pointer-tn))) + (emit-move node block val val-arg) + (emit-move node block value value-arg) + (vop allocate-full-call-frame node block 2 fp) + (vop* call-named node block (fp fun val-arg value-arg nil) (res nil) + (list val-arg value-arg) + 2 1) + (move-continuation-result node block (list res) (node-cont node))))) (when locs (emit-move node block val (first locs))