src/compiler/sparc/sap.lisp

   1 ;;;; the Alpha VM definition of SAP operations
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13 \f
  14 ;;;; moves and coercions:
  15
  16 ;;; Move a tagged SAP to an untagged representation.
  17 (define-vop (move-to-sap)
  18   (:args (x :scs (descriptor-reg)))
  19   (:results (y :scs (sap-reg)))
  20   (:note "pointer to SAP coercion")
  21   (:generator 1
  22     (loadw y x sap-pointer-slot other-pointer-lowtag)))
  23
  24 (define-move-vop move-to-sap :move
  25   (descriptor-reg) (sap-reg))
  26
  27
  28 ;;; Move an untagged SAP to a tagged representation.
  29 (define-vop (move-from-sap)
  30   (:args (sap :scs (sap-reg) :to :save))
  31   (:temporary (:scs (non-descriptor-reg)) ndescr)
  32   (:results (res :scs (descriptor-reg)))
  33   (:note "SAP to pointer coercion")
  34   (:generator 20
  35     (with-fixed-allocation (res ndescr sap-widetag sap-size)
  36       (storew sap res sap-pointer-slot other-pointer-lowtag))))
  37
  38 (define-move-vop move-from-sap :move
  39   (sap-reg) (descriptor-reg))
  40
  41
  42 ;;; Move untagged SAP values.
  43 (define-vop (sap-move)
  44   (:args (x :target y
  45             :scs (sap-reg)
  46             :load-if (not (location= x y))))
  47   (:results (y :scs (sap-reg)
  48                :load-if (not (location= x y))))
  49   (:note "SAP move")
  50   (:effects)
  51   (:affected)
  52   (:generator 0
  53     (move y x)))
  54
  55 (define-move-vop sap-move :move
  56   (sap-reg) (sap-reg))
  57
  58
  59 ;;; Move untagged SAP arguments/return-values.
  60 (define-vop (move-sap-arg)
  61   (:args (x :target y
  62             :scs (sap-reg))
  63          (fp :scs (any-reg)
  64              :load-if (not (sc-is y sap-reg))))
  65   (:results (y))
  66   (:note "SAP argument move")
  67   (:generator 0
  68     (sc-case y
  69       (sap-reg
  70        (move y x))
  71       (sap-stack
  72        (storew x fp (tn-offset y))))))
  73
  74 (define-move-vop move-sap-arg :move-arg
  75   (descriptor-reg sap-reg) (sap-reg))
  76
  77
  78 ;;; Use standard MOVE-ARG + coercion to move an untagged SAP to a
  79 ;;; descriptor passing location.
  80 (define-move-vop move-arg :move-arg
  81   (sap-reg) (descriptor-reg))
  82 \f
  83 ;;;; SAP-INT and INT-SAP
  84
  85 (define-vop (sap-int)
  86   (:args (sap :scs (sap-reg) :target int))
  87   (:arg-types system-area-pointer)
  88   (:results (int :scs (unsigned-reg)))
  89   (:result-types unsigned-num)
  90   (:translate sap-int)
  91   (:policy :fast-safe)
  92   (:generator 1
  93     (move int sap)))
  94
  95 (define-vop (int-sap)
  96   (:args (int :scs (unsigned-reg) :target sap))
  97   (:arg-types unsigned-num)
  98   (:results (sap :scs (sap-reg)))
  99   (:result-types system-area-pointer)
 100   (:translate int-sap)
 101   (:policy :fast-safe)
 102   (:generator 1
 103     (move sap int)))
 104 \f
 105 ;;;; POINTER+ and POINTER-
 106
 107 (define-vop (pointer+)
 108   (:translate sap+)
 109   (:args (ptr :scs (sap-reg))
 110          (offset :scs (signed-reg)))
 111   (:arg-types system-area-pointer signed-num)
 112   (:results (res :scs (sap-reg)))
 113   (:result-types system-area-pointer)
 114   (:policy :fast-safe)
 115   (:generator 2
 116     (inst add res ptr offset)))
 117
 118 (define-vop (pointer+-c)
 119   (:translate sap+)
 120   (:args (ptr :scs (sap-reg)))
 121   (:info offset)
 122   (:arg-types system-area-pointer (:constant (signed-byte 13)))
 123   (:results (res :scs (sap-reg)))
 124   (:result-types system-area-pointer)
 125   (:policy :fast-safe)
 126   (:generator 1
 127     (inst add res ptr offset)))
 128
 129 (define-vop (pointer-)
 130   (:translate sap-)
 131   (:args (ptr1 :scs (sap-reg))
 132          (ptr2 :scs (sap-reg)))
 133   (:arg-types system-area-pointer system-area-pointer)
 134   (:policy :fast-safe)
 135   (:results (res :scs (signed-reg)))
 136   (:result-types signed-num)
 137   (:generator 1
 138     (inst sub res ptr1 ptr2)))
 139 \f
 140 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
 141
 142 (macrolet ((def-system-ref-and-set (ref-name set-name sc type size &optional signed)
 143                (let ((ref-name-c (symbolicate ref-name "-C"))
 144                      (set-name-c (symbolicate set-name "-C")))
 145                  `(progn
 146                    (define-vop (,ref-name)
 147                        (:translate ,ref-name)
 148                      (:policy :fast-safe)
 149                      (:args (sap :scs (sap-reg))
 150                       (offset :scs (signed-reg)))
 151                      (:arg-types system-area-pointer signed-num)
 152                      (:results (result :scs (,sc)))
 153                      (:result-types ,type)
 154                      (:generator 5
 155                       ,@(if (eql size :long-float)
 156                             '((load-long-reg result sap offset t))
 157                             `((inst ,(ecase size
 158                                             (:byte (if signed 'ldsb 'ldub))
 159                                             (:short (if signed 'ldsh 'lduh))
 160                                             (:long 'ld)
 161                                             (:single 'ldf)
 162                                             (:double 'lddf))
 163                                result sap offset)))))
 164                    (define-vop (,ref-name-c)
 165                        (:translate ,ref-name)
 166                      (:policy :fast-safe)
 167                      (:args (sap :scs (sap-reg)))
 168                      (:arg-types system-area-pointer (:constant (signed-byte 13)))
 169                      (:info offset)
 170                      (:results (result :scs (,sc)))
 171                      (:result-types ,type)
 172                      (:generator 4
 173                       ,@(if (eql size :long-float)
 174                             '((load-long-reg result sap offset t))
 175                             `((inst ,(ecase size
 176                                             (:byte (if signed 'ldsb 'ldub))
 177                                             (:short (if signed 'ldsh 'lduh))
 178                                             (:long 'ld)
 179                                             (:single 'ldf)
 180                                             (:double 'lddf))
 181                                result sap offset)))))
 182                    (define-vop (,set-name)
 183                        (:translate ,set-name)
 184                      (:policy :fast-safe)
 185                      (:args (sap :scs (sap-reg))
 186                       (offset :scs (signed-reg))
 187                       (value :scs (,sc) :target result))
 188                      (:arg-types system-area-pointer signed-num ,type)
 189                      (:results (result :scs (,sc)))
 190                      (:result-types ,type)
 191                      (:generator 5
 192                       ,@(if (eql size :long-float)
 193                             '((store-long-reg value sap offset t))
 194                             `((inst ,(ecase size
 195                                             (:byte 'stb)
 196                                             (:short 'sth)
 197                                             (:long 'st)
 198                                             (:single 'stf)
 199                                             (:double 'stdf))
 200                                value sap offset)))
 201                       (unless (location= result value)
 202                         ,@(case size
 203                                 (:single
 204                                  '((inst fmovs result value)))
 205                                 (:double
 206                                  '((move-double-reg result value)))
 207                                 (:long-float
 208                                  '((move-long-reg result value)))
 209                                 (t
 210                                  '((inst move result value)))))))
 211                    (define-vop (,set-name-c)
 212                        (:translate ,set-name)
 213                      (:policy :fast-safe)
 214                      (:args (sap :scs (sap-reg))
 215                       (value :scs (,sc) :target result))
 216                      (:arg-types system-area-pointer (:constant (signed-byte 13)) ,type)
 217                      (:info offset)
 218                      (:results (result :scs (,sc)))
 219                      (:result-types ,type)
 220                      (:generator 4
 221                       ,@(if (eql size :long-float)
 222                             '((store-long-reg value sap offset t))
 223                             `((inst ,(ecase size
 224                                             (:byte 'stb)
 225                                             (:short 'sth)
 226                                             (:long 'st)
 227                                             (:single 'stf)
 228                                             (:double 'stdf))
 229                                value sap offset)))
 230                       (unless (location= result value)
 231                         ,@(case size
 232                                 (:single
 233                                  '((inst fmovs result value)))
 234                                 (:double
 235                                  '((move-double-reg result value)))
 236                                 (:long-float
 237                                  '((move-long-reg result value)))
 238                                 (t
 239                                  '((inst move result value)))))))))))
 240
 241   (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
 242     unsigned-reg positive-fixnum :byte nil)
 243   (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
 244     signed-reg tagged-num :byte t)
 245   (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
 246     unsigned-reg positive-fixnum :short nil)
 247   (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
 248     signed-reg tagged-num :short t)
 249   (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
 250     unsigned-reg unsigned-num :long nil)
 251   (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
 252     signed-reg signed-num :long t)
 253   (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
 254     sap-reg system-area-pointer :long)
 255   (def-system-ref-and-set sap-ref-single %set-sap-ref-single
 256     single-reg single-float :single)
 257   (def-system-ref-and-set sap-ref-double %set-sap-ref-double
 258     double-reg double-float :double)
 259   #!+long-float
 260   (def-system-ref-and-set sap-ref-long %set-sap-ref-long
 261     long-reg long-float :long-float)
 262 ) ; MACROLET
 263 \f
 264 ;;; noise to convert normal lisp data objects into SAPs.
 265
 266 (define-vop (vector-sap)
 267   (:translate vector-sap)
 268   (:policy :fast-safe)
 269   (:args (vector :scs (descriptor-reg)))
 270   (:results (sap :scs (sap-reg)))
 271   (:result-types system-area-pointer)
 272   (:generator 2
 273     (inst add sap vector
 274           (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))
 275 \f
 276 ;;; Transforms for 64-bit SAP accessors.
 277 (deftransform sap-ref-64 ((sap offset) (* *))
 278   '(logior (ash (sap-ref-32 sap offset) 32)
 279            (sap-ref-32 sap (+ offset 4))))
 280
 281 (deftransform signed-sap-ref-64 ((sap offset) (* *))
 282   '(logior (ash (signed-sap-ref-32 sap offset) 32)
 283            (sap-ref-32 sap (+ 4 offset))))
 284
 285 (deftransform %set-sap-ref-64 ((sap offset value) (* * *))
 286   '(progn
 287      (%set-sap-ref-32 sap offset (ash value -32))
 288      (%set-sap-ref-32 sap (+ offset 4) (logand value #xffffffff))))
 289
 290 (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
 291   '(progn
 292      (%set-signed-sap-ref-32 sap offset (ash value -32))
 293      (%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff))))