1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
12 (defoptimizer ir2-convert-reffer ((object) node block name offset lowtag)
13 (let* ((cont (node-cont node))
14 (locs (continuation-result-tns cont
15 (list *backend-t-primitive-type*)))
17 (vop slot node block (continuation-tn node block object)
18 name offset lowtag res)
19 (move-continuation-result node block locs cont)))
21 (defoptimizer ir2-convert-setter ((object value) node block name offset lowtag)
22 (let ((value-tn (continuation-tn node block value)))
23 (vop set-slot node block (continuation-tn node block object) value-tn
25 (move-continuation-result node block (list value-tn) (node-cont node))))
27 (defoptimizer ir2-convert-setfer ((value object) node block name offset lowtag)
28 (let ((value-tn (continuation-tn node block value)))
29 (vop set-slot node block (continuation-tn node block object) value-tn
31 (move-continuation-result node block (list value-tn) (node-cont node))))
33 (defun do-inits (node block name result lowtag inits args)
34 (let ((unbound-marker-tn nil))
36 (let ((kind (car init))
38 (vop set-slot node block result
42 (continuation-tn node block (pop args)))
45 (setf unbound-marker-tn
46 (let ((tn (make-restricted-tn
48 (sc-number-or-lose 'sb!vm::any-reg))))
49 (vop make-unbound-marker node block tn)
56 (defun do-fixed-alloc (node block name words type lowtag result)
57 (vop fixed-alloc node block name words type lowtag result))
59 (defoptimizer ir2-convert-fixed-allocation
60 ((&rest args) node block name words type lowtag inits)
61 (let* ((cont (node-cont node))
62 (locs (continuation-result-tns cont
63 (list *backend-t-primitive-type*)))
64 (result (first locs)))
65 (do-fixed-alloc node block name words type lowtag result)
66 (do-inits node block name result lowtag inits args)
67 (move-continuation-result node block locs cont)))
69 (defoptimizer ir2-convert-variable-allocation
70 ((extra &rest args) node block name words type lowtag inits)
71 (let* ((cont (node-cont node))
72 (locs (continuation-result-tns cont
73 (list *backend-t-primitive-type*)))
74 (result (first locs)))
75 (if (constant-continuation-p extra)
76 (let ((words (+ (continuation-value extra) words)))
77 (do-fixed-alloc node block name words type lowtag result))
78 (vop var-alloc node block (continuation-tn node block extra) name words
80 (do-inits node block name result lowtag inits args)
81 (move-continuation-result node block locs cont)))