0.7.1.20:
[sbcl.git] / src / compiler / sparc / memory.lisp
1 ;;;; the Sparc definitions of some general purpose memory reference
2 ;;;; VOPs 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
15 ;;; Cell-Ref and Cell-Set are used to define VOPs like CAR, where the
16 ;;; offset to be read or written is a property of the VOP used.
17 (define-vop (cell-ref)
18   (:args (object :scs (descriptor-reg)))
19   (:results (value :scs (descriptor-reg any-reg)))
20   (:variant-vars offset lowtag)
21   (:policy :fast-safe)
22   (:generator 4
23     (loadw value object offset lowtag)))
24
25 (define-vop (cell-set)
26   (:args (object :scs (descriptor-reg))
27          (value :scs (descriptor-reg any-reg)))
28   (:variant-vars offset lowtag)
29   (:policy :fast-safe)
30   (:generator 4
31     (storew value object offset lowtag)))
32
33 ;;; Slot-Ref and Slot-Set are used to define VOPs like Closure-Ref,
34 ;;; where the offset is constant at compile time, but varies for
35 ;;; different uses.  We add in the stardard g-vector overhead.
36 (define-vop (slot-ref)
37   (:args (object :scs (descriptor-reg)))
38   (:results (value :scs (descriptor-reg any-reg)))
39   (:variant-vars base lowtag)
40   (:info offset)
41   (:generator 4
42     (loadw value object (+ base offset) lowtag)))
43
44 (define-vop (slot-set)
45   (:args (object :scs (descriptor-reg))
46          (value :scs (descriptor-reg any-reg)))
47   (:variant-vars base lowtag)
48   (:info offset)
49   (:generator 4
50     (storew value object (+ base offset) lowtag)))
51 \f
52 ;;;; Indexed references:
53
54 ;;; Define some VOPs for indexed memory reference.
55 (macrolet ((define-indexer (name write-p op shift)
56                `(define-vop (,name)
57                  (:args (object :scs (descriptor-reg))
58                   (index :scs (any-reg zero immediate))
59                   ,@(when write-p
60                           '((value :scs (any-reg descriptor-reg) :target result))))
61                  (:arg-types * tagged-num ,@(when write-p '(*)))
62                  (:temporary (:scs (non-descriptor-reg)) temp)
63                  (:results (,(if write-p 'result 'value)
64                             :scs (any-reg descriptor-reg)))
65                  (:result-types *)
66                  (:variant-vars offset lowtag)
67                  (:policy :fast-safe)
68                  (:generator 5
69                   (sc-case index
70                    ((immediate zero)
71                     (let ((offset (- (+ (if (sc-is index zero)
72                                             0
73                                             (ash (tn-value index)
74                                                  (- word-shift ,shift)))
75                                         (ash offset word-shift))
76                                      lowtag)))
77                       (etypecase offset
78                         ((signed-byte 13)
79                          (inst ,op value object offset))
80                         ((or (unsigned-byte 32) (signed-byte 32))
81                          (inst li temp offset)
82                          (inst ,op value object temp)))))
83                    (t
84                     ,@(unless (zerop shift)
85                               `((inst srl temp index ,shift)))
86                     (inst add temp ,(if (zerop shift) 'index 'temp)
87                           (- (ash offset word-shift) lowtag))
88                     (inst ,op value object temp)))
89                   ,@(when write-p
90                           '((move result value)))))))
91   (define-indexer word-index-ref nil ld 0)
92   (define-indexer word-index-set t st 0)
93   (define-indexer halfword-index-ref nil lduh 1)
94   (define-indexer signed-halfword-index-ref nil ldsh 1)
95   (define-indexer halfword-index-set t sth 1)
96   (define-indexer byte-index-ref nil ldub 2)
97   (define-indexer signed-byte-index-ref nil ldsb 2)
98   (define-indexer byte-index-set t stb 2))
99