Changeset 7661


Ignore:
Timestamp:
Nov 16, 2007, 8:18:48 PM (12 years ago)
Author:
rme
Message:

Extend some floating point stuff to work (maybe) on IA-32.

Include placeholder for i386-ff-call operator.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/ia32/compiler/X86/x862.lisp

    r7429 r7661  
    4343
    4444
     45;; probably belongs elsewhere
     46(defmacro with-temporary-imm-target ((&rest reserved) spec &body body)
     47  (let* ((node (gensym))
     48         (name (if (atom spec) spec (car spec)))
     49         (mode-name (if (atom spec) :natural (cadr spec))))
     50    `(with-node-target (,@reserved) ,node
     51       (! mark-as-imm ,node)
     52       (let* ((,name (set-regspec-mode ,node
     53                                       (gpr-mode-name-value ,mode-name))))
     54         ,@body)
     55       (! mark-as-node ,node))))
    4556
    4657
     
    188199(defvar *x862-allocptr* nil)
    189200
     201(defvar *x862-fp1* nil)
     202
    190203(declaim (fixnum *x862-vstack* *x862-cstack*))
    191204
     
    487500                                              (:x8664 x8664::allocptr)))
    488501           
    489 
     502           (*x862-fp1* (target-arch-case (:x8632 x8632::fp1)
     503                                         (:x8664 x8664::fp1)))
    490504           (*x862-target-num-arg-regs* (target-arch-case
    491505                                        (:x8632 $numx8632argregs)
     
    23022316                   reg)))))))
    23032317
    2304 
    23052318;;; xxx
    23062319(defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization)
     
    23372350                   (! misc-set-node val-reg src unscaled-idx)))))
    23382351            (t
    2339              (with-imm-target (unboxed-val-reg) scaled-idx
    2340                (cond
    2341                  (is-64-bit
    2342                   (if (and index-known-fixnum
    2343                            (<= index-known-fixnum
    2344                                (arch::target-max-64-bit-constant-index arch)))
    2345                     (if (eq type-keyword :double-float-vector)
    2346                       (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
    2347                       (if is-signed
    2348                         (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
    2349                         (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
    2350                     (progn
    2351                       (if index-known-fixnum
    2352                         (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
    2353                       (if (eq type-keyword :double-float-vector)
    2354                         (! misc-set-double-float unboxed-val-reg src unscaled-idx)
    2355                         (if is-signed
    2356                           (! misc-set-s64 unboxed-val-reg src unscaled-idx)
    2357                           (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
    2358                  (is-32-bit
    2359                   (if (and index-known-fixnum
    2360                            (<= index-known-fixnum
    2361                                (arch::target-max-32-bit-constant-index arch)))
    2362                     (if (eq type-keyword :single-float-vector)
    2363                       (if (eq (hard-regspec-class unboxed-val-reg)
    2364                               hard-reg-class-fpr)
    2365                         (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
    2366                         (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
    2367                       (if is-signed
    2368                         (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
    2369                         (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
    2370                     (progn
    2371                       (if index-known-fixnum
    2372                         (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    2373                         (! scale-32bit-misc-index scaled-idx unscaled-idx))
    2374                       (if (and (eq type-keyword :single-float-vector)
    2375                                (eql (hard-regspec-class unboxed-val-reg)
    2376                                     hard-reg-class-fpr))
    2377                         (! misc-set-single-float unboxed-val-reg src scaled-idx)
    2378                         (if is-signed
    2379                           (! misc-set-s32 unboxed-val-reg src scaled-idx)
    2380                           (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
    2381                  (is-16-bit
    2382                   (if (and index-known-fixnum
    2383                            (<= index-known-fixnum
    2384                                (arch::target-max-16-bit-constant-index arch)))
    2385                     (if is-signed
    2386                       (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
    2387                       (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
    2388                     (progn
    2389                       (if index-known-fixnum
    2390                         (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
    2391                         (! scale-16bit-misc-index scaled-idx unscaled-idx))
    2392                       (if is-signed
    2393                         (! misc-set-s16 unboxed-val-reg src scaled-idx)
    2394                         (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
    2395                  (is-8-bit
    2396                   (if (and index-known-fixnum
    2397                            (<= index-known-fixnum
    2398                                (arch::target-max-8-bit-constant-index arch)))
    2399                     (if is-signed
    2400                       (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
    2401                       (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
    2402                     (progn
    2403                       (if index-known-fixnum
    2404                         (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
    2405                         (! scale-8bit-misc-index scaled-idx unscaled-idx))
    2406                       (if is-signed
    2407                         (! misc-set-s8 unboxed-val-reg src scaled-idx)
    2408                         (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
    2409                  (is-1-bit
    2410                   (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
    2411                     (if constval
    2412                       (if (zerop constval)
    2413                         (! set-constant-bit-to-zero src index-known-fixnum)
    2414                         (! set-constant-bit-to-one src index-known-fixnum))
    2415                       (progn
    2416                         (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
    2417                     (with-imm-temps () (word-index bit-number)
    2418                       (if index-known-fixnum
    2419                         (progn
    2420                           (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
    2421                           (x862-lri seg bit-number (logand index-known-fixnum #x63)))
    2422                         (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx))
    2423                       (if constval
    2424                         (if (zerop constval)
    2425                           (! set-variable-bit-to-zero src word-index bit-number)
    2426                           (! set-variable-bit-to-one src word-index bit-number))
    2427                         (progn
    2428                           (! set-variable-bit-to-variable-value src word-index bit-number val-reg))))))))))
     2352             (cond
     2353               (is-64-bit
     2354                (if (and index-known-fixnum
     2355                         (<= index-known-fixnum
     2356                             (arch::target-max-64-bit-constant-index arch)))
     2357                  (if (eq type-keyword :double-float-vector)
     2358                    (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
     2359                    (if is-signed
     2360                      (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
     2361                      (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
     2362                  (progn
     2363                    (if index-known-fixnum
     2364                      (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
     2365                    (if (eq type-keyword :double-float-vector)
     2366                      (! misc-set-double-float unboxed-val-reg src unscaled-idx)
     2367                      (if is-signed
     2368                        (! misc-set-s64 unboxed-val-reg src unscaled-idx)
     2369                        (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
     2370               (is-32-bit
     2371                (if (and index-known-fixnum
     2372                         (<= index-known-fixnum
     2373                             (arch::target-max-32-bit-constant-index arch)))
     2374                  (if (eq type-keyword :single-float-vector)
     2375                    (if (eq (hard-regspec-class unboxed-val-reg)
     2376                            hard-reg-class-fpr)
     2377                      (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
     2378                      (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
     2379                    (if is-signed
     2380                      (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
     2381                      (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)))
     2382                  (progn
     2383                    ;; scaled-idx
     2384                    (target-arch-case
     2385                     (:x8664
     2386                      (with-imm-target (unboxed-val-reg) scaled-idx
     2387                        (if index-known-fixnum
     2388                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     2389                          (! scale-32bit-misc-index scaled-idx unscaled-idx))
     2390                        (if (and (eq type-keyword :single-float-vector)
     2391                                 (eql (hard-regspec-class unboxed-val-reg)
     2392                                      hard-reg-class-fpr))
     2393                          (! misc-set-single-float unboxed-val-reg src scaled-idx)
     2394                          (if is-signed
     2395                            (! misc-set-s32 unboxed-val-reg src scaled-idx)
     2396                            (! misc-set-u32 unboxed-val-reg src scaled-idx)))))
     2397                     (:x8632
     2398                      (with-temporary-imm-target (src unscaled-idx) scaled-idx
     2399                        (if index-known-fixnum
     2400                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
     2401                          (! scale-32bit-misc-index scaled-idx unscaled-idx))
     2402                        (if (and (eq type-keyword :single-float-vector)
     2403                                 (eql (hard-regspec-class unboxed-val-reg)
     2404                                      hard-reg-class-fpr))
     2405                          (! misc-set-single-float unboxed-val-reg src scaled-idx)
     2406                          (if is-signed
     2407                            (! misc-set-s32 unboxed-val-reg src scaled-idx)
     2408                            (! misc-set-u32 unboxed-val-reg src scaled-idx)))))))))
     2409               (is-16-bit
     2410                (if (and index-known-fixnum
     2411                         (<= index-known-fixnum
     2412                             (arch::target-max-16-bit-constant-index arch)))
     2413                  (if is-signed
     2414                    (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
     2415                    (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
     2416                  (progn
     2417                    ;; scaled-idx
     2418                    (target-arch-case
     2419                     (:x8664
     2420                      (with-imm-target (unboxed-val-reg) scaled-idx
     2421                        (if index-known-fixnum
     2422                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     2423                          (! scale-16bit-misc-index scaled-idx unscaled-idx))
     2424                        (if is-signed
     2425                          (! misc-set-s16 unboxed-val-reg src scaled-idx)
     2426                          (! misc-set-u16 unboxed-val-reg src scaled-idx))))
     2427                     (:x8632
     2428                      (with-temporary-imm-target (src unscaled-idx) scaled-idx
     2429                        (if index-known-fixnum
     2430                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     2431                          (! scale-16bit-misc-index scaled-idx unscaled-idx))
     2432                          (if is-signed
     2433                            (! misc-set-s16 unboxed-val-reg src scaled-idx)
     2434                            (! misc-set-u16 unboxed-val-reg src scaled-idx))))))))
     2435               (is-8-bit
     2436                (if (and index-known-fixnum
     2437                         (<= index-known-fixnum
     2438                             (arch::target-max-8-bit-constant-index arch)))
     2439                  (if is-signed
     2440                    (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
     2441                    (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
     2442                  (progn
     2443                    ;; scaled-idx
     2444                    (target-arch-case
     2445                     (:x8664
     2446                      (with-imm-target (unboxed-val-reg) scaled-idx
     2447                        (if index-known-fixnum
     2448                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     2449                          (! scale-8bit-misc-index scaled-idx unscaled-idx))
     2450                        (if is-signed
     2451                          (! misc-set-s8 unboxed-val-reg src scaled-idx)
     2452                          (! misc-set-u8 unboxed-val-reg src scaled-idx))))
     2453                     (:x8632
     2454                      (with-temporary-imm-target (src unscaled-idx) scaled-idx
     2455                        (if index-known-fixnum
     2456                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     2457                          (! scale-8bit-misc-index scaled-idx unscaled-idx))
     2458                          (if is-signed
     2459                            (! misc-set-s8 unboxed-val-reg src scaled-idx)
     2460                            (! misc-set-u8 unboxed-val-reg src scaled-idx))))))))
     2461               (is-1-bit
     2462                (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     2463                  (if constval
     2464                    (if (zerop constval)
     2465                      (! set-constant-bit-to-zero src index-known-fixnum)
     2466                      (! set-constant-bit-to-one src index-known-fixnum))
     2467                    (progn
     2468                      (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
     2469                  (target-arch-case
     2470                   (:x8664
     2471                    (with-imm-temps () (word-index bit-number)
     2472                      (if index-known-fixnum
     2473                        (progn
     2474                          (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
     2475                          (x862-lri seg bit-number (logand index-known-fixnum #x63)))
     2476                        (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx))
     2477                      (if constval
     2478                        (if (zerop constval)
     2479                          (! set-variable-bit-to-zero src word-index bit-number)
     2480                          (! set-variable-bit-to-one src word-index bit-number))
     2481                        (progn
     2482                          (! set-variable-bit-to-variable-value src word-index bit-number val-reg)))))
     2483                   (:x8632
     2484                    (with-imm-temps () (word-index)
     2485                      (with-temporary-imm-target (src unscaled-idx) bit-number
     2486                        (if index-known-fixnum
     2487                          (progn
     2488                            (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
     2489                            (x862-lri seg bit-number (logand index-known-fixnum #x31)))
     2490                          (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx))
     2491                        (if constval
     2492                          (if (zerop constval)
     2493                            (! set-variable-bit-to-zero src word-index bit-number)
     2494                            (! set-variable-bit-to-one src word-index bit-number))
     2495                          (progn
     2496                            (! set-variable-bit-to-variable-value src word-index bit-number val-reg))))))))))))
    24292497      (when (and vreg val-reg) (<- val-reg))
    24302498      (^))))
     
    30513119      (declare (fixnum class mode))
    30523120      (cond ((= class hard-reg-class-fpr)
    3053              (make-wired-lreg x8664::fp1 :class class :mode mode))
     3121             (make-wired-lreg *x862-fp1* :class class :mode mode))
    30543122            ((= class hard-reg-class-gpr)
    30553123             (if (= mode hard-reg-class-gpr-mode-node)
     
    44754543                             (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
    44764544                       (t
    4477                         (with-imm-target () (ptr-reg :address)
    4478                           (with-imm-target (ptr-reg) (offsetreg :signed-natural)
    4479                             (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    4480                             (! fixnum->signed-natural offsetreg *x862-arg-z*)
    4481                             (case size
    4482                               (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg))
    4483                               (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
    4484                               (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
    4485                               (1 (! mem-set-constant-byte intval ptr-reg offsetreg)))))))
     4545                        (target-arch-case
     4546                         (:x8664
     4547                          (with-imm-target () (ptr-reg :address)
     4548                            (with-imm-target (ptr-reg) (offsetreg :signed-natural)
     4549                              (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4550                              (! fixnum->signed-natural offsetreg *x862-arg-z*)
     4551                              (case size
     4552                                (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg))
     4553                                (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
     4554                                (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
     4555                                (1 (! mem-set-constant-byte intval ptr-reg offsetreg))))))
     4556                         (:x8632
     4557                          (with-imm-target () (ptr-reg :address)
     4558                            (with-temporary-imm-target () (offsetreg :signed-natural)
     4559                              (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4560                              (! fixnum->signed-natural offsetreg *x862-arg-z*)
     4561                              (case size
     4562                                (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg))
     4563                                (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
     4564                                (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
     4565                                (1 (! mem-set-constant-byte intval ptr-reg offsetreg)))))))))
    44864566                 (if for-value
    44874567                   (ensuring-node-target (target vreg)
     
    45034583                   (<- *x862-arg-z*)))
    45044584                (t
    4505                  (with-imm-target () (ptr-reg :address)
    4506                    (with-imm-target (ptr-reg) (offset-reg :address)
    4507                      (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
    4508                      (! fixnum->signed-natural offset-reg *x862-arg-z*)
    4509                      (! fixnum-add2 ptr-reg offset-reg)
    4510                      (x862-push-register seg ptr-reg)))
     4585                 (target-arch-case
     4586                  (:x8664
     4587                   (with-imm-target () (ptr-reg :address)
     4588                     (with-imm-target (ptr-reg) (offset-reg :address)
     4589                       (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4590                       (! fixnum->signed-natural offset-reg *x862-arg-z*)
     4591                       (! fixnum-add2 ptr-reg offset-reg)
     4592                       (x862-push-register seg ptr-reg))))
     4593                  (:x8632
     4594                   (with-imm-target () (ptr-reg :address)
     4595                     (with-temporary-imm-target (*x862-arg-z*) (offset-reg :address)
     4596                       (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4597                       (! fixnum->signed-natural offset-reg *x862-arg-z*)
     4598                       (! fixnum-add2 ptr-reg offset-reg)
     4599                       (x862-push-register seg ptr-reg)))))
    45114600                 (val-to-argz-and-imm0)
    45124601                 (with-imm-target (*x862-imm0*) (ptr-reg :address)
     
    70787167                    (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line)))))
    70797168              (if otherform
    7080                 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))
     7169                (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*))
    70817170                (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*)))
    70827171              (-> done)
    70837172              (@ out-of-line)
    70847173              (if otherform
    7085                 (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))
     7174                (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*)))
    70867175              (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*))
    70877176              (@ done)
     
    77337822                    (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
    77347823                  (offval
    7735                     (with-imm-target () (src-reg :address)
    7736                       (x862-one-targeted-reg-form seg ptr src-reg)
    7737                       (target-arch-case
    7738                        (:x8632 (! mem-ref-c-fullword dest src-reg offval))
    7739                        (:x8664 (! mem-ref-c-doubleword dest src-reg offval)))))
     7824                   (target-arch-case
     7825                    (:x8664
     7826                     (with-imm-target () (src-reg :address)
     7827                       (x862-one-targeted-reg-form seg ptr src-reg)
     7828                       (! mem-ref-c-doubleword dest src-reg offval)))
     7829                    (:x8632
     7830                     (with-temporary-imm-target () (src-reg :address)
     7831                       (x862-one-targeted-reg-form seg ptr src-reg)
     7832                       (! mem-ref-c-fullword dest src-reg offval)))))
    77407833                  (t
    7741                    (with-imm-target () (src-reg :address)
    7742                      (with-imm-target (src-reg) (offset-reg :signed-natural)
    7743                        (x862-one-targeted-reg-form seg ptr src-reg)
    7744                        (if triv-p
    7745                          (if (acode-fixnum-form-p offset)
    7746                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7747                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7748                          (progn
    7749                            (! temp-push-unboxed-word src-reg)
    7750                            (x862-open-undo $undostkblk)
    7751                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7752                            (! temp-pop-unboxed-word src-reg)
    7753                            (x862-close-undo)))
    7754                        (target-arch-case
    7755                         (:x8632 (! mem-ref-fullword dest src-reg offset-reg))
    7756                         (:x8664 (! mem-ref-doubleword dest src-reg offset-reg)))))))
     7834                   (target-arch-case
     7835                    (:x8664
     7836                     (with-imm-target () (src-reg :address)
     7837                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     7838                         (x862-one-targeted-reg-form seg ptr src-reg)
     7839                         (if triv-p
     7840                           (if (acode-fixnum-form-p offset)
     7841                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7842                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7843                           (progn
     7844                             (! temp-push-unboxed-word src-reg)
     7845                             (x862-open-undo $undostkblk)
     7846                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7847                             (! temp-pop-unboxed-word src-reg)
     7848                             (x862-close-undo)))
     7849                         (! mem-ref-doubleword dest src-reg offset-reg))))
     7850                    (:x8632
     7851                     (with-temporary-imm-target () (src-reg :address)
     7852                       (with-temporary-imm-target (src-reg) (offset-reg :signed-natural)
     7853                         (x862-one-targeted-reg-form seg ptr src-reg)
     7854                         (if triv-p
     7855                           (if (acode-fixnum-form-p offset)
     7856                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7857                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7858                           (progn
     7859                             (! temp-push-unboxed-word src-reg)
     7860                             (x862-open-undo $undostkblk)
     7861                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7862                             (! temp-pop-unboxed-word src-reg)
     7863                             (x862-close-undo)))
     7864                         (! mem-ref-fullword dest src-reg offset-reg)))))))
    77577865                (if (node-reg-p vreg)
    77587866                  (! box-fixnum vreg dest)
     
    77687876                    (1 (! mem-ref-c-absolute-s8 dest absptr))))
    77697877                 (offval
    7770                   (with-imm-target (dest) (src-reg :address)
    7771                    (x862-one-targeted-reg-form seg ptr src-reg)
    7772                      (case size
    7773                        (8 (! mem-ref-c-signed-doubleword dest src-reg offval))
    7774                        (4 (! mem-ref-c-signed-fullword dest src-reg offval))
    7775                        (2 (! mem-ref-c-s16 dest src-reg offval))
    7776                        (1 (! mem-ref-c-s8 dest src-reg offval)))))
     7878                  (target-arch-case
     7879                   (:x8664
     7880                    (with-imm-target (dest) (src-reg :address)
     7881                      (x862-one-targeted-reg-form seg ptr src-reg)
     7882                      (case size
     7883                        (8 (! mem-ref-c-signed-doubleword dest src-reg offval))
     7884                        (4 (! mem-ref-c-signed-fullword dest src-reg offval))
     7885                        (2 (! mem-ref-c-s16 dest src-reg offval))
     7886                        (1 (! mem-ref-c-s8 dest src-reg offval)))))
     7887                   (:x8632
     7888                    (with-temporary-imm-target () (src-reg :address)
     7889                      (x862-one-targeted-reg-form seg ptr src-reg)
     7890                      (case size
     7891                        ;;(8 (! mem-ref-c-signed-doubleword dest src-reg offval))
     7892                        (4 (! mem-ref-c-signed-fullword dest src-reg offval))
     7893                        (2 (! mem-ref-c-s16 dest src-reg offval))
     7894                        (1 (! mem-ref-c-s8 dest src-reg offval)))))))
    77777895                 (t
    7778                   (with-imm-target () (src-reg :address)
    7779                     (with-imm-target (src-reg) (offset-reg :signed-natural)
    7780                      (x862-one-targeted-reg-form seg ptr src-reg)
    7781                      (if triv-p
    7782                        (if (acode-fixnum-form-p offset)
    7783                          (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7784                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7785                        (progn
    7786                          (! temp-push-unboxed-word src-reg)
    7787                          (x862-open-undo $undostkblk)
    7788                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7789                          (! temp-pop-unboxed-word src-reg)
    7790                          (x862-close-undo)))
    7791                   (case size
    7792                     (8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
    7793                     (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
    7794                     (2 (! mem-ref-s16 dest src-reg offset-reg))
    7795                     (1 (! mem-ref-s8 dest src-reg offset-reg)))))))
     7896                  (target-arch-case
     7897                   (:x8664
     7898                    (with-imm-target () (src-reg :address)
     7899                      (with-imm-target (src-reg) (offset-reg :signed-natural)
     7900                        (x862-one-targeted-reg-form seg ptr src-reg)
     7901                        (if triv-p
     7902                          (if (acode-fixnum-form-p offset)
     7903                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7904                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7905                          (progn
     7906                            (! temp-push-unboxed-word src-reg)
     7907                            (x862-open-undo $undostkblk)
     7908                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7909                            (! temp-pop-unboxed-word src-reg)
     7910                            (x862-close-undo)))
     7911                        (case size
     7912                          (8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
     7913                          (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
     7914                          (2 (! mem-ref-s16 dest src-reg offset-reg))
     7915                          (1 (! mem-ref-s8 dest src-reg offset-reg))))))
     7916                   (:x8632
     7917                    (with-temporary-imm-target () (src-reg :address)
     7918                      (with-temporary-imm-target (src-reg) (offset-reg :signed-natural)
     7919                        (x862-one-targeted-reg-form seg ptr src-reg)
     7920                        (if triv-p
     7921                          (if (acode-fixnum-form-p offset)
     7922                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7923                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7924                          (progn
     7925                            (! temp-push-unboxed-word src-reg)
     7926                            (x862-open-undo $undostkblk)
     7927                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7928                            (! temp-pop-unboxed-word src-reg)
     7929                            (x862-close-undo)))
     7930                        (case size
     7931                          ;;(8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
     7932                          (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
     7933                          (2 (! mem-ref-s16 dest src-reg offset-reg))
     7934                          (1 (! mem-ref-s8 dest src-reg offset-reg)))))))))
    77967935               (if (node-reg-p vreg)
    77977936                 (case size
     
    78127951                    (1 (! mem-ref-c-absolute-u8 dest absptr))))
    78137952                 (offval
    7814                   (with-imm-target (dest) (src-reg :address)
    7815                     (x862-one-targeted-reg-form seg ptr src-reg)
    7816                     (case size
    7817                       (8 (! mem-ref-c-doubleword dest src-reg offval))
    7818                       (4 (! mem-ref-c-fullword dest src-reg offval))
    7819                       (2 (! mem-ref-c-u16 dest src-reg offval))
    7820                       (1 (! mem-ref-c-u8 dest src-reg offval)))))
     7953                  (target-arch-case
     7954                   (:x8664
     7955                    (with-imm-target (dest) (src-reg :address)
     7956                      (x862-one-targeted-reg-form seg ptr src-reg)
     7957                      (case size
     7958                        (8 (! mem-ref-c-doubleword dest src-reg offval))
     7959                        (4 (! mem-ref-c-fullword dest src-reg offval))
     7960                        (2 (! mem-ref-c-u16 dest src-reg offval))
     7961                        (1 (! mem-ref-c-u8 dest src-reg offval)))))
     7962                   (:x8632
     7963                    (with-temporary-imm-target () (src-reg :address)
     7964                      (x862-one-targeted-reg-form seg ptr src-reg)
     7965                      (case size
     7966                        ;;(8 (! mem-ref-c-doubleword dest src-reg offval))
     7967                        (4 (! mem-ref-c-fullword dest src-reg offval))
     7968                        (2 (! mem-ref-c-u16 dest src-reg offval))
     7969                        (1 (! mem-ref-c-u8 dest src-reg offval)))))))
    78217970                 (t
    7822                   (with-imm-target () (src-reg :address)
    7823                     (with-imm-target (src-reg) (offset-reg :signed-natural)
    7824                      (x862-one-targeted-reg-form seg ptr src-reg)
    7825                      (if triv-p
    7826                        (if (acode-fixnum-form-p offset)
    7827                          (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7828                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7829                        (progn
    7830                          (! temp-push-unboxed-word src-reg)
    7831                          (x862-open-undo $undostkblk)
    7832                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7833                          (! temp-pop-unboxed-word src-reg)
    7834                          (x862-close-undo)))
    7835                   (case size
    7836                     (8 (! mem-ref-doubleword dest src-reg offset-reg))
    7837                     (4 (! mem-ref-fullword dest src-reg offset-reg))
    7838                     (2 (! mem-ref-u16 dest src-reg offset-reg))
    7839                     (1 (! mem-ref-u8 dest src-reg offset-reg)))))))
    7840                   (<- (set-regspec-mode
    7841                        dest
     7971                  (target-arch-case
     7972                   (:x8664
     7973                    (with-imm-target () (src-reg :address)
     7974                      (with-imm-target (src-reg) (offset-reg :signed-natural)
     7975                        (x862-one-targeted-reg-form seg ptr src-reg)
     7976                        (if triv-p
     7977                          (if (acode-fixnum-form-p offset)
     7978                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7979                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7980                          (progn
     7981                            (! temp-push-unboxed-word src-reg)
     7982                            (x862-open-undo $undostkblk)
     7983                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7984                            (! temp-pop-unboxed-word src-reg)
     7985                            (x862-close-undo)))
     7986                        (case size
     7987                          (8 (! mem-ref-doubleword dest src-reg offset-reg))
     7988                          (4 (! mem-ref-fullword dest src-reg offset-reg))
     7989                          (2 (! mem-ref-u16 dest src-reg offset-reg))
     7990                          (1 (! mem-ref-u8 dest src-reg offset-reg))))))
     7991                   (:x8632
     7992                    (with-temporary-imm-target () (src-reg :address)
     7993                      (with-temporary-imm-target (src-reg) (offset-reg :signed-natural)
     7994                        (x862-one-targeted-reg-form seg ptr src-reg)
     7995                        (if triv-p
     7996                          (if (acode-fixnum-form-p offset)
     7997                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7998                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7999                          (progn
     8000                            (! temp-push-unboxed-word src-reg)
     8001                            (x862-open-undo $undostkblk)
     8002                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     8003                            (! temp-pop-unboxed-word src-reg)
     8004                            (x862-close-undo)))
     8005                        (case size
     8006                          ;;(8 (! mem-ref-doubleword dest src-reg offset-reg))
     8007                          (4 (! mem-ref-fullword dest src-reg offset-reg))
     8008                          (2 (! mem-ref-u16 dest src-reg offset-reg))
     8009                          (1 (! mem-ref-u8 dest src-reg offset-reg)))))))
     8010                  (<- (set-regspec-mode
     8011                       dest
    78428012                       (gpr-mode-name-value
    78438013                        (case size
     
    78458015                          (4 :u32)
    78468016                          (2 :u16)
    7847                           (1 :u8))))))))
     8017                          (1 :u8))))))))))
    78488018           (^)))))
    78498019
     
    79358105                                    *x862-temp0*
    79368106                                    (progn
    7937                                       (x862-addrspec-to-reg seg v-ea x8664::temp1)
    7938                                       x8664::temp1))))
     8107                                      (x862-addrspec-to-reg seg v-ea *x862-temp1*)
     8108                                      *x862-temp1*))))
    79398109                    (! set-closure-forward-reference val-reg *x862-temp0* (car r)))))))
    79408110          (x862-undo-body seg vreg xfer body old-stack)
     
    82988468                                         k ($ *x862-arg-y*)
    82998469                                         new ($ *x862-arg-z*))
    8300            (x862-pop-register seg ($ x8664::temp1))
     8470           (x862-pop-register seg ($ *x862-temp1*))
    83018471           (x862-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset3))))))
    83028472
     
    85438713(defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval)
    85448714  (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*))
    8545   (let* ((target ($ x8664::fp1 :class :fpr :mode :double-float))
     8715  (let* ((target ($ *x862-fp1* :class :fpr :mode :double-float))
    85468716         (node ($ *x862-arg-z*)))
    85478717    (x862-one-targeted-reg-form seg fval target)
     
    86858855                (unless triv-by
    86868856                  (x862-pop-register seg ptr-reg))
    8687                 (with-imm-target (ptr-reg) (by-reg :signed-natural)
    8688                   (! fixnum->signed-natural by-reg boxed-by)
    8689                   (let* ((result ptr-reg))
    8690                     (! fixnum-add2 result by-reg)
    8691                     (<- result))))))
     8857                (target-arch-case
     8858                 (:x8664
     8859                  (with-imm-target (ptr-reg) (by-reg :signed-natural)
     8860                    (! fixnum->signed-natural by-reg boxed-by)
     8861                    (let* ((result ptr-reg))
     8862                      (! fixnum-add2 result by-reg)
     8863                      (<- result))))
     8864                 (:x8632
     8865                  (with-temporary-imm-target (boxed-by) (by-reg :signed-natural)
     8866                    (! fixnum->signed-natural by-reg boxed-by)
     8867                    (let* ((result ptr-reg))
     8868                      (! fixnum-add2 result by-reg)
     8869                      (<- result))))))))
    86928870        (^)))))
    86938871
     
    87918969      (^)))
    87928970
     8971#+nil
     8972(defx862 x862-i386-ff-call i386-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
     8973  (declare (ignore monitor))
     8974  ;; a placeholder
     8975)
    87938976
    87948977(defx862 x862-ff-call ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
     
    88579040               (x862-vpush-register seg reg)))
    88589041            (:double-float
    8859              (let* ((df ($ x8664::fp1 :class :fpr :mode :double-float)))
     9042             (let* ((df ($ *x862-fp1* :class :fpr :mode :double-float)))
    88609043               (incf nfpr-args)
    88619044               (x862-one-targeted-reg-form seg valform df )
     
    88689051                      (incf other-offset)))))
    88699052            (:single-float
    8870              (let* ((sf ($ x8664::fp1 :class :fpr :mode :single-float)))
     9053             (let* ((sf ($ *x862-fp1* :class :fpr :mode :single-float)))
    88719054               (incf nfpr-args)
    88729055               (x862-one-targeted-reg-form
Note: See TracChangeset for help on using the changeset viewer.