Changeset 7707


Ignore:
Timestamp:
Nov 21, 2007, 8:31:42 PM (12 years ago)
Author:
rme
Message:

Define WITH-ADDITIONAL-IMM-REG and use it in a few places.

File:
1 edited

Legend:

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

    r7666 r7707  
    4242(defparameter *x862-operator-supports-push* ())
    4343
    44 
    45 
     44;; probably should be elsewhere
     45
     46(defmacro with-additional-imm-reg ((&rest reserved) &body body)
     47  (let ((node (gensym))
     48        (bit (gensym)))
     49    `(target-arch-case
     50      (:x8632
     51       (with-node-target (,@reserved) ,node
     52         (let* ((,bit (ash 1 (hard-regspec-value ,node)))
     53                (*backend-node-temps* (logandc2 *backend-node-temps* ,bit))
     54                (*available-backend-node-temps* (logandc2 *available-backend-node-temps* ,bit))
     55                (*backend-imm-temps* (logior *backend-imm-temps* ,bit))
     56                (*available-backend-imm-temps* (logior *available-backend-imm-temps* ,bit)))
     57           (! mark-as-imm ,node)
     58           ,@body
     59           (! mark-as-node ,node))))
     60      (:x8664
     61       (let ()
     62         ,@body)))))
    4663
    4764 
     
    23372354                   (! misc-set-node val-reg src unscaled-idx)))))
    23382355            (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))))))))))
     2356             (with-additional-imm-reg (src unscaled-idx val-reg)
     2357               (with-imm-target (unboxed-val-reg) scaled-idx
     2358                 (cond
     2359                   (is-64-bit
     2360                    (if (and index-known-fixnum
     2361                             (<= index-known-fixnum
     2362                                 (arch::target-max-64-bit-constant-index arch)))
     2363                      (if (eq type-keyword :double-float-vector)
     2364                        (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum)
     2365                        (if is-signed
     2366                          (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum)
     2367                          (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum)))
     2368                      (progn
     2369                        (if index-known-fixnum
     2370                          (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))))
     2371                        (if (eq type-keyword :double-float-vector)
     2372                          (! misc-set-double-float unboxed-val-reg src unscaled-idx)
     2373                          (if is-signed
     2374                            (! misc-set-s64 unboxed-val-reg src unscaled-idx)
     2375                            (! misc-set-u64 unboxed-val-reg src unscaled-idx))))))
     2376                   (is-32-bit
     2377                    (if (and index-known-fixnum
     2378                             (<= index-known-fixnum
     2379                                 (arch::target-max-32-bit-constant-index arch)))
     2380                      (if (eq type-keyword :single-float-vector)
     2381                        (if (eq (hard-regspec-class unboxed-val-reg)
     2382                                hard-reg-class-fpr)
     2383                          (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum)
     2384                          (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))
     2385                        (if is-signed
     2386                          (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum)
     2387                          (! misc-set-c-u32 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 2)))
     2391                          (! scale-32bit-misc-index scaled-idx unscaled-idx))
     2392                        (if (and (eq type-keyword :single-float-vector)
     2393                                 (eql (hard-regspec-class unboxed-val-reg)
     2394                                      hard-reg-class-fpr))
     2395                          (! misc-set-single-float unboxed-val-reg src scaled-idx)
     2396                          (if is-signed
     2397                            (! misc-set-s32 unboxed-val-reg src scaled-idx)
     2398                            (! misc-set-u32 unboxed-val-reg src scaled-idx))))))
     2399                   (is-16-bit
     2400                    (if (and index-known-fixnum
     2401                             (<= index-known-fixnum
     2402                                 (arch::target-max-16-bit-constant-index arch)))
     2403                      (if is-signed
     2404                        (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum)
     2405                        (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum))
     2406                      (progn
     2407                        (if index-known-fixnum
     2408                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1)))
     2409                          (! scale-16bit-misc-index scaled-idx unscaled-idx))
     2410                        (if is-signed
     2411                          (! misc-set-s16 unboxed-val-reg src scaled-idx)
     2412                          (! misc-set-u16 unboxed-val-reg src scaled-idx)))))
     2413                   (is-8-bit
     2414                    (if (and index-known-fixnum
     2415                             (<= index-known-fixnum
     2416                                 (arch::target-max-8-bit-constant-index arch)))
     2417                      (if is-signed
     2418                        (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum)
     2419                        (! misc-set-c-u8  unboxed-val-reg src index-known-fixnum))
     2420                      (progn
     2421                        (if index-known-fixnum
     2422                          (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum))
     2423                          (! scale-8bit-misc-index scaled-idx unscaled-idx))
     2424                        (if is-signed
     2425                          (! misc-set-s8 unboxed-val-reg src scaled-idx)
     2426                          (! misc-set-u8 unboxed-val-reg src scaled-idx)))))
     2427                   (is-1-bit
     2428                    (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch)))
     2429                      (if constval
     2430                        (if (zerop constval)
     2431                          (! set-constant-bit-to-zero src index-known-fixnum)
     2432                          (! set-constant-bit-to-one src index-known-fixnum))
     2433                        (progn
     2434                          (! set-constant-bit-to-variable-value src index-known-fixnum val-reg)))
     2435                      (with-imm-temps () (word-index bit-number)
     2436                        (if index-known-fixnum
     2437                          (progn
     2438                            (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6)))
     2439                            (x862-lri seg bit-number (logand index-known-fixnum #x63)))
     2440                          (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx))
     2441                        (if constval
     2442                          (if (zerop constval)
     2443                            (! set-variable-bit-to-zero src word-index bit-number)
     2444                            (! set-variable-bit-to-one src word-index bit-number))
     2445                          (progn
     2446                            (! set-variable-bit-to-variable-value src word-index bit-number val-reg)))))))))))
    24292447      (when (and vreg val-reg) (<- val-reg))
    24302448      (^))))
     
    44634481                 (1
    44644482                  (if (>= intval 128) (setq intval (- intval 256))))))
    4465           (cond (intval
    4466                  (cond (offval
    4467                         (with-imm-target () (ptr-reg :address)
    4468                          (let* ((ptr-reg (x862-one-untargeted-reg-form seg
    4469                                                                        ptr
    4470                                                                        ptr-reg)))
    4471                            (case size
    4472                              (8 (! mem-set-c-constant-doubleword signed-intval ptr-reg offval))
    4473                              (4 (! mem-set-c-constant-fullword signed-intval ptr-reg offval))
    4474                              (2 (! mem-set-c-constant-halfword signed-intval ptr-reg offval))
    4475                              (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
    4476                        (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)))))))
    4486                  (if for-value
    4487                    (ensuring-node-target (target vreg)
    4488                     (x862-lri seg vreg (ash intval *x862-target-fixnum-shift*)))))
    4489                 (offval
    4490                  ;; simpler thant the general case
    4491                  (with-imm-target () (ptr-reg :address)
    4492                    (x862-push-register seg
    4493                                        (x862-one-untargeted-reg-form seg ptr ptr-reg)))
    4494                  (val-to-argz-and-imm0)
    4495                  (with-imm-target (*x862-imm0*) (ptr-reg :address)
    4496                    (x862-pop-register seg ptr-reg)
    4497                    (case size
    4498                      (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg offval))
    4499                      (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval))
    4500                      (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval))
    4501                      (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))
    4502                  (if for-value
    4503                    (<- *x862-arg-z*)))
    4504                 (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)))
    4511                  (val-to-argz-and-imm0)
    4512                  (with-imm-target (*x862-imm0*) (ptr-reg :address)
    4513                    (x862-pop-register seg ptr-reg)
    4514                    (case size
    4515                      (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg 0))
    4516                      (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0))
    4517                      (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0))
    4518                      (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))
    4519                  (if for-value
    4520                    (< *x862-arg-z*))))
     4483          (with-additional-imm-reg ()
     4484            (cond (intval
     4485                   (cond (offval
     4486                          (with-imm-target () (ptr-reg :address)
     4487                            (let* ((ptr-reg (x862-one-untargeted-reg-form seg
     4488                                                                          ptr
     4489                                                                          ptr-reg)))
     4490                              (case size
     4491                                (8 (! mem-set-c-constant-doubleword signed-intval ptr-reg offval))
     4492                                (4 (! mem-set-c-constant-fullword signed-intval ptr-reg offval))
     4493                                (2 (! mem-set-c-constant-halfword signed-intval ptr-reg offval))
     4494                                (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval))))))
     4495                         (t
     4496                          (with-imm-target () (ptr-reg :address)
     4497                            (with-imm-target (ptr-reg) (offsetreg :signed-natural)
     4498                              (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4499                              (! fixnum->signed-natural offsetreg *x862-arg-z*)
     4500                              (case size
     4501                                (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg))
     4502                                (4 (! mem-set-constant-fullword intval ptr-reg offsetreg))
     4503                                (2 (! mem-set-constant-halfword intval ptr-reg offsetreg))
     4504                                (1 (! mem-set-constant-byte intval ptr-reg offsetreg)))))))
     4505                   (if for-value
     4506                     (ensuring-node-target (target vreg)
     4507                       (x862-lri seg vreg (ash intval *x862-target-fixnum-shift*)))))
     4508                  (offval
     4509                   ;; simpler thant the general case
     4510                   (with-imm-target () (ptr-reg :address)
     4511                     (x862-push-register seg
     4512                                         (x862-one-untargeted-reg-form seg ptr ptr-reg)))
     4513                   (val-to-argz-and-imm0)
     4514                   (with-imm-target (*x862-imm0*) (ptr-reg :address)
     4515                     (x862-pop-register seg ptr-reg)
     4516                     (case size
     4517                       (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg offval))
     4518                       (4 (! mem-set-c-fullword *x862-imm0* ptr-reg offval))
     4519                       (2 (! mem-set-c-halfword *x862-imm0* ptr-reg offval))
     4520                       (1 (! mem-set-c-byte *x862-imm0* ptr-reg offval))))
     4521                   (if for-value
     4522                     (<- *x862-arg-z*)))
     4523                  (t
     4524                   (with-imm-target () (ptr-reg :address)
     4525                     (with-imm-target (ptr-reg) (offset-reg :address)
     4526                       (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
     4527                       (! fixnum->signed-natural offset-reg *x862-arg-z*)
     4528                       (! fixnum-add2 ptr-reg offset-reg)
     4529                       (x862-push-register seg ptr-reg)))
     4530                   (val-to-argz-and-imm0)
     4531                   (with-imm-target (*x862-imm0*) (ptr-reg :address)
     4532                     (x862-pop-register seg ptr-reg)
     4533                     (case size
     4534                       (8 (! mem-set-c-doubleword *x862-imm0* ptr-reg 0))
     4535                       (4 (! mem-set-c-fullword *x862-imm0* ptr-reg 0))
     4536                       (2 (! mem-set-c-halfword *x862-imm0* ptr-reg 0))
     4537                       (1 (! mem-set-c-byte *x862-imm0* ptr-reg 0))))
     4538                   (if for-value
     4539                     (< *x862-arg-z*)))))
    45214540
    45224541          (^))))))
     
    77347753                      (and offval (logtest 3 offval) (setq offval nil))
    77357754                      (and absptr (logtest 3 absptr) (setq absptr nil)))))
    7736            (cond
    7737              (fixnump
    7738               (with-imm-target () (dest :signed-natural)
    7739                 (cond
    7740                   (absptr                             
    7741                    (target-arch-case
    7742                     (:x8632 (! mem-ref-c-absolute-fullword dest absptr))
    7743                     (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
    7744                   (offval
    7745                     (with-imm-target () (src-reg :address)
    7746                       (x862-one-targeted-reg-form seg ptr src-reg)
    7747                       (target-arch-case
    7748                        (:x8632 (! mem-ref-c-fullword dest src-reg offval))
    7749                        (:x8664 (! mem-ref-c-doubleword dest src-reg offval)))))
    7750                   (t
    7751                    (with-imm-target () (src-reg :address)
    7752                      (with-imm-target (src-reg) (offset-reg :signed-natural)
    7753                        (x862-one-targeted-reg-form seg ptr src-reg)
    7754                        (if triv-p
    7755                          (if (acode-fixnum-form-p offset)
    7756                            (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7757                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7758                          (progn
    7759                            (! temp-push-unboxed-word src-reg)
    7760                            (x862-open-undo $undostkblk)
    7761                            (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7762                            (! temp-pop-unboxed-word src-reg)
    7763                            (x862-close-undo)))
    7764                        (target-arch-case
    7765                         (:x8632 (! mem-ref-fullword dest src-reg offset-reg))
    7766                         (:x8664 (! mem-ref-doubleword dest src-reg offset-reg)))))))
    7767                 (if (node-reg-p vreg)
    7768                   (! box-fixnum vreg dest)
    7769                   (<- dest))))
    7770              (signed
    7771               (with-imm-target () (dest :signed-natural)
    7772                (cond
    7773                  (absptr
    7774                   (case size
    7775                     (8 (! mem-ref-c-absolute-signed-doubleword dest absptr))
    7776                     (4 (! mem-ref-c-absolute-signed-fullword dest  absptr))
    7777                     (2 (! mem-ref-c-absolute-s16 dest absptr))
    7778                     (1 (! mem-ref-c-absolute-s8 dest absptr))))
    7779                  (offval
    7780                   (with-imm-target (dest) (src-reg :address)
    7781                    (x862-one-targeted-reg-form seg ptr src-reg)
    7782                      (case size
    7783                        (8 (! mem-ref-c-signed-doubleword dest src-reg offval))
    7784                        (4 (! mem-ref-c-signed-fullword dest src-reg offval))
    7785                        (2 (! mem-ref-c-s16 dest src-reg offval))
    7786                        (1 (! mem-ref-c-s8 dest src-reg offval)))))
    7787                  (t
    7788                   (with-imm-target () (src-reg :address)
    7789                     (with-imm-target (src-reg) (offset-reg :signed-natural)
    7790                      (x862-one-targeted-reg-form seg ptr src-reg)
    7791                      (if triv-p
    7792                        (if (acode-fixnum-form-p offset)
    7793                          (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7794                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7795                        (progn
    7796                          (! temp-push-unboxed-word src-reg)
    7797                          (x862-open-undo $undostkblk)
    7798                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7799                          (! temp-pop-unboxed-word src-reg)
    7800                          (x862-close-undo)))
    7801                   (case size
    7802                     (8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
    7803                     (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
    7804                     (2 (! mem-ref-s16 dest src-reg offset-reg))
    7805                     (1 (! mem-ref-s8 dest src-reg offset-reg)))))))
    7806                (if (node-reg-p vreg)
    7807                  (case size
    7808                    ((1 2) (! box-fixnum vreg dest))
    7809                    (4 (target-arch-case
    7810                        (:x8632 (<- dest))
    7811                        (:x8664 (! box-fixnum vreg dest))))
    7812                    (8 (<- dest)))
    7813                  (<- dest))))
    7814              (t
    7815               (with-imm-target () (dest :natural)
    7816                (cond
    7817                  (absptr
    7818                   (case size
    7819                     (8 (! mem-ref-c-absolute-doubleword dest absptr))
    7820                     (4 (! mem-ref-c-absolute-fullword dest absptr))
    7821                     (2 (! mem-ref-c-absolute-u16 dest absptr))
    7822                     (1 (! mem-ref-c-absolute-u8 dest absptr))))
    7823                  (offval
    7824                   (with-imm-target (dest) (src-reg :address)
    7825                     (x862-one-targeted-reg-form seg ptr src-reg)
    7826                     (case size
    7827                       (8 (! mem-ref-c-doubleword dest src-reg offval))
    7828                       (4 (! mem-ref-c-fullword dest src-reg offval))
    7829                       (2 (! mem-ref-c-u16 dest src-reg offval))
    7830                       (1 (! mem-ref-c-u8 dest src-reg offval)))))
    7831                  (t
    7832                   (with-imm-target () (src-reg :address)
    7833                     (with-imm-target (src-reg) (offset-reg :signed-natural)
    7834                      (x862-one-targeted-reg-form seg ptr src-reg)
    7835                      (if triv-p
    7836                        (if (acode-fixnum-form-p offset)
    7837                          (x862-lri seg offset-reg (acode-fixnum-form-p offset))
    7838                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
    7839                        (progn
    7840                          (! temp-push-unboxed-word src-reg)
    7841                          (x862-open-undo $undostkblk)
    7842                          (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
    7843                          (! temp-pop-unboxed-word src-reg)
    7844                          (x862-close-undo)))
    7845                   (case size
    7846                     (8 (! mem-ref-doubleword dest src-reg offset-reg))
    7847                     (4 (! mem-ref-fullword dest src-reg offset-reg))
    7848                     (2 (! mem-ref-u16 dest src-reg offset-reg))
    7849                     (1 (! mem-ref-u8 dest src-reg offset-reg)))))))
    7850                   (<- (set-regspec-mode
    7851                        dest
    7852                        (gpr-mode-name-value
    7853                         (case size
    7854                           (8 :u64)
    7855                           (4 :u32)
    7856                           (2 :u16)
    7857                           (1 :u8))))))))
     7755           (with-additional-imm-reg ()
     7756             (cond
     7757               (fixnump
     7758                (with-imm-target () (dest :signed-natural)
     7759                  (cond
     7760                    (absptr                             
     7761                     (target-arch-case
     7762                      (:x8632 (! mem-ref-c-absolute-fullword dest absptr))
     7763                      (:x8664 (! mem-ref-c-absolute-doubleword dest  absptr))))
     7764                    (offval
     7765                     (with-imm-target () (src-reg :address)
     7766                       (x862-one-targeted-reg-form seg ptr src-reg)
     7767                       (target-arch-case
     7768                        (:x8632 (! mem-ref-c-fullword dest src-reg offval))
     7769                        (:x8664 (! mem-ref-c-doubleword dest src-reg offval)))))
     7770                    (t
     7771                     (with-imm-target () (src-reg :address)
     7772                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     7773                         (x862-one-targeted-reg-form seg ptr src-reg)
     7774                         (if triv-p
     7775                           (if (acode-fixnum-form-p offset)
     7776                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7777                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7778                           (progn
     7779                             (! temp-push-unboxed-word src-reg)
     7780                             (x862-open-undo $undostkblk)
     7781                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7782                             (! temp-pop-unboxed-word src-reg)
     7783                             (x862-close-undo)))
     7784                         (target-arch-case
     7785                          (:x8632 (! mem-ref-fullword dest src-reg offset-reg))
     7786                          (:x8664 (! mem-ref-doubleword dest src-reg offset-reg)))))))
     7787                  (if (node-reg-p vreg)
     7788                    (! box-fixnum vreg dest)
     7789                    (<- dest))))
     7790               (signed
     7791                (with-imm-target () (dest :signed-natural)
     7792                  (cond
     7793                    (absptr
     7794                     (case size
     7795                       (8 (! mem-ref-c-absolute-signed-doubleword dest absptr))
     7796                       (4 (! mem-ref-c-absolute-signed-fullword dest  absptr))
     7797                       (2 (! mem-ref-c-absolute-s16 dest absptr))
     7798                       (1 (! mem-ref-c-absolute-s8 dest absptr))))
     7799                    (offval
     7800                     (with-imm-target (dest) (src-reg :address)
     7801                       (x862-one-targeted-reg-form seg ptr src-reg)
     7802                       (case size
     7803                         (8 (! mem-ref-c-signed-doubleword dest src-reg offval))
     7804                         (4 (! mem-ref-c-signed-fullword dest src-reg offval))
     7805                         (2 (! mem-ref-c-s16 dest src-reg offval))
     7806                         (1 (! mem-ref-c-s8 dest src-reg offval)))))
     7807                    (t
     7808                     (with-imm-target () (src-reg :address)
     7809                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     7810                         (x862-one-targeted-reg-form seg ptr src-reg)
     7811                         (if triv-p
     7812                           (if (acode-fixnum-form-p offset)
     7813                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7814                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7815                           (progn
     7816                             (! temp-push-unboxed-word src-reg)
     7817                             (x862-open-undo $undostkblk)
     7818                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7819                             (! temp-pop-unboxed-word src-reg)
     7820                             (x862-close-undo)))
     7821                         (case size
     7822                           (8 (! mem-ref-signed-doubleword dest src-reg offset-reg))
     7823                           (4 (! mem-ref-signed-fullword dest src-reg offset-reg))
     7824                           (2 (! mem-ref-s16 dest src-reg offset-reg))
     7825                           (1 (! mem-ref-s8 dest src-reg offset-reg)))))))
     7826                  (if (node-reg-p vreg)
     7827                    (case size
     7828                      ((1 2) (! box-fixnum vreg dest))
     7829                      (4 (target-arch-case
     7830                          (:x8632 (<- dest))
     7831                          (:x8664 (! box-fixnum vreg dest))))
     7832                      (8 (<- dest)))
     7833                    (<- dest))))
     7834               (t
     7835                (with-imm-target () (dest :natural)
     7836                  (cond
     7837                    (absptr
     7838                     (case size
     7839                       (8 (! mem-ref-c-absolute-doubleword dest absptr))
     7840                       (4 (! mem-ref-c-absolute-fullword dest absptr))
     7841                       (2 (! mem-ref-c-absolute-u16 dest absptr))
     7842                       (1 (! mem-ref-c-absolute-u8 dest absptr))))
     7843                    (offval
     7844                     (with-imm-target (dest) (src-reg :address)
     7845                       (x862-one-targeted-reg-form seg ptr src-reg)
     7846                       (case size
     7847                         (8 (! mem-ref-c-doubleword dest src-reg offval))
     7848                         (4 (! mem-ref-c-fullword dest src-reg offval))
     7849                         (2 (! mem-ref-c-u16 dest src-reg offval))
     7850                         (1 (! mem-ref-c-u8 dest src-reg offval)))))
     7851                    (t
     7852                     (with-imm-target () (src-reg :address)
     7853                       (with-imm-target (src-reg) (offset-reg :signed-natural)
     7854                         (x862-one-targeted-reg-form seg ptr src-reg)
     7855                         (if triv-p
     7856                           (if (acode-fixnum-form-p offset)
     7857                             (x862-lri seg offset-reg (acode-fixnum-form-p offset))
     7858                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
     7859                           (progn
     7860                             (! temp-push-unboxed-word src-reg)
     7861                             (x862-open-undo $undostkblk)
     7862                             (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))
     7863                             (! temp-pop-unboxed-word src-reg)
     7864                             (x862-close-undo)))
     7865                         (case size
     7866                           (8 (! mem-ref-doubleword dest src-reg offset-reg))
     7867                           (4 (! mem-ref-fullword dest src-reg offset-reg))
     7868                           (2 (! mem-ref-u16 dest src-reg offset-reg))
     7869                           (1 (! mem-ref-u8 dest src-reg offset-reg)))))))
     7870                  (<- (set-regspec-mode
     7871                       dest
     7872                       (gpr-mode-name-value
     7873                        (case size
     7874                          (8 :u64)
     7875                          (4 :u32)
     7876                          (2 :u16)
     7877                          (1 :u8)))))))))
    78587878           (^)))))
    78597879
     
    86958715                (unless triv-by
    86968716                  (x862-pop-register seg ptr-reg))
    8697                 (with-imm-target (ptr-reg) (by-reg :signed-natural)
    8698                   (! fixnum->signed-natural by-reg boxed-by)
    8699                   (let* ((result ptr-reg))
    8700                     (! fixnum-add2 result by-reg)
    8701                     (<- result))))))
     8717                (with-additional-imm-reg ()
     8718                  (with-imm-target (ptr-reg) (by-reg :signed-natural)
     8719                    (! fixnum->signed-natural by-reg boxed-by)
     8720                    (let* ((result ptr-reg))
     8721                      (! fixnum-add2 result by-reg)
     8722                      (<- result)))))))
    87028723        (^)))))
    87038724
Note: See TracChangeset for help on using the changeset viewer.