- Timestamp:
- Nov 16, 2007, 12:18:48 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
r7429 r7661 43 43 44 44 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)))) 45 56 46 57 … … 188 199 (defvar *x862-allocptr* nil) 189 200 201 (defvar *x862-fp1* nil) 202 190 203 (declaim (fixnum *x862-vstack* *x862-cstack*)) 191 204 … … 487 500 (:x8664 x8664::allocptr))) 488 501 489 502 (*x862-fp1* (target-arch-case (:x8632 x8632::fp1) 503 (:x8664 x8664::fp1))) 490 504 (*x862-target-num-arg-regs* (target-arch-case 491 505 (:x8632 $numx8632argregs) … … 2302 2316 reg))))))) 2303 2317 2304 2305 2318 ;;; xxx 2306 2319 (defun x862-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval node-value-needs-memoization) … … 2337 2350 (! misc-set-node val-reg src unscaled-idx))))) 2338 2351 (t 2339 (with-imm-target (unboxed-val-reg) scaled-idx 2340 (cond 2341 (is-64-bit 2342 (if (and index-known-fixnum 2343 (<= index-known-fixnum 2344 (arch::target-max-64-bit-constant-index arch))) 2345 (if (eq type-keyword :double-float-vector) 2346 (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum) 2347 (if is-signed 2348 (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum) 2349 (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum))) 2350 (progn 2351 (if index-known-fixnum 2352 (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3)))) 2353 (if (eq type-keyword :double-float-vector) 2354 (! misc-set-double-float unboxed-val-reg src unscaled-idx) 2355 (if is-signed 2356 (! misc-set-s64 unboxed-val-reg src unscaled-idx) 2357 (! misc-set-u64 unboxed-val-reg src unscaled-idx)))))) 2358 (is-32-bit 2359 (if (and index-known-fixnum 2360 (<= index-known-fixnum 2361 (arch::target-max-32-bit-constant-index arch))) 2362 (if (eq type-keyword :single-float-vector) 2363 (if (eq (hard-regspec-class unboxed-val-reg) 2364 hard-reg-class-fpr) 2365 (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum) 2366 (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)) 2367 (if is-signed 2368 (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum) 2369 (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))) 2370 (progn 2371 (if index-known-fixnum 2372 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) 2373 (! scale-32bit-misc-index scaled-idx unscaled-idx)) 2374 (if (and (eq type-keyword :single-float-vector) 2375 (eql (hard-regspec-class unboxed-val-reg) 2376 hard-reg-class-fpr)) 2377 (! misc-set-single-float unboxed-val-reg src scaled-idx) 2378 (if is-signed 2379 (! misc-set-s32 unboxed-val-reg src scaled-idx) 2380 (! misc-set-u32 unboxed-val-reg src scaled-idx)))))) 2381 (is-16-bit 2382 (if (and index-known-fixnum 2383 (<= index-known-fixnum 2384 (arch::target-max-16-bit-constant-index arch))) 2385 (if is-signed 2386 (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum) 2387 (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum)) 2388 (progn 2389 (if index-known-fixnum 2390 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1))) 2391 (! scale-16bit-misc-index scaled-idx unscaled-idx)) 2392 (if is-signed 2393 (! misc-set-s16 unboxed-val-reg src scaled-idx) 2394 (! misc-set-u16 unboxed-val-reg src scaled-idx))))) 2395 (is-8-bit 2396 (if (and index-known-fixnum 2397 (<= index-known-fixnum 2398 (arch::target-max-8-bit-constant-index arch))) 2399 (if is-signed 2400 (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum) 2401 (! misc-set-c-u8 unboxed-val-reg src index-known-fixnum)) 2402 (progn 2403 (if index-known-fixnum 2404 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum)) 2405 (! scale-8bit-misc-index scaled-idx unscaled-idx)) 2406 (if is-signed 2407 (! misc-set-s8 unboxed-val-reg src scaled-idx) 2408 (! misc-set-u8 unboxed-val-reg src scaled-idx))))) 2409 (is-1-bit 2410 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch))) 2411 (if constval 2412 (if (zerop constval) 2413 (! set-constant-bit-to-zero src index-known-fixnum) 2414 (! set-constant-bit-to-one src index-known-fixnum)) 2415 (progn 2416 (! set-constant-bit-to-variable-value src index-known-fixnum val-reg))) 2417 (with-imm-temps () (word-index bit-number) 2418 (if index-known-fixnum 2419 (progn 2420 (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6))) 2421 (x862-lri seg bit-number (logand index-known-fixnum #x63))) 2422 (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx)) 2423 (if constval 2424 (if (zerop constval) 2425 (! set-variable-bit-to-zero src word-index bit-number) 2426 (! set-variable-bit-to-one src word-index bit-number)) 2427 (progn 2428 (! set-variable-bit-to-variable-value src word-index bit-number val-reg)))))))))) 2352 (cond 2353 (is-64-bit 2354 (if (and index-known-fixnum 2355 (<= index-known-fixnum 2356 (arch::target-max-64-bit-constant-index arch))) 2357 (if (eq type-keyword :double-float-vector) 2358 (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum) 2359 (if is-signed 2360 (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum) 2361 (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum))) 2362 (progn 2363 (if index-known-fixnum 2364 (x862-absolute-natural seg unscaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3)))) 2365 (if (eq type-keyword :double-float-vector) 2366 (! misc-set-double-float unboxed-val-reg src unscaled-idx) 2367 (if is-signed 2368 (! misc-set-s64 unboxed-val-reg src unscaled-idx) 2369 (! misc-set-u64 unboxed-val-reg src unscaled-idx)))))) 2370 (is-32-bit 2371 (if (and index-known-fixnum 2372 (<= index-known-fixnum 2373 (arch::target-max-32-bit-constant-index arch))) 2374 (if (eq type-keyword :single-float-vector) 2375 (if (eq (hard-regspec-class unboxed-val-reg) 2376 hard-reg-class-fpr) 2377 (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum) 2378 (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)) 2379 (if is-signed 2380 (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum) 2381 (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))) 2382 (progn 2383 ;; scaled-idx 2384 (target-arch-case 2385 (:x8664 2386 (with-imm-target (unboxed-val-reg) scaled-idx 2387 (if index-known-fixnum 2388 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) 2389 (! scale-32bit-misc-index scaled-idx unscaled-idx)) 2390 (if (and (eq type-keyword :single-float-vector) 2391 (eql (hard-regspec-class unboxed-val-reg) 2392 hard-reg-class-fpr)) 2393 (! misc-set-single-float unboxed-val-reg src scaled-idx) 2394 (if is-signed 2395 (! misc-set-s32 unboxed-val-reg src scaled-idx) 2396 (! misc-set-u32 unboxed-val-reg src scaled-idx))))) 2397 (:x8632 2398 (with-temporary-imm-target (src unscaled-idx) scaled-idx 2399 (if index-known-fixnum 2400 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) 2401 (! scale-32bit-misc-index scaled-idx unscaled-idx)) 2402 (if (and (eq type-keyword :single-float-vector) 2403 (eql (hard-regspec-class unboxed-val-reg) 2404 hard-reg-class-fpr)) 2405 (! misc-set-single-float unboxed-val-reg src scaled-idx) 2406 (if is-signed 2407 (! misc-set-s32 unboxed-val-reg src scaled-idx) 2408 (! misc-set-u32 unboxed-val-reg src scaled-idx))))))))) 2409 (is-16-bit 2410 (if (and index-known-fixnum 2411 (<= index-known-fixnum 2412 (arch::target-max-16-bit-constant-index arch))) 2413 (if is-signed 2414 (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum) 2415 (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum)) 2416 (progn 2417 ;; scaled-idx 2418 (target-arch-case 2419 (:x8664 2420 (with-imm-target (unboxed-val-reg) scaled-idx 2421 (if index-known-fixnum 2422 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1))) 2423 (! scale-16bit-misc-index scaled-idx unscaled-idx)) 2424 (if is-signed 2425 (! misc-set-s16 unboxed-val-reg src scaled-idx) 2426 (! misc-set-u16 unboxed-val-reg src scaled-idx)))) 2427 (:x8632 2428 (with-temporary-imm-target (src unscaled-idx) scaled-idx 2429 (if index-known-fixnum 2430 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1))) 2431 (! scale-16bit-misc-index scaled-idx unscaled-idx)) 2432 (if is-signed 2433 (! misc-set-s16 unboxed-val-reg src scaled-idx) 2434 (! misc-set-u16 unboxed-val-reg src scaled-idx)))))))) 2435 (is-8-bit 2436 (if (and index-known-fixnum 2437 (<= index-known-fixnum 2438 (arch::target-max-8-bit-constant-index arch))) 2439 (if is-signed 2440 (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum) 2441 (! misc-set-c-u8 unboxed-val-reg src index-known-fixnum)) 2442 (progn 2443 ;; scaled-idx 2444 (target-arch-case 2445 (:x8664 2446 (with-imm-target (unboxed-val-reg) scaled-idx 2447 (if index-known-fixnum 2448 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum)) 2449 (! scale-8bit-misc-index scaled-idx unscaled-idx)) 2450 (if is-signed 2451 (! misc-set-s8 unboxed-val-reg src scaled-idx) 2452 (! misc-set-u8 unboxed-val-reg src scaled-idx)))) 2453 (:x8632 2454 (with-temporary-imm-target (src unscaled-idx) scaled-idx 2455 (if index-known-fixnum 2456 (x862-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum)) 2457 (! scale-8bit-misc-index scaled-idx unscaled-idx)) 2458 (if is-signed 2459 (! misc-set-s8 unboxed-val-reg src scaled-idx) 2460 (! misc-set-u8 unboxed-val-reg src scaled-idx)))))))) 2461 (is-1-bit 2462 (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch))) 2463 (if constval 2464 (if (zerop constval) 2465 (! set-constant-bit-to-zero src index-known-fixnum) 2466 (! set-constant-bit-to-one src index-known-fixnum)) 2467 (progn 2468 (! set-constant-bit-to-variable-value src index-known-fixnum val-reg))) 2469 (target-arch-case 2470 (:x8664 2471 (with-imm-temps () (word-index bit-number) 2472 (if index-known-fixnum 2473 (progn 2474 (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6))) 2475 (x862-lri seg bit-number (logand index-known-fixnum #x63))) 2476 (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx)) 2477 (if constval 2478 (if (zerop constval) 2479 (! set-variable-bit-to-zero src word-index bit-number) 2480 (! set-variable-bit-to-one src word-index bit-number)) 2481 (progn 2482 (! set-variable-bit-to-variable-value src word-index bit-number val-reg))))) 2483 (:x8632 2484 (with-imm-temps () (word-index) 2485 (with-temporary-imm-target (src unscaled-idx) bit-number 2486 (if index-known-fixnum 2487 (progn 2488 (x862-lri seg word-index (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum -6))) 2489 (x862-lri seg bit-number (logand index-known-fixnum #x31))) 2490 (! word-index-and-bitnum-from-index word-index bit-number unscaled-idx)) 2491 (if constval 2492 (if (zerop constval) 2493 (! set-variable-bit-to-zero src word-index bit-number) 2494 (! set-variable-bit-to-one src word-index bit-number)) 2495 (progn 2496 (! set-variable-bit-to-variable-value src word-index bit-number val-reg)))))))))))) 2429 2497 (when (and vreg val-reg) (<- val-reg)) 2430 2498 (^)))) … … 3051 3119 (declare (fixnum class mode)) 3052 3120 (cond ((= class hard-reg-class-fpr) 3053 (make-wired-lreg x8664::fp1:class class :mode mode))3121 (make-wired-lreg *x862-fp1* :class class :mode mode)) 3054 3122 ((= class hard-reg-class-gpr) 3055 3123 (if (= mode hard-reg-class-gpr-mode-node) … … 4475 4543 (1 (! mem-set-c-constant-byte signed-intval ptr-reg offval)))))) 4476 4544 (t 4477 (with-imm-target () (ptr-reg :address) 4478 (with-imm-target (ptr-reg) (offsetreg :signed-natural) 4479 (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*)) 4480 (! fixnum->signed-natural offsetreg *x862-arg-z*) 4481 (case size 4482 (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg)) 4483 (4 (! mem-set-constant-fullword intval ptr-reg offsetreg)) 4484 (2 (! mem-set-constant-halfword intval ptr-reg offsetreg)) 4485 (1 (! mem-set-constant-byte intval ptr-reg offsetreg))))))) 4545 (target-arch-case 4546 (:x8664 4547 (with-imm-target () (ptr-reg :address) 4548 (with-imm-target (ptr-reg) (offsetreg :signed-natural) 4549 (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*)) 4550 (! fixnum->signed-natural offsetreg *x862-arg-z*) 4551 (case size 4552 (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg)) 4553 (4 (! mem-set-constant-fullword intval ptr-reg offsetreg)) 4554 (2 (! mem-set-constant-halfword intval ptr-reg offsetreg)) 4555 (1 (! mem-set-constant-byte intval ptr-reg offsetreg)))))) 4556 (:x8632 4557 (with-imm-target () (ptr-reg :address) 4558 (with-temporary-imm-target () (offsetreg :signed-natural) 4559 (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*)) 4560 (! fixnum->signed-natural offsetreg *x862-arg-z*) 4561 (case size 4562 (8 (! mem-set-constant-doubleword intval ptr-reg offsetreg)) 4563 (4 (! mem-set-constant-fullword intval ptr-reg offsetreg)) 4564 (2 (! mem-set-constant-halfword intval ptr-reg offsetreg)) 4565 (1 (! mem-set-constant-byte intval ptr-reg offsetreg))))))))) 4486 4566 (if for-value 4487 4567 (ensuring-node-target (target vreg) … … 4503 4583 (<- *x862-arg-z*))) 4504 4584 (t 4505 (with-imm-target () (ptr-reg :address) 4506 (with-imm-target (ptr-reg) (offset-reg :address) 4507 (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*)) 4508 (! fixnum->signed-natural offset-reg *x862-arg-z*) 4509 (! fixnum-add2 ptr-reg offset-reg) 4510 (x862-push-register seg ptr-reg))) 4585 (target-arch-case 4586 (:x8664 4587 (with-imm-target () (ptr-reg :address) 4588 (with-imm-target (ptr-reg) (offset-reg :address) 4589 (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*)) 4590 (! fixnum->signed-natural offset-reg *x862-arg-z*) 4591 (! fixnum-add2 ptr-reg offset-reg) 4592 (x862-push-register seg ptr-reg)))) 4593 (:x8632 4594 (with-imm-target () (ptr-reg :address) 4595 (with-temporary-imm-target (*x862-arg-z*) (offset-reg :address) 4596 (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*)) 4597 (! fixnum->signed-natural offset-reg *x862-arg-z*) 4598 (! fixnum-add2 ptr-reg offset-reg) 4599 (x862-push-register seg ptr-reg))))) 4511 4600 (val-to-argz-and-imm0) 4512 4601 (with-imm-target (*x862-imm0*) (ptr-reg :address) … … 7078 7167 (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line))))) 7079 7168 (if otherform 7080 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))7169 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*)) 7081 7170 (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*))) 7082 7171 (-> done) 7083 7172 (@ out-of-line) 7084 7173 (if otherform 7085 (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))7174 (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*))) 7086 7175 (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*)) 7087 7176 (@ done) … … 7733 7822 (:x8664 (! mem-ref-c-absolute-doubleword dest absptr)))) 7734 7823 (offval 7735 (with-imm-target () (src-reg :address) 7736 (x862-one-targeted-reg-form seg ptr src-reg) 7737 (target-arch-case 7738 (:x8632 (! mem-ref-c-fullword dest src-reg offval)) 7739 (:x8664 (! mem-ref-c-doubleword dest src-reg offval))))) 7824 (target-arch-case 7825 (:x8664 7826 (with-imm-target () (src-reg :address) 7827 (x862-one-targeted-reg-form seg ptr src-reg) 7828 (! mem-ref-c-doubleword dest src-reg offval))) 7829 (:x8632 7830 (with-temporary-imm-target () (src-reg :address) 7831 (x862-one-targeted-reg-form seg ptr src-reg) 7832 (! mem-ref-c-fullword dest src-reg offval))))) 7740 7833 (t 7741 (with-imm-target () (src-reg :address) 7742 (with-imm-target (src-reg) (offset-reg :signed-natural) 7743 (x862-one-targeted-reg-form seg ptr src-reg) 7744 (if triv-p 7745 (if (acode-fixnum-form-p offset) 7746 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7747 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7748 (progn 7749 (! temp-push-unboxed-word src-reg) 7750 (x862-open-undo $undostkblk) 7751 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7752 (! temp-pop-unboxed-word src-reg) 7753 (x862-close-undo))) 7754 (target-arch-case 7755 (:x8632 (! mem-ref-fullword dest src-reg offset-reg)) 7756 (:x8664 (! mem-ref-doubleword dest src-reg offset-reg))))))) 7834 (target-arch-case 7835 (:x8664 7836 (with-imm-target () (src-reg :address) 7837 (with-imm-target (src-reg) (offset-reg :signed-natural) 7838 (x862-one-targeted-reg-form seg ptr src-reg) 7839 (if triv-p 7840 (if (acode-fixnum-form-p offset) 7841 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7842 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7843 (progn 7844 (! temp-push-unboxed-word src-reg) 7845 (x862-open-undo $undostkblk) 7846 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7847 (! temp-pop-unboxed-word src-reg) 7848 (x862-close-undo))) 7849 (! mem-ref-doubleword dest src-reg offset-reg)))) 7850 (:x8632 7851 (with-temporary-imm-target () (src-reg :address) 7852 (with-temporary-imm-target (src-reg) (offset-reg :signed-natural) 7853 (x862-one-targeted-reg-form seg ptr src-reg) 7854 (if triv-p 7855 (if (acode-fixnum-form-p offset) 7856 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7857 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7858 (progn 7859 (! temp-push-unboxed-word src-reg) 7860 (x862-open-undo $undostkblk) 7861 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7862 (! temp-pop-unboxed-word src-reg) 7863 (x862-close-undo))) 7864 (! mem-ref-fullword dest src-reg offset-reg))))))) 7757 7865 (if (node-reg-p vreg) 7758 7866 (! box-fixnum vreg dest) … … 7768 7876 (1 (! mem-ref-c-absolute-s8 dest absptr)))) 7769 7877 (offval 7770 (with-imm-target (dest) (src-reg :address) 7771 (x862-one-targeted-reg-form seg ptr src-reg) 7772 (case size 7773 (8 (! mem-ref-c-signed-doubleword dest src-reg offval)) 7774 (4 (! mem-ref-c-signed-fullword dest src-reg offval)) 7775 (2 (! mem-ref-c-s16 dest src-reg offval)) 7776 (1 (! mem-ref-c-s8 dest src-reg offval))))) 7878 (target-arch-case 7879 (:x8664 7880 (with-imm-target (dest) (src-reg :address) 7881 (x862-one-targeted-reg-form seg ptr src-reg) 7882 (case size 7883 (8 (! mem-ref-c-signed-doubleword dest src-reg offval)) 7884 (4 (! mem-ref-c-signed-fullword dest src-reg offval)) 7885 (2 (! mem-ref-c-s16 dest src-reg offval)) 7886 (1 (! mem-ref-c-s8 dest src-reg offval))))) 7887 (:x8632 7888 (with-temporary-imm-target () (src-reg :address) 7889 (x862-one-targeted-reg-form seg ptr src-reg) 7890 (case size 7891 ;;(8 (! mem-ref-c-signed-doubleword dest src-reg offval)) 7892 (4 (! mem-ref-c-signed-fullword dest src-reg offval)) 7893 (2 (! mem-ref-c-s16 dest src-reg offval)) 7894 (1 (! mem-ref-c-s8 dest src-reg offval))))))) 7777 7895 (t 7778 (with-imm-target () (src-reg :address) 7779 (with-imm-target (src-reg) (offset-reg :signed-natural) 7780 (x862-one-targeted-reg-form seg ptr src-reg) 7781 (if triv-p 7782 (if (acode-fixnum-form-p offset) 7783 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7784 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7785 (progn 7786 (! temp-push-unboxed-word src-reg) 7787 (x862-open-undo $undostkblk) 7788 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7789 (! temp-pop-unboxed-word src-reg) 7790 (x862-close-undo))) 7791 (case size 7792 (8 (! mem-ref-signed-doubleword dest src-reg offset-reg)) 7793 (4 (! mem-ref-signed-fullword dest src-reg offset-reg)) 7794 (2 (! mem-ref-s16 dest src-reg offset-reg)) 7795 (1 (! mem-ref-s8 dest src-reg offset-reg))))))) 7896 (target-arch-case 7897 (:x8664 7898 (with-imm-target () (src-reg :address) 7899 (with-imm-target (src-reg) (offset-reg :signed-natural) 7900 (x862-one-targeted-reg-form seg ptr src-reg) 7901 (if triv-p 7902 (if (acode-fixnum-form-p offset) 7903 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7904 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7905 (progn 7906 (! temp-push-unboxed-word src-reg) 7907 (x862-open-undo $undostkblk) 7908 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7909 (! temp-pop-unboxed-word src-reg) 7910 (x862-close-undo))) 7911 (case size 7912 (8 (! mem-ref-signed-doubleword dest src-reg offset-reg)) 7913 (4 (! mem-ref-signed-fullword dest src-reg offset-reg)) 7914 (2 (! mem-ref-s16 dest src-reg offset-reg)) 7915 (1 (! mem-ref-s8 dest src-reg offset-reg)))))) 7916 (:x8632 7917 (with-temporary-imm-target () (src-reg :address) 7918 (with-temporary-imm-target (src-reg) (offset-reg :signed-natural) 7919 (x862-one-targeted-reg-form seg ptr src-reg) 7920 (if triv-p 7921 (if (acode-fixnum-form-p offset) 7922 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7923 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7924 (progn 7925 (! temp-push-unboxed-word src-reg) 7926 (x862-open-undo $undostkblk) 7927 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7928 (! temp-pop-unboxed-word src-reg) 7929 (x862-close-undo))) 7930 (case size 7931 ;;(8 (! mem-ref-signed-doubleword dest src-reg offset-reg)) 7932 (4 (! mem-ref-signed-fullword dest src-reg offset-reg)) 7933 (2 (! mem-ref-s16 dest src-reg offset-reg)) 7934 (1 (! mem-ref-s8 dest src-reg offset-reg))))))))) 7796 7935 (if (node-reg-p vreg) 7797 7936 (case size … … 7812 7951 (1 (! mem-ref-c-absolute-u8 dest absptr)))) 7813 7952 (offval 7814 (with-imm-target (dest) (src-reg :address) 7815 (x862-one-targeted-reg-form seg ptr src-reg) 7816 (case size 7817 (8 (! mem-ref-c-doubleword dest src-reg offval)) 7818 (4 (! mem-ref-c-fullword dest src-reg offval)) 7819 (2 (! mem-ref-c-u16 dest src-reg offval)) 7820 (1 (! mem-ref-c-u8 dest src-reg offval))))) 7953 (target-arch-case 7954 (:x8664 7955 (with-imm-target (dest) (src-reg :address) 7956 (x862-one-targeted-reg-form seg ptr src-reg) 7957 (case size 7958 (8 (! mem-ref-c-doubleword dest src-reg offval)) 7959 (4 (! mem-ref-c-fullword dest src-reg offval)) 7960 (2 (! mem-ref-c-u16 dest src-reg offval)) 7961 (1 (! mem-ref-c-u8 dest src-reg offval))))) 7962 (:x8632 7963 (with-temporary-imm-target () (src-reg :address) 7964 (x862-one-targeted-reg-form seg ptr src-reg) 7965 (case size 7966 ;;(8 (! mem-ref-c-doubleword dest src-reg offval)) 7967 (4 (! mem-ref-c-fullword dest src-reg offval)) 7968 (2 (! mem-ref-c-u16 dest src-reg offval)) 7969 (1 (! mem-ref-c-u8 dest src-reg offval))))))) 7821 7970 (t 7822 (with-imm-target () (src-reg :address) 7823 (with-imm-target (src-reg) (offset-reg :signed-natural) 7824 (x862-one-targeted-reg-form seg ptr src-reg) 7825 (if triv-p 7826 (if (acode-fixnum-form-p offset) 7827 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7828 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7829 (progn 7830 (! temp-push-unboxed-word src-reg) 7831 (x862-open-undo $undostkblk) 7832 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7833 (! temp-pop-unboxed-word src-reg) 7834 (x862-close-undo))) 7835 (case size 7836 (8 (! mem-ref-doubleword dest src-reg offset-reg)) 7837 (4 (! mem-ref-fullword dest src-reg offset-reg)) 7838 (2 (! mem-ref-u16 dest src-reg offset-reg)) 7839 (1 (! mem-ref-u8 dest src-reg offset-reg))))))) 7840 (<- (set-regspec-mode 7841 dest 7971 (target-arch-case 7972 (:x8664 7973 (with-imm-target () (src-reg :address) 7974 (with-imm-target (src-reg) (offset-reg :signed-natural) 7975 (x862-one-targeted-reg-form seg ptr src-reg) 7976 (if triv-p 7977 (if (acode-fixnum-form-p offset) 7978 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7979 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7980 (progn 7981 (! temp-push-unboxed-word src-reg) 7982 (x862-open-undo $undostkblk) 7983 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 7984 (! temp-pop-unboxed-word src-reg) 7985 (x862-close-undo))) 7986 (case size 7987 (8 (! mem-ref-doubleword dest src-reg offset-reg)) 7988 (4 (! mem-ref-fullword dest src-reg offset-reg)) 7989 (2 (! mem-ref-u16 dest src-reg offset-reg)) 7990 (1 (! mem-ref-u8 dest src-reg offset-reg)))))) 7991 (:x8632 7992 (with-temporary-imm-target () (src-reg :address) 7993 (with-temporary-imm-target (src-reg) (offset-reg :signed-natural) 7994 (x862-one-targeted-reg-form seg ptr src-reg) 7995 (if triv-p 7996 (if (acode-fixnum-form-p offset) 7997 (x862-lri seg offset-reg (acode-fixnum-form-p offset)) 7998 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*))) 7999 (progn 8000 (! temp-push-unboxed-word src-reg) 8001 (x862-open-undo $undostkblk) 8002 (! fixnum->signed-natural offset-reg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)) 8003 (! temp-pop-unboxed-word src-reg) 8004 (x862-close-undo))) 8005 (case size 8006 ;;(8 (! mem-ref-doubleword dest src-reg offset-reg)) 8007 (4 (! mem-ref-fullword dest src-reg offset-reg)) 8008 (2 (! mem-ref-u16 dest src-reg offset-reg)) 8009 (1 (! mem-ref-u8 dest src-reg offset-reg))))))) 8010 (<- (set-regspec-mode 8011 dest 7842 8012 (gpr-mode-name-value 7843 8013 (case size … … 7845 8015 (4 :u32) 7846 8016 (2 :u16) 7847 (1 :u8)))))))) 8017 (1 :u8)))))))))) 7848 8018 (^))))) 7849 8019 … … 7935 8105 *x862-temp0* 7936 8106 (progn 7937 (x862-addrspec-to-reg seg v-ea x8664::temp1)7938 x8664::temp1))))8107 (x862-addrspec-to-reg seg v-ea *x862-temp1*) 8108 *x862-temp1*)))) 7939 8109 (! set-closure-forward-reference val-reg *x862-temp0* (car r))))))) 7940 8110 (x862-undo-body seg vreg xfer body old-stack) … … 8298 8468 k ($ *x862-arg-y*) 8299 8469 new ($ *x862-arg-z*)) 8300 (x862-pop-register seg ($ x8664::temp1))8470 (x862-pop-register seg ($ *x862-temp1*)) 8301 8471 (x862-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset3)))))) 8302 8472 … … 8543 8713 (defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval) 8544 8714 (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*)) 8545 (let* ((target ($ x8664::fp1:class :fpr :mode :double-float))8715 (let* ((target ($ *x862-fp1* :class :fpr :mode :double-float)) 8546 8716 (node ($ *x862-arg-z*))) 8547 8717 (x862-one-targeted-reg-form seg fval target) … … 8685 8855 (unless triv-by 8686 8856 (x862-pop-register seg ptr-reg)) 8687 (with-imm-target (ptr-reg) (by-reg :signed-natural) 8688 (! fixnum->signed-natural by-reg boxed-by) 8689 (let* ((result ptr-reg)) 8690 (! fixnum-add2 result by-reg) 8691 (<- result)))))) 8857 (target-arch-case 8858 (:x8664 8859 (with-imm-target (ptr-reg) (by-reg :signed-natural) 8860 (! fixnum->signed-natural by-reg boxed-by) 8861 (let* ((result ptr-reg)) 8862 (! fixnum-add2 result by-reg) 8863 (<- result)))) 8864 (:x8632 8865 (with-temporary-imm-target (boxed-by) (by-reg :signed-natural) 8866 (! fixnum->signed-natural by-reg boxed-by) 8867 (let* ((result ptr-reg)) 8868 (! fixnum-add2 result by-reg) 8869 (<- result)))))))) 8692 8870 (^))))) 8693 8871 … … 8791 8969 (^))) 8792 8970 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 ) 8793 8976 8794 8977 (defx862 x862-ff-call ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor) … … 8857 9040 (x862-vpush-register seg reg))) 8858 9041 (:double-float 8859 (let* ((df ($ x8664::fp1:class :fpr :mode :double-float)))9042 (let* ((df ($ *x862-fp1* :class :fpr :mode :double-float))) 8860 9043 (incf nfpr-args) 8861 9044 (x862-one-targeted-reg-form seg valform df ) … … 8868 9051 (incf other-offset))))) 8869 9052 (:single-float 8870 (let* ((sf ($ x8664::fp1:class :fpr :mode :single-float)))9053 (let* ((sf ($ *x862-fp1* :class :fpr :mode :single-float))) 8871 9054 (incf nfpr-args) 8872 9055 (x862-one-targeted-reg-form
Note:
See TracChangeset
for help on using the changeset viewer.
