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 \f
  34 ;;;; Indexed references:
  35
  36 ;;; Define some VOPs for indexed memory reference.
  37 (macrolet ((define-indexer (name write-p op shift)
  38               `(define-vop (,name)
  39                  (:args (object :scs (descriptor-reg))
  40                         (index :scs (any-reg zero immediate))
  41                         ,@(when write-p '((value :scs (any-reg descriptor-reg)))))
  42                  (:arg-types * tagged-num ,@(when write-p '(*)))
  43                  (:temporary (:scs (non-descriptor-reg)) temp)
  44                  ,@(unless write-p
  45                      `((:results (value :scs (any-reg descriptor-reg)))
  46                        (:result-types *)))
  47                  (:variant-vars offset lowtag)
  48                  (:policy :fast-safe)
  49                  (:generator 5
  50                   (sc-case index
  51                    ((immediate zero)
  52                     (let ((offset (- (+ (if (sc-is index zero)
  53                                             0
  54                                             (ash (tn-value index)
  55                                                  (- word-shift ,shift)))
  56                                         (ash offset word-shift))
  57                                      lowtag)))
  58                       (etypecase offset
  59                         ((signed-byte 13)
  60                          (inst ,op value object offset))
  61                         ((or (unsigned-byte 32) (signed-byte 32))
  62                          (inst li temp offset)
  63                          (inst ,op value object temp)))))
  64                    (t
  65                     ,@(unless (zerop shift)
  66                               `((inst srl temp index ,shift)))
  67                     (inst add temp ,(if (zerop shift) 'index 'temp)
  68                           (- (ash offset word-shift) lowtag))
  69                     (inst ,op value object temp)))))))
  70   (define-indexer word-index-ref nil ld 0)
  71   (define-indexer word-index-set t st 0)
  72   (define-indexer halfword-index-ref nil lduh 1)
  73   (define-indexer signed-halfword-index-ref nil ldsh 1)
  74   (define-indexer halfword-index-set t sth 1)
  75   (define-indexer byte-index-ref nil ldub 2)
  76   (define-indexer signed-byte-index-ref nil ldsb 2)
  77   (define-indexer byte-index-set t stb 2))