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