Port to x86-64 versions of Windows
[sbcl.git] / src / compiler / ppc / memory.lisp
1 ;;;; the PPC definitions of some general purpose memory reference VOPs
2 ;;;; inherited by basic memory reference operations
3
4 ;;;; This software is part of the SBCL system. See the README file for
5 ;;;; more information.
6 ;;;;
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
12
13 (in-package "SB!VM")
14 \f
15 ;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the offset to
16 ;;; be read or written is a property of the VOP used.
17 ;;;
18 (define-vop (cell-ref)
19   (:args (object :scs (descriptor-reg)))
20   (:results (value :scs (descriptor-reg any-reg)))
21   (:variant-vars offset lowtag)
22   (:policy :fast-safe)
23   (:generator 4
24     (loadw value object offset lowtag)))
25 ;;;
26 (define-vop (cell-set)
27   (:args (object :scs (descriptor-reg))
28          (value :scs (descriptor-reg any-reg)))
29   (:variant-vars offset lowtag)
30   (:policy :fast-safe)
31   (:generator 4
32     (storew value object offset lowtag)))
33
34 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref, where the
35 ;;; offset is constant at compile time, but varies for different uses.  We add
36 ;;; in the standard g-vector overhead.
37 ;;;
38 (define-vop (slot-ref)
39   (:args (object :scs (descriptor-reg)))
40   (:results (value :scs (descriptor-reg any-reg)))
41   (:variant-vars base lowtag)
42   (:info offset)
43   (:generator 4
44     (loadw value object (+ base offset) lowtag)))
45 ;;;
46 (define-vop (slot-set)
47   (:args (object :scs (descriptor-reg))
48          (value :scs (descriptor-reg any-reg)))
49   (:variant-vars base lowtag)
50   (:info offset)
51   (:generator 4
52     (storew value object (+ base offset) lowtag)))
53
54
55 \f
56 ;;;; Indexed references:
57
58 ;;; Define some VOPs for indexed memory reference.
59 (defmacro define-indexer (name write-p ri-op rr-op shift &optional sign-extend-byte)
60   `(define-vop (,name)
61      (:args (object :scs (descriptor-reg))
62             (index :scs (any-reg zero immediate))
63             ,@(when write-p
64                 '((value :scs (any-reg descriptor-reg) :target result))))
65      (:arg-types * tagged-num ,@(when write-p '(*)))
66      (:temporary (:scs (non-descriptor-reg)) temp)
67      (:results (,(if write-p 'result 'value)
68                 :scs (any-reg descriptor-reg)))
69      (:result-types *)
70      (:variant-vars offset lowtag)
71      (:policy :fast-safe)
72      (:generator 5
73        (sc-case index
74          ((immediate zero)
75           (let ((offset (- (+ (if (sc-is index zero)
76                                   0
77                                   (ash (tn-value index)
78                                        (- word-shift ,shift)))
79                               (ash offset word-shift))
80                            lowtag)))
81             (etypecase offset
82               ((signed-byte 16)
83                (inst ,ri-op value object offset))
84               ((or (unsigned-byte 32) (signed-byte 32))
85                (inst lr temp offset)
86                (inst ,rr-op value object temp)))))
87          (t
88           ,@(unless (zerop shift)
89               `((inst srwi temp index ,shift)))
90           (inst addi temp ,(if (zerop shift) 'index 'temp)
91                 (- (ash offset word-shift) lowtag))
92           (inst ,rr-op value object temp)))
93        ,@(when sign-extend-byte
94            `((inst extsb value value)))
95        ,@(when write-p
96            '((move result value))))))
97
98 (define-indexer word-index-ref nil lwz lwzx 0)
99 (define-indexer word-index-set t stw stwx 0)
100 (define-indexer halfword-index-ref nil lhz lhzx 1)
101 (define-indexer signed-halfword-index-ref nil lha lhax 1)
102 (define-indexer halfword-index-set t sth sthx 1)
103 (define-indexer byte-index-ref nil lbz lbzx 2)
104 (define-indexer signed-byte-index-ref nil lbz lbzx 2 t)
105 (define-indexer byte-index-set t stb stbx 2)
106
107 #!+compare-and-swap-vops
108 (define-vop (word-index-cas)
109   (:args (object :scs (descriptor-reg))
110          (index :scs (any-reg zero immediate))
111          (old-value :scs (any-reg descriptor-reg))
112          (new-value :scs (any-reg descriptor-reg)))
113   (:arg-types * tagged-num * *)
114   (:temporary (:sc non-descriptor-reg) temp)
115   (:results (result :scs (any-reg descriptor-reg) :from :load))
116   (:result-types *)
117   (:variant-vars offset lowtag)
118   (:policy :fast-safe)
119   (:generator 5
120     (sc-case index
121       ((immediate zero)
122        (let ((offset (- (+ (if (sc-is index zero)
123                                0
124                              (ash (tn-value index) word-shift))
125                            (ash offset word-shift))
126                         lowtag)))
127          (inst lr temp offset)))
128       (t
129        ;; KLUDGE: This relies on N-FIXNUM-TAG-BITS being the same as
130        ;; WORD-SHIFT.  I know better than to do this.  --AB, 2010-Jun-16
131        (inst addi temp index
132              (- (ash offset word-shift) lowtag))))
133
134     (inst sync)
135     LOOP
136     (inst lwarx result temp object)
137     (inst cmpw result old-value)
138     (inst bne EXIT)
139     (inst stwcx. new-value temp object)
140     (inst bne LOOP)
141     EXIT
142     (inst isync)))