Changeset 5146
- Timestamp:
- Sep 6, 2006, 3:39:36 PM (18 years ago)
- Location:
- trunk/ccl/compiler/X86
- Files:
-
- 2 edited
-
X8664/x8664-vinsns.lisp (modified) (9 diffs)
-
x862.lisp (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/compiler/X86/X8664/x8664-vinsns.lisp
r5042 r5146 663 663 664 664 665 (define-x8664-vinsn u 8->char (((dest :lisp)665 (define-x8664-vinsn u32->char (((dest :lisp) 666 666 (src :u8)) 667 667 ((src :u8)) … … 2564 2564 (jmp :again) 2565 2565 :ok) 2566 2567 (define-x8664-vinsn require-char-code (() 2568 ((object :lisp)) 2569 ((tag :u32))) 2570 :again 2571 (testb (:$b x8664::fixnummask) (:%b object)) 2572 (jne.pn :bad) 2573 (cmpq (:$l #x110000) (:%q object)) 2574 (jb.pt :ok) 2575 :bad 2576 (uuo-error-reg-not-type (:%q object) (:$ub arch::error-object-not-mod-char-code-limit)) 2577 (jmp :again) 2578 :ok) 2579 2580 2566 2581 2567 2582 … … 2933 2948 (:%l dest))) 2934 2949 2935 (define-x8664-vinsn %scharcode (((code :imm))2950 (define-x8664-vinsn %scharcode8 (((code :imm)) 2936 2951 ((str :lisp) 2937 2952 (idx :imm)) … … 2940 2955 (sarq (:$ub x8664::fixnumshift) (:%q imm)) 2941 2956 (movzbl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm)) 2942 (leaq (:@ (:%q imm) 8) (:%q code))) 2957 (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code))) 2958 2959 (define-x8664-vinsn %scharcode32 (((code :imm)) 2960 ((str :lisp) 2961 (idx :imm)) 2962 ((imm :u64))) 2963 (movq (:%q idx) (:%q imm)) 2964 (sarq (:$ub 1) (:%q imm)) 2965 (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm)) 2966 (imulq (:$b x8664::fixnumone) (:%q imm)(:%q code))) 2943 2967 2944 2968 (define-x8664-subprim-jump-vinsn (tail-call-sym-slide) .SPtcallsymslide) … … 3286 3310 3287 3311 3288 (define-x8664-vinsn %set-scharcode (()3312 (define-x8664-vinsn %set-scharcode8 (() 3289 3313 ((str :lisp) 3290 3314 (idx :imm) … … 3297 3321 (shrq (:$ub x8664::word-shift) (:%q imm)) 3298 3322 (movb (:%b imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm)))) 3323 3324 3325 (define-x8664-vinsn %set-scharcode32 (() 3326 ((str :lisp) 3327 (idx :imm) 3328 (code :imm)) 3329 ((imm :u64) 3330 (imm1 :u64))) 3331 (movq (:%q code) (:%q imm1)) 3332 (movq (:%q idx) (:%q imm)) 3333 (shrq (:$ub x8664::fixnumshift) (:%q imm1)) 3334 (shrq (:$ub 1) (:%q imm)) 3335 (movl (:%l imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm)))) 3299 3336 3300 3337 … … 3639 3676 (testb (:%b x8664::arg_z) (:%b x8664::arg_z))) 3640 3677 3641 (define-x8664-vinsn %schar (((char :imm))3678 (define-x8664-vinsn %schar8 (((char :imm)) 3642 3679 ((str :lisp) 3643 3680 (idx :imm)) … … 3649 3686 (leaq (:@ x8664::subtag-character (:%q imm)) (:%q char))) 3650 3687 3651 3652 (define-x8664-vinsn %set-schar (() 3653 ((str :lisp) 3654 (idx :imm) 3655 (char :imm)) 3656 ((imm0 :u64) 3657 (imm1 :u64))) 3688 (define-x8664-vinsn %schar32 (((char :imm)) 3689 ((str :lisp) 3690 (idx :imm)) 3691 ((imm :u32))) 3692 (movq (:%q idx) (:%q imm)) 3693 (shrq (:$ub 1) (:%q imm)) 3694 (movl (:@ x8664::misc-data-offset (:%q str) (:%q imm)) (:%l imm)) 3695 (shll (:$ub x8664::charcode-shift) (:%l imm)) 3696 (leaq (:@ x8664::subtag-character (:%q imm)) (:%q char))) 3697 3698 3699 (define-x8664-vinsn %set-schar8 (() 3700 ((str :lisp) 3701 (idx :imm) 3702 (char :imm)) 3703 ((imm0 :u64) 3704 (imm1 :u64))) 3658 3705 (movq (:%q idx) (:%q imm0)) 3659 3706 (movl (:%l char) (:%l imm1)) … … 3662 3709 (movb (:%b imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm0)))) 3663 3710 3711 (define-x8664-vinsn %set-schar32 (() 3712 ((str :lisp) 3713 (idx :imm) 3714 (char :imm)) 3715 ((imm0 :u64) 3716 (imm1 :u64))) 3717 (movq (:%q idx) (:%q imm0)) 3718 (movl (:%l char) (:%l imm1)) 3719 (shrq (:$ub 1) (:%q imm0)) 3720 (shrl (:$ub x8664::charcode-shift) (:%l imm1)) 3721 (movl (:%l imm1) (:@ x8664::misc-data-offset (:%q str) (:%q imm0)))) 3664 3722 3665 3723 (define-x8664-vinsn misc-set-c-single-float (((val :single-float)) -
trunk/ccl/compiler/X86/x862.lisp
r5042 r5146 1503 1503 (! misc-ref-c-u32 temp src index-known-fixnum)) 1504 1504 (ensuring-node-target (target vreg) 1505 (! box-fixnum target temp))))) 1505 (if (eq type-keyword :simple-string) 1506 (! u32->char target temp) 1507 (! box-fixnum target temp)))))) 1506 1508 (with-imm-temps 1507 1509 () (idx-reg) … … 1520 1522 (! misc-ref-u32 temp src idx-reg)) 1521 1523 (ensuring-node-target (target vreg) 1522 (! box-fixnum target temp))))))) 1524 (if (eq type-keyword :simple-string) 1525 (! u32->char target temp) 1526 (! box-fixnum target temp)))))))) 1523 1527 (if is-8-bit 1524 1528 (with-imm-temps … … 1538 1542 (if (eq type-keyword :simple-string) 1539 1543 (ensuring-node-target (target vreg) 1540 (! u 8->char target temp))1544 (! u32->char target temp)) 1541 1545 (if (and (= vreg-mode hard-reg-class-gpr-mode-u8) 1542 1546 (eq type-keyword :unsigned-8-bit-vector)) … … 1976 1980 (if (typep constval 'single-float) 1977 1981 (x862-single-float-bits constval) 1978 constval)) 1982 (if (typep constval 'character) 1983 (char-code constval) 1984 constval))) 1979 1985 (cond ((eq type-keyword :single-float-vector) 1980 1986 (when safe … … 1983 1989 ((eq type-keyword :signed-32-bit-vector) 1984 1990 (! unbox-s32 temp val-reg)) 1991 ((eq type-keyword :simple-string) 1992 (! unbox-base-char temp val-reg)) 1985 1993 (t 1986 1994 (! unbox-u32 temp val-reg)))) … … 5828 5836 (ensuring-node-target (target vreg) 5829 5837 (with-imm-target () (dest :u8) 5830 (! u 8->char target (let* ((*x862-reckless* t))5838 (! u32->char target (let* ((*x862-reckless* t)) 5831 5839 (x862-one-untargeted-reg-form seg c dest))))) 5832 5840 (^)))) … … 5834 5842 (defx862 x862-%schar %schar (seg vreg xfer str idx) 5835 5843 (multiple-value-bind (src unscaled-idx) 5836 5844 (x862-two-untargeted-reg-forms seg str x8664::arg_y idx x8664::arg_z) 5837 5845 (if vreg 5838 5846 (ensuring-node-target (target vreg) 5839 (! %schar target src unscaled-idx))) 5847 (case (arch::target-char-code-limit (backend-target-arch *target-backend*)) 5848 (256 (! %schar8 target src unscaled-idx)) 5849 (t (! %schar32 target src unscaled-idx))))) 5840 5850 (^))) 5841 5851 5842 5852 (defx862 x862-%set-schar %set-schar (seg vreg xfer str idx char) 5843 5853 (multiple-value-bind (src unscaled-idx char) 5844 (x862-three-untargeted-reg-forms seg 5845 str x8664::arg_x 5846 idx x8664::arg_y 5847 char x8664::arg_z) 5848 (! %set-schar src unscaled-idx char) 5854 (x862-three-untargeted-reg-forms seg 5855 str x8664::arg_x 5856 idx x8664::arg_y 5857 char x8664::arg_z) 5858 (case (arch::target-char-code-limit (backend-target-arch *target-backend*)) 5859 (256 (! %set-schar8 src unscaled-idx char)) 5860 (t (! %set-schar32 src unscaled-idx char))) 5849 5861 (when vreg (<- char)) 5850 5862 (^))) … … 5852 5864 (defx862 x862-%set-scharcode %set-scharcode (seg vreg xfer str idx char) 5853 5865 (multiple-value-bind (src unscaled-idx char) 5854 (x862-three-untargeted-reg-forms seg str x8664::arg_x idx x8664::arg_y 5855 char x8664::arg_z) 5856 (! %set-scharcode src unscaled-idx char) 5866 (x862-three-untargeted-reg-forms seg str x8664::arg_x idx x8664::arg_y 5867 char x8664::arg_z) 5868 (case (arch::target-char-code-limit (backend-target-arch *target-backend*)) 5869 (256 (! %set-scharcode8 src unscaled-idx char)) 5870 (t (! %set-scharcode32 src unscaled-idx char))) 5857 5871 (when vreg (<- char)) 5858 5872 (^))) … … 5860 5874 (defx862 x862-%scharcode %scharcode (seg vreg xfer str idx) 5861 5875 (multiple-value-bind (src unscaled-idx) 5862 5876 (x862-two-untargeted-reg-forms seg str x8664::arg_y idx x8664::arg_z) 5863 5877 (if vreg 5864 5878 (ensuring-node-target (target vreg) 5865 (! %scharcode target src unscaled-idx))) 5879 (case (arch::target-char-code-limit (backend-target-arch *target-backend*)) 5880 (256 (! %scharcode8 target src unscaled-idx)) 5881 (t (! %scharcode32 target src unscaled-idx))))) 5866 5882 (^))) 5867 5883 … … 5870 5886 (defx862 x862-code-char code-char (seg vreg xfer c) 5871 5887 (let* ((reg (x862-one-untargeted-reg-form seg c x8664::arg_z))) 5872 (! require-u8 reg) ; Typecheck even if result unused. 5888 ;; Typecheck even if result unused. 5889 (case (arch::target-char-code-limit (backend-target-arch *target-backend*)) 5890 (256 (! require-u8 reg)) 5891 (t (! require-char-code reg))) 5873 5892 (if vreg 5874 5893 (ensuring-node-target (target vreg)
Note:
See TracChangeset
for help on using the changeset viewer.
