src/compiler/x86/sap.lisp

   1 ;;;; SAP operations for the x86 VM
   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-type)))
  23 (define-move-vop move-to-sap :move
  24   (descriptor-reg) (sap-reg))
  25
  26 ;;; Move an untagged SAP to a tagged representation.
  27 (define-vop (move-from-sap)
  28   (:args (sap :scs (sap-reg) :to :result))
  29   (:results (res :scs (descriptor-reg) :from :argument))
  30   (:note "SAP to pointer coercion")
  31   (:node-var node)
  32   (:generator 20
  33     (with-fixed-allocation (res sap-type sap-size node)
  34       (storew sap res sap-pointer-slot other-pointer-type))))
  35 (define-move-vop move-from-sap :move
  36   (sap-reg) (descriptor-reg))
  37
  38 ;;; Move untagged sap values.
  39 (define-vop (sap-move)
  40   (:args (x :target y
  41             :scs (sap-reg)
  42             :load-if (not (location= x y))))
  43   (:results (y :scs (sap-reg)
  44                :load-if (not (location= x y))))
  45   (:note "SAP move")
  46   (:effects)
  47   (:affected)
  48   (:generator 0
  49     (move y x)))
  50 (define-move-vop sap-move :move
  51   (sap-reg) (sap-reg))
  52
  53 ;;; Move untagged sap arguments/return-values.
  54 (define-vop (move-sap-argument)
  55   (:args (x :target y
  56             :scs (sap-reg))
  57          (fp :scs (any-reg)
  58              :load-if (not (sc-is y sap-reg))))
  59   (:results (y))
  60   (:note "SAP argument move")
  61   (:generator 0
  62     (sc-case y
  63       (sap-reg
  64        (move y x))
  65       (sap-stack
  66        (if (= (tn-offset fp) esp-offset)
  67            (storew x fp (tn-offset y))  ; c-call
  68            (storew x fp (- (1+ (tn-offset y)))))))))
  69 (define-move-vop move-sap-argument :move-argument
  70   (descriptor-reg sap-reg) (sap-reg))
  71
  72 ;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
  73 ;;; descriptor passing location.
  74 (define-move-vop move-argument :move-argument
  75   (sap-reg) (descriptor-reg))
  76 \f
  77 ;;;; SAP-INT and INT-SAP
  78
  79 (define-vop (sap-int)
  80   (:args (sap :scs (sap-reg) :target int))
  81   (:arg-types system-area-pointer)
  82   (:results (int :scs (unsigned-reg)))
  83   (:result-types unsigned-num)
  84   (:translate sap-int)
  85   (:policy :fast-safe)
  86   (:generator 1
  87     (move int sap)))
  88
  89 (define-vop (int-sap)
  90   (:args (int :scs (unsigned-reg) :target sap))
  91   (:arg-types unsigned-num)
  92   (:results (sap :scs (sap-reg)))
  93   (:result-types system-area-pointer)
  94   (:translate int-sap)
  95   (:policy :fast-safe)
  96   (:generator 1
  97     (move sap int)))
  98 \f
  99 ;;;; POINTER+ and POINTER-
 100
 101 (define-vop (pointer+)
 102   (:translate sap+)
 103   (:args (ptr :scs (sap-reg) :target res
 104               :load-if (not (location= ptr res)))
 105          (offset :scs (signed-reg immediate)))
 106   (:arg-types system-area-pointer signed-num)
 107   (:results (res :scs (sap-reg) :from (:argument 0)
 108                  :load-if (not (location= ptr res))))
 109   (:result-types system-area-pointer)
 110   (:policy :fast-safe)
 111   (:generator 1
 112     (cond ((and (sc-is ptr sap-reg) (sc-is res sap-reg)
 113                 (not (location= ptr res)))
 114            (sc-case offset
 115              (signed-reg
 116               (inst lea res (make-ea :dword :base ptr :index offset :scale 1)))
 117              (immediate
 118               (inst lea res (make-ea :dword :base ptr
 119                                      :disp (tn-value offset))))))
 120           (t
 121            (move res ptr)
 122            (sc-case offset
 123              (signed-reg
 124               (inst add res offset))
 125              (immediate
 126               (inst add res (tn-value offset))))))))
 127
 128 (define-vop (pointer-)
 129   (:translate sap-)
 130   (:args (ptr1 :scs (sap-reg) :target res)
 131          (ptr2 :scs (sap-reg)))
 132   (:arg-types system-area-pointer system-area-pointer)
 133   (:policy :fast-safe)
 134   (:results (res :scs (signed-reg) :from (:argument 0)))
 135   (:result-types signed-num)
 136   (:generator 1
 137     (move res ptr1)
 138     (inst sub res ptr2)))
 139 \f
 140 ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET
 141
 142 (macrolet ((def-system-ref-and-set (ref-name
 143                                     set-name
 144                                     sc
 145                                     type
 146                                     size
 147                                     &optional signed)
 148              (let ((ref-name-c (symbolicate ref-name "-C"))
 149                    (set-name-c (symbolicate set-name "-C"))
 150                    (temp-sc (symbolicate size "-REG")))
 151                `(progn
 152                   (define-vop (,ref-name)
 153                     (:translate ,ref-name)
 154                     (:policy :fast-safe)
 155                     (:args (sap :scs (sap-reg))
 156                            (offset :scs (signed-reg)))
 157                     (:arg-types system-area-pointer signed-num)
 158                     ,@(unless (eq size :dword)
 159                         `((:temporary (:sc ,temp-sc
 160                                        :from (:eval 0)
 161                                        :to (:eval 1))
 162                                       temp)))
 163                     (:results (result :scs (,sc)))
 164                     (:result-types ,type)
 165                     (:generator 5
 166                                 (inst mov ,(if (eq size :dword) 'result 'temp)
 167                                       (make-ea ,size :base sap :index offset))
 168                                 ,@(unless (eq size :dword)
 169                                     `((inst ,(if signed 'movsx 'movzx)
 170                                             result temp)))))
 171                   (define-vop (,ref-name-c)
 172                     (:translate ,ref-name)
 173                     (:policy :fast-safe)
 174                     (:args (sap :scs (sap-reg)))
 175                     (:arg-types system-area-pointer
 176                                 (:constant (signed-byte 32)))
 177                     (:info offset)
 178                     ,@(unless (eq size :dword)
 179                         `((:temporary (:sc ,temp-sc
 180                                        :from (:eval 0)
 181                                        :to (:eval 1))
 182                                       temp)))
 183                     (:results (result :scs (,sc)))
 184                     (:result-types ,type)
 185                     (:generator 4
 186                                 (inst mov ,(if (eq size :dword) 'result 'temp)
 187                                       (make-ea ,size :base sap :disp offset))
 188                                 ,@(unless (eq size :dword)
 189                                     `((inst ,(if signed 'movsx 'movzx)
 190                                             result temp)))))
 191                   (define-vop (,set-name)
 192                     (:translate ,set-name)
 193                     (:policy :fast-safe)
 194                     (:args (sap :scs (sap-reg) :to (:eval 0))
 195                            (offset :scs (signed-reg) :to (:eval 0))
 196                            (value :scs (,sc)
 197                                   :target ,(if (eq size :dword)
 198                                                'result
 199                                                'temp)))
 200                     (:arg-types system-area-pointer signed-num ,type)
 201                     ,@(unless (eq size :dword)
 202                         `((:temporary (:sc ,temp-sc :offset eax-offset
 203                                            :from (:argument 2) :to (:result 0)
 204                                            :target result)
 205                                       temp)))
 206                     (:results (result :scs (,sc)))
 207                     (:result-types ,type)
 208                     (:generator 5
 209                                 ,@(unless (eq size :dword)
 210                                     `((move eax-tn value)))
 211                                 (inst mov (make-ea ,size
 212                                                    :base sap
 213                                                    :index offset)
 214                                       ,(if (eq size :dword) 'value 'temp))
 215                                 (move result
 216                                       ,(if (eq size :dword) 'value 'eax-tn))))
 217                   (define-vop (,set-name-c)
 218                     (:translate ,set-name)
 219                     (:policy :fast-safe)
 220                     (:args (sap :scs (sap-reg) :to (:eval 0))
 221                            (value :scs (,sc)
 222                                   :target ,(if (eq size :dword)
 223                                                'result
 224                                                'temp)))
 225                     (:arg-types system-area-pointer
 226                                 (:constant (signed-byte 32)) ,type)
 227                     (:info offset)
 228                     ,@(unless (eq size :dword)
 229                         `((:temporary (:sc ,temp-sc :offset eax-offset
 230                                            :from (:argument 2) :to (:result 0)
 231                                            :target result)
 232                                       temp)))
 233                     (:results (result :scs (,sc)))
 234                     (:result-types ,type)
 235                     (:generator 4
 236                                 ,@(unless (eq size :dword)
 237                                     `((move eax-tn value)))
 238                                 (inst mov
 239                                       (make-ea ,size :base sap :disp offset)
 240                                       ,(if (eq size :dword) 'value 'temp))
 241                                 (move result ,(if (eq size :dword)
 242                                                   'value
 243                                                   'eax-tn))))))))
 244
 245   (def-system-ref-and-set sap-ref-8 %set-sap-ref-8
 246     unsigned-reg positive-fixnum :byte nil)
 247   (def-system-ref-and-set signed-sap-ref-8 %set-signed-sap-ref-8
 248     signed-reg tagged-num :byte t)
 249   (def-system-ref-and-set sap-ref-16 %set-sap-ref-16
 250     unsigned-reg positive-fixnum :word nil)
 251   (def-system-ref-and-set signed-sap-ref-16 %set-signed-sap-ref-16
 252     signed-reg tagged-num :word t)
 253   (def-system-ref-and-set sap-ref-32 %set-sap-ref-32
 254     unsigned-reg unsigned-num :dword nil)
 255   (def-system-ref-and-set signed-sap-ref-32 %set-signed-sap-ref-32
 256     signed-reg signed-num :dword t)
 257   (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap
 258     sap-reg system-area-pointer :dword))
 259 \f
 260 ;;;; SAP-REF-DOUBLE
 261
 262 (define-vop (sap-ref-double)
 263   (:translate sap-ref-double)
 264   (:policy :fast-safe)
 265   (:args (sap :scs (sap-reg))
 266          (offset :scs (signed-reg)))
 267   (:arg-types system-area-pointer signed-num)
 268   (:results (result :scs (double-reg)))
 269   (:result-types double-float)
 270   (:generator 5
 271      (with-empty-tn@fp-top(result)
 272         (inst fldd (make-ea :dword :base sap :index offset)))))
 273
 274 (define-vop (sap-ref-double-c)
 275   (:translate sap-ref-double)
 276   (:policy :fast-safe)
 277   (:args (sap :scs (sap-reg)))
 278   (:arg-types system-area-pointer (:constant (signed-byte 32)))
 279   (:info offset)
 280   (:results (result :scs (double-reg)))
 281   (:result-types double-float)
 282   (:generator 4
 283      (with-empty-tn@fp-top(result)
 284         (inst fldd (make-ea :dword :base sap :disp offset)))))
 285
 286 (define-vop (%set-sap-ref-double)
 287   (:translate %set-sap-ref-double)
 288   (:policy :fast-safe)
 289   (:args (sap :scs (sap-reg) :to (:eval 0))
 290          (offset :scs (signed-reg) :to (:eval 0))
 291          (value :scs (double-reg)))
 292   (:arg-types system-area-pointer signed-num double-float)
 293   (:results (result :scs (double-reg)))
 294   (:result-types double-float)
 295   (:generator 5
 296     (cond ((zerop (tn-offset value))
 297            ;; Value is in ST0.
 298            (inst fstd (make-ea :dword :base sap :index offset))
 299            (unless (zerop (tn-offset result))
 300                    ;; Value is in ST0 but not result.
 301                    (inst fstd result)))
 302           (t
 303            ;; Value is not in ST0.
 304            (inst fxch value)
 305            (inst fstd (make-ea :dword :base sap :index offset))
 306            (cond ((zerop (tn-offset result))
 307                   ;; The result is in ST0.
 308                   (inst fstd value))
 309                  (t
 310                   ;; Neither value or result are in ST0.
 311                   (unless (location= value result)
 312                           (inst fstd result))
 313                   (inst fxch value)))))))
 314
 315 (define-vop (%set-sap-ref-double-c)
 316   (:translate %set-sap-ref-double)
 317   (:policy :fast-safe)
 318   (:args (sap :scs (sap-reg) :to (:eval 0))
 319          (value :scs (double-reg)))
 320   (:arg-types system-area-pointer (:constant (signed-byte 32)) double-float)
 321   (:info offset)
 322   (:results (result :scs (double-reg)))
 323   (:result-types double-float)
 324   (:generator 4
 325     (cond ((zerop (tn-offset value))
 326            ;; Value is in ST0.
 327            (inst fstd (make-ea :dword :base sap :disp offset))
 328            (unless (zerop (tn-offset result))
 329                    ;; Value is in ST0 but not result.
 330                    (inst fstd result)))
 331           (t
 332            ;; Value is not in ST0.
 333            (inst fxch value)
 334            (inst fstd (make-ea :dword :base sap :disp offset))
 335            (cond ((zerop (tn-offset result))
 336                   ;; The result is in ST0.
 337                   (inst fstd value))
 338                  (t
 339                   ;; Neither value or result are in ST0.
 340                   (unless (location= value result)
 341                           (inst fstd result))
 342                   (inst fxch value)))))))
 343 \f
 344 ;;;; SAP-REF-SINGLE
 345
 346 (define-vop (sap-ref-single)
 347   (:translate sap-ref-single)
 348   (:policy :fast-safe)
 349   (:args (sap :scs (sap-reg))
 350          (offset :scs (signed-reg)))
 351   (:arg-types system-area-pointer signed-num)
 352   (:results (result :scs (single-reg)))
 353   (:result-types single-float)
 354   (:generator 5
 355      (with-empty-tn@fp-top(result)
 356         (inst fld (make-ea :dword :base sap :index offset)))))
 357
 358 (define-vop (sap-ref-single-c)
 359   (:translate sap-ref-single)
 360   (:policy :fast-safe)
 361   (:args (sap :scs (sap-reg)))
 362   (:arg-types system-area-pointer (:constant (signed-byte 32)))
 363   (:info offset)
 364   (:results (result :scs (single-reg)))
 365   (:result-types single-float)
 366   (:generator 4
 367      (with-empty-tn@fp-top(result)
 368         (inst fld (make-ea :dword :base sap :disp offset)))))
 369
 370 (define-vop (%set-sap-ref-single)
 371   (:translate %set-sap-ref-single)
 372   (:policy :fast-safe)
 373   (:args (sap :scs (sap-reg) :to (:eval 0))
 374          (offset :scs (signed-reg) :to (:eval 0))
 375          (value :scs (single-reg)))
 376   (:arg-types system-area-pointer signed-num single-float)
 377   (:results (result :scs (single-reg)))
 378   (:result-types single-float)
 379   (:generator 5
 380     (cond ((zerop (tn-offset value))
 381            ;; Value is in ST0
 382            (inst fst (make-ea :dword :base sap :index offset))
 383            (unless (zerop (tn-offset result))
 384                    ;; Value is in ST0 but not result.
 385                    (inst fst result)))
 386           (t
 387            ;; Value is not in ST0.
 388            (inst fxch value)
 389            (inst fst (make-ea :dword :base sap :index offset))
 390            (cond ((zerop (tn-offset result))
 391                   ;; The result is in ST0.
 392                   (inst fst value))
 393                  (t
 394                   ;; Neither value or result are in ST0
 395                   (unless (location= value result)
 396                           (inst fst result))
 397                   (inst fxch value)))))))
 398
 399 (define-vop (%set-sap-ref-single-c)
 400   (:translate %set-sap-ref-single)
 401   (:policy :fast-safe)
 402   (:args (sap :scs (sap-reg) :to (:eval 0))
 403          (value :scs (single-reg)))
 404   (:arg-types system-area-pointer (:constant (signed-byte 32)) single-float)
 405   (:info offset)
 406   (:results (result :scs (single-reg)))
 407   (:result-types single-float)
 408   (:generator 4
 409     (cond ((zerop (tn-offset value))
 410            ;; Value is in ST0
 411            (inst fst (make-ea :dword :base sap :disp offset))
 412            (unless (zerop (tn-offset result))
 413                    ;; Value is in ST0 but not result.
 414                    (inst fst result)))
 415           (t
 416            ;; Value is not in ST0.
 417            (inst fxch value)
 418            (inst fst (make-ea :dword :base sap :disp offset))
 419            (cond ((zerop (tn-offset result))
 420                   ;; The result is in ST0.
 421                   (inst fst value))
 422                  (t
 423                   ;; Neither value or result are in ST0
 424                   (unless (location= value result)
 425                           (inst fst result))
 426                   (inst fxch value)))))))
 427 \f
 428 ;;;; SAP-REF-LONG
 429
 430 (define-vop (sap-ref-long)
 431   (:translate sap-ref-long)
 432   (:policy :fast-safe)
 433   (:args (sap :scs (sap-reg))
 434          (offset :scs (signed-reg)))
 435   (:arg-types system-area-pointer signed-num)
 436   (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
 437   (:result-types #!+long-float long-float #!-long-float double-float)
 438   (:generator 5
 439      (with-empty-tn@fp-top(result)
 440         (inst fldl (make-ea :dword :base sap :index offset)))))
 441
 442 (define-vop (sap-ref-long-c)
 443   (:translate sap-ref-long)
 444   (:policy :fast-safe)
 445   (:args (sap :scs (sap-reg)))
 446   (:arg-types system-area-pointer (:constant (signed-byte 32)))
 447   (:info offset)
 448   (:results (result :scs (#!+long-float long-reg #!-long-float double-reg)))
 449   (:result-types #!+long-float long-float #!-long-float double-float)
 450   (:generator 4
 451      (with-empty-tn@fp-top(result)
 452         (inst fldl (make-ea :dword :base sap :disp offset)))))
 453
 454 #!+long-float
 455 (define-vop (%set-sap-ref-long)
 456   (:translate %set-sap-ref-long)
 457   (:policy :fast-safe)
 458   (:args (sap :scs (sap-reg) :to (:eval 0))
 459          (offset :scs (signed-reg) :to (:eval 0))
 460          (value :scs (long-reg)))
 461   (:arg-types system-area-pointer signed-num long-float)
 462   (:results (result :scs (long-reg)))
 463   (:result-types long-float)
 464   (:generator 5
 465     (cond ((zerop (tn-offset value))
 466            ;; Value is in ST0
 467            (store-long-float (make-ea :dword :base sap :index offset))
 468            (unless (zerop (tn-offset result))
 469              ;; Value is in ST0 but not result.
 470              (inst fstd result)))
 471           (t
 472            ;; Value is not in ST0.
 473            (inst fxch value)
 474            (store-long-float (make-ea :dword :base sap :index offset))
 475            (cond ((zerop (tn-offset result))
 476                   ;; The result is in ST0.
 477                   (inst fstd value))
 478                  (t
 479                   ;; Neither value or result are in ST0
 480                   (unless (location= value result)
 481                     (inst fstd result))
 482                   (inst fxch value)))))))
 483 \f
 484 ;;; noise to convert normal lisp data objects into SAPs
 485
 486 (define-vop (vector-sap)
 487   (:translate vector-sap)
 488   (:policy :fast-safe)
 489   (:args (vector :scs (descriptor-reg) :target sap))
 490   (:results (sap :scs (sap-reg)))
 491   (:result-types system-area-pointer)
 492   (:generator 2
 493     (move sap vector)
 494     (inst add sap (- (* vector-data-offset word-bytes) other-pointer-type))))