X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-ir2tran.lisp;h=09d6a82a8350321d0c36972f39979d11ac4fccb4;hb=5dcf5905dc38232b3cc5ec6b309ea5c6424db957;hp=0125c4a38387196cd823cceb993348e471d8c65e;hpb=d76c81b0ca4dcfc99f0cd805f5c20493fa80b2b6;p=sbcl.git diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 0125c4a..09d6a82 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -10,27 +10,27 @@ (in-package "SB!C") (defoptimizer ir2-convert-reffer ((object) node block name offset lowtag) - (let* ((cont (node-cont node)) - (locs (continuation-result-tns cont + (let* ((lvar (node-lvar node)) + (locs (lvar-result-tns lvar (list *backend-t-primitive-type*))) (res (first locs))) - (vop slot node block (continuation-tn node block object) + (vop slot node block (lvar-tn node block object) name offset lowtag res) - (move-continuation-result node block locs cont))) + (move-lvar-result node block locs lvar))) (defoptimizer ir2-convert-setter ((object value) node block name offset lowtag) - (let ((value-tn (continuation-tn node block value))) - (vop set-slot node block (continuation-tn node block object) value-tn + (let ((value-tn (lvar-tn node block value))) + (vop set-slot node block (lvar-tn node block object) value-tn name offset lowtag) - (move-continuation-result node block (list value-tn) (node-cont node)))) + (move-lvar-result node block (list value-tn) (node-lvar node)))) ;;; FIXME: Isn't there a name for this which looks less like a typo? ;;; (The name IR2-CONVERT-SETTER is used for something else, just above.) (defoptimizer ir2-convert-setfer ((value object) node block name offset lowtag) - (let ((value-tn (continuation-tn node block value))) - (vop set-slot node block (continuation-tn node block object) value-tn + (let ((value-tn (lvar-tn node block value))) + (vop set-slot node block (lvar-tn node block object) value-tn name offset lowtag) - (move-continuation-result node block (list value-tn) (node-cont node)))) + (move-lvar-result node block (list value-tn) (node-lvar node)))) (defun do-inits (node block name result lowtag inits args) (let ((unbound-marker-tn nil)) @@ -41,7 +41,7 @@ (ecase kind (:arg (aver args) - (continuation-tn node block (pop args))) + (lvar-tn node block (pop args))) (:unbound (or unbound-marker-tn (setf unbound-marker-tn @@ -60,40 +60,40 @@ (defoptimizer ir2-convert-fixed-allocation ((&rest args) node block name words type lowtag inits) - (let* ((cont (node-cont node)) - (locs (continuation-result-tns cont + (let* ((lvar (node-lvar node)) + (locs (lvar-result-tns lvar (list *backend-t-primitive-type*))) (result (first locs))) (do-fixed-alloc node block name words type lowtag result) (do-inits node block name result lowtag inits args) - (move-continuation-result node block locs cont))) + (move-lvar-result node block locs lvar))) (defoptimizer ir2-convert-variable-allocation ((extra &rest args) node block name words type lowtag inits) - (let* ((cont (node-cont node)) - (locs (continuation-result-tns cont + (let* ((lvar (node-lvar node)) + (locs (lvar-result-tns lvar (list *backend-t-primitive-type*))) (result (first locs))) - (if (constant-continuation-p extra) - (let ((words (+ (continuation-value extra) words))) + (if (constant-lvar-p extra) + (let ((words (+ (lvar-value extra) words))) (do-fixed-alloc node block name words type lowtag result)) - (vop var-alloc node block (continuation-tn node block extra) name words + (vop var-alloc node block (lvar-tn node block extra) name words type lowtag result)) (do-inits node block name result lowtag inits args) - (move-continuation-result node block locs cont))) + (move-lvar-result node block locs lvar))) -;;; KLUDGE: this is set up automatically in #!-SB-THREAD builds by the -;;; :SET-TRANS thing in objdef.lisp. However, for #!+SB-THREAD builds -;;; we need to use a special VOP, so we have to do this by hand. -;;; -- CSR, 2003-05-08 -#!+sb-thread +;;; :SET-TRANS (in objdef.lisp DEFINE-PRIMITIVE-OBJECT) doesn't quite +;;; cut it for symbols, where under certain compilation options +;;; (e.g. #!+SB-THREAD) we have to do something complicated, rather +;;; than simply set the slot. So we build the IR2 converting function +;;; by hand. -- CSR, 2003-05-08 (let ((fun-info (fun-info-or-lose '%set-symbol-value))) (setf (fun-info-ir2-convert fun-info) (lambda (node block) (let ((args (basic-combination-args node))) (destructuring-bind (symbol value) args - (let ((value-tn (continuation-tn node block value))) + (let ((value-tn (lvar-tn node block value))) (vop set node block - (continuation-tn node block symbol) value-tn) - (move-continuation-result - node block (list value-tn) (node-cont node)))))))) + (lvar-tn node block symbol) value-tn) + (move-lvar-result + node block (list value-tn) (node-lvar node))))))))