X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-ir2tran.lisp;h=1ca4e97a6a7df0020a6ca51e7f96eeba1ffa3051;hb=f1ffbf976aaa50b7b22f126b97e34afe06a91210;hp=5cbeb85e3aab8bcef52c7effddd385acfa15076a;hpb=21c2b080d512e218485a3969b773bea62a50b73d;p=sbcl.git diff --git a/src/compiler/generic/vm-ir2tran.lisp b/src/compiler/generic/vm-ir2tran.lisp index 5cbeb85..1ca4e97 100644 --- a/src/compiler/generic/vm-ir2tran.lisp +++ b/src/compiler/generic/vm-ir2tran.lisp @@ -10,77 +10,77 @@ (in-package "SB!C") (defoptimizer ir2-convert-reffer ((object) node block name offset lowtag) - (let* ((cont (node-cont node)) - (locs (continuation-result-tns cont - (list *backend-t-primitive-type*))) - (res (first locs))) - (vop slot node block (continuation-tn node block object) - name offset lowtag res) - (move-continuation-result node block locs cont))) + (let* ((lvar (node-lvar node)) + (locs (lvar-result-tns lvar + (list *backend-t-primitive-type*))) + (res (first locs))) + (vop slot node block (lvar-tn node block object) + name offset lowtag res) + (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 - name offset lowtag) - (move-continuation-result node block (list value-tn) (node-cont node)))) + (let ((value-tn (lvar-tn node block value))) + (vop set-slot node block (lvar-tn node block object) value-tn + name offset lowtag) + (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 - name offset lowtag) - (move-continuation-result node block (list value-tn) (node-cont node)))) + (let ((value-tn (lvar-tn node block value))) + (vop set-slot node block (lvar-tn node block object) value-tn + name offset lowtag) + (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)) (dolist (init inits) (let ((kind (car init)) - (slot (cdr init))) - (vop set-slot node block result - (ecase kind - (:arg - (aver args) - (continuation-tn node block (pop args))) - (:unbound - (or unbound-marker-tn - (setf unbound-marker-tn - (let ((tn (make-restricted-tn - nil - (sc-number-or-lose 'sb!vm::any-reg)))) - (vop make-unbound-marker node block tn) - tn)))) - (:null - (emit-constant nil))) - name slot lowtag)))) + (slot (cdr init))) + (vop set-slot node block result + (ecase kind + (:arg + (aver args) + (lvar-tn node block (pop args))) + (:unbound + (or unbound-marker-tn + (setf unbound-marker-tn + (let ((tn (make-restricted-tn + nil + (sc-number-or-lose 'sb!vm::any-reg)))) + (vop make-unbound-marker node block tn) + tn)))) + (:null + (emit-constant nil))) + name slot lowtag)))) (aver (null args))) (defun do-fixed-alloc (node block name words type lowtag result) (vop fixed-alloc node block name words type lowtag result)) (defoptimizer ir2-convert-fixed-allocation - ((&rest args) node block name words type lowtag inits) - (let* ((cont (node-cont node)) - (locs (continuation-result-tns cont - (list *backend-t-primitive-type*))) - (result (first locs))) + ((&rest args) node block name words type lowtag inits) + (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 - (list *backend-t-primitive-type*))) - (result (first locs))) - (if (constant-continuation-p extra) - (let ((words (+ (continuation-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 - type lowtag result)) + ((extra &rest args) node block name words type lowtag inits) + (let* ((lvar (node-lvar node)) + (locs (lvar-result-tns lvar + (list *backend-t-primitive-type*))) + (result (first locs))) + (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 (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))) ;;; :SET-TRANS (in objdef.lisp DEFINE-PRIMITIVE-OBJECT) doesn't quite ;;; cut it for symbols, where under certain compilation options @@ -89,11 +89,11 @@ ;;; 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))) - (vop set node block - (continuation-tn node block symbol) value-tn) - (move-continuation-result - node block (list value-tn) (node-cont node)))))))) + (lambda (node block) + (let ((args (basic-combination-args node))) + (destructuring-bind (symbol value) args + (let ((value-tn (lvar-tn node block value))) + (vop set node block + (lvar-tn node block symbol) value-tn) + (move-lvar-result + node block (list value-tn) (node-lvar node))))))))