Changeset 7665


Ignore:
Timestamp:
Nov 16, 2007, 11:45:20 PM (12 years ago)
Author:
rme
Message:

Undo change committed in r7661. What a botch.

File:
1 edited

Legend:

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

    r7661 r7665  
    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))))
    5645
    5746
     
    199188(defvar *x862-allocptr* nil)
    200189
    201 (defvar *x862-fp1* nil)
    202 
    203190(declaim (fixnum *x862-vstack* *x862-cstack*))
    204191
     
    500487                                              (:x8664 x8664::allocptr)))
    501488           
    502            (*x862-fp1* (target-arch-case (:x8632 x8632::fp1)
    503                                          (:x8664 x8664::fp1)))
     489
    504490           (*x862-target-num-arg-regs* (target-arch-case
    505491                                        (:x8632 $numx8632argregs)
     
    23162302                   reg)))))))
    23172303
     2304
    23182305;;; xxx
    23192306(defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization)
     
    23502337                   (! misc-set-node val-reg src unscaled-idx)))))
    23512338            (t
    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))))))))))))
     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))))))))))
    24972429      (when (and vreg val-reg) (<- val-reg))
    24982430      (^))))
     
    31193051      (declare (fixnum class mode))
    31203052      (cond ((= class hard-reg-class-fpr)
    3121              (make-wired-lreg *x862-fp1* :class class :mode mode))
     3053             (make-wired-lreg x8664::fp1 :class class :mode mode))
    31223054            ((= class hard-reg-class-gpr)
    31233055             (if (= mode hard-reg-class-gpr-mode-node)
     
    45434475                             (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
    45444476                       (t
    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)))))))))
     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)))))))
    45664486                 (if for-value
    45674487                   (ensuring-node-target (target vreg)
     
    45834503                   (<- *x862-arg-z*)))
    45844504                (t
    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)))))
     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)))
    46004511                 (val-to-argz-and-imm0)
    46014512                 (with-imm-target (*x862-imm0*) (ptr-reg :address)
     
    71677078                    (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line)))))
    71687079              (if otherform
    7169                 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*))
     7080                (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))
    71707081                (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*)))
    71717082              (-> done)
    71727083              (@ out-of-line)
    71737084              (if otherform
    7174                 (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*)))
     7085                (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))
    71757086              (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*))
    71767087              (@ done)
     
    78227733                    (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
    78237734                  (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)))))
     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)))))
    78337740                  (t
    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)))))))
     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)))))))
    78657757                (if (node-reg-p vreg)
    78667758                  (! box-fixnum vreg dest)
     
    78767768                    (1 (! mem-ref-c-absolute-s8 dest absptr))))
    78777769                 (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)))))))
     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)))))
    78957777                 (t
    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)))))))))
     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)))))))
    79357796               (if (node-reg-p vreg)
    79367797                 (case size
     
    79517812                    (1 (! mem-ref-c-absolute-u8 dest absptr))))
    79527813                 (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)))))))
     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)))))
    79707821                 (t
    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
     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
    80127842                       (gpr-mode-name-value
    80137843                        (case size
     
    80157845                          (4 :u32)
    80167846                          (2 :u16)
    8017                           (1 :u8))))))))))
     7847                          (1 :u8))))))))
    80187848           (^)))))
    80197849
     
    81057935                                    *x862-temp0*
    81067936                                    (progn
    8107                                       (x862-addrspec-to-reg seg v-ea *x862-temp1*)
    8108                                       *x862-temp1*))))
     7937                                      (x862-addrspec-to-reg seg v-ea x8664::temp1)
     7938                                      x8664::temp1))))
    81097939                    (! set-closure-forward-reference val-reg *x862-temp0* (car r)))))))
    81107940          (x862-undo-body seg vreg xfer body old-stack)
     
    84688298                                         k ($ *x862-arg-y*)
    84698299                                         new ($ *x862-arg-z*))
    8470            (x862-pop-register seg ($ *x862-temp1*))
     8300           (x862-pop-register seg ($ x8664::temp1))
    84718301           (x862-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset3))))))
    84728302
     
    87138543(defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval)
    87148544  (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*))
    8715   (let* ((target ($ *x862-fp1* :class :fpr :mode :double-float))
     8545  (let* ((target ($ x8664::fp1 :class :fpr :mode :double-float))
    87168546         (node ($ *x862-arg-z*)))
    87178547    (x862-one-targeted-reg-form seg fval target)
     
    88558685                (unless triv-by
    88568686                  (x862-pop-register seg ptr-reg))
    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))))))))
     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))))))
    88708692        (^)))))
    88718693
     
    89698791      (^)))
    89708792
    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 )
    89768793
    89778794(defx862 x862-ff-call ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)
     
    90408857               (x862-vpush-register seg reg)))
    90418858            (:double-float
    9042              (let* ((df ($ *x862-fp1* :class :fpr :mode :double-float)))
     8859             (let* ((df ($ x8664::fp1 :class :fpr :mode :double-float)))
    90438860               (incf nfpr-args)
    90448861               (x862-one-targeted-reg-form seg valform df )
     
    90518868                      (incf other-offset)))))
    90528869            (:single-float
    9053              (let* ((sf ($ *x862-fp1* :class :fpr :mode :single-float)))
     8870             (let* ((sf ($ x8664::fp1 :class :fpr :mode :single-float)))
    90548871               (incf nfpr-args)
    90558872               (x862-one-targeted-reg-form
Note: See TracChangeset for help on using the changeset viewer.