- Timestamp:
- Nov 16, 2007, 3:45:20 PM (17 years ago)
- File:
-
- 1 edited
-
branches/ia32/compiler/X86/x862.lisp (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/ia32/compiler/X86/x862.lisp
r7661 r7665 43 43 44 44 45 ;; probably belongs elsewhere46 (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) ,node51 (! mark-as-imm ,node)52 (let* ((,name (set-regspec-mode ,node53 (gpr-mode-name-value ,mode-name))))54 ,@body)55 (! mark-as-node ,node))))56 45 57 46 … … 199 188 (defvar *x862-allocptr* nil) 200 189 201 (defvar *x862-fp1* nil)202 203 190 (declaim (fixnum *x862-vstack* *x862-cstack*)) 204 191 … … 500 487 (:x8664 x8664::allocptr))) 501 488 502 (*x862-fp1* (target-arch-case (:x8632 x8632::fp1) 503 (:x8664 x8664::fp1))) 489 504 490 (*x862-target-num-arg-regs* (target-arch-case 505 491 (:x8632 $numx8632argregs) … … 2316 2302 reg))))))) 2317 2303 2304 2318 2305 ;;; xxx 2319 2306 (defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization) … … 2350 2337 (! misc-set-node val-reg src unscaled-idx))))) 2351 2338 (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)))))))))) 2497 2429 (when (and vreg val-reg) (<- val-reg)) 2498 2430 (^)))) … … 3119 3051 (declare (fixnum class mode)) 3120 3052 (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)) 3122 3054 ((= class hard-reg-class-gpr) 3123 3055 (if (= mode hard-reg-class-gpr-mode-node) … … 4543 4475 (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval)))))) 4544 4476 (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))))))) 4566 4486 (if for-value 4567 4487 (ensuring-node-target (target vreg) … … 4583 4503 (<- *x862-arg-z*))) 4584 4504 (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))) 4600 4511 (val-to-argz-and-imm0) 4601 4512 (with-imm-target (*x862-imm0*) (ptr-reg :address) … … 7167 7078 (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line))))) 7168 7079 (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)) 7170 7081 (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*))) 7171 7082 (-> done) 7172 7083 (@ out-of-line) 7173 7084 (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))) 7175 7086 (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*)) 7176 7087 (@ done) … … 7822 7733 (:x8664 (! mem-ref-c-absolute-doubleword dest absptr)))) 7823 7734 (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))))) 7833 7740 (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))))))) 7865 7757 (if (node-reg-p vreg) 7866 7758 (! box-fixnum vreg dest) … … 7876 7768 (1 (! mem-ref-c-absolute-s8 dest absptr)))) 7877 7769 (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))))) 7895 7777 (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))))))) 7935 7796 (if (node-reg-p vreg) 7936 7797 (case size … … 7951 7812 (1 (! mem-ref-c-absolute-u8 dest absptr)))) 7952 7813 (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))))) 7970 7821 (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 8012 7842 (gpr-mode-name-value 8013 7843 (case size … … 8015 7845 (4 :u32) 8016 7846 (2 :u16) 8017 (1 :u8)))))))) ))7847 (1 :u8)))))))) 8018 7848 (^))))) 8019 7849 … … 8105 7935 *x862-temp0* 8106 7936 (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)))) 8109 7939 (! set-closure-forward-reference val-reg *x862-temp0* (car r))))))) 8110 7940 (x862-undo-body seg vreg xfer body old-stack) … … 8468 8298 k ($ *x862-arg-y*) 8469 8299 new ($ *x862-arg-z*)) 8470 (x862-pop-register seg ($ *x862-temp1*))8300 (x862-pop-register seg ($ x8664::temp1)) 8471 8301 (x862-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset3)))))) 8472 8302 … … 8713 8543 (defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval) 8714 8544 (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)) 8716 8546 (node ($ *x862-arg-z*))) 8717 8547 (x862-one-targeted-reg-form seg fval target) … … 8855 8685 (unless triv-by 8856 8686 (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)))))) 8870 8692 (^))))) 8871 8693 … … 8969 8791 (^))) 8970 8792 8971 #+nil8972 (defx862 x862-i386-ff-call i386-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor)8973 (declare (ignore monitor))8974 ;; a placeholder8975 )8976 8793 8977 8794 (defx862 x862-ff-call ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor) … … 9040 8857 (x862-vpush-register seg reg))) 9041 8858 (:double-float 9042 (let* ((df ($ *x862-fp1*:class :fpr :mode :double-float)))8859 (let* ((df ($ x8664::fp1 :class :fpr :mode :double-float))) 9043 8860 (incf nfpr-args) 9044 8861 (x862-one-targeted-reg-form seg valform df ) … … 9051 8868 (incf other-offset))))) 9052 8869 (:single-float 9053 (let* ((sf ($ *x862-fp1*:class :fpr :mode :single-float)))8870 (let* ((sf ($ x8664::fp1 :class :fpr :mode :single-float))) 9054 8871 (incf nfpr-args) 9055 8872 (x862-one-targeted-reg-form
Note:
See TracChangeset
for help on using the changeset viewer.
