- Timestamp:
- Nov 26, 2007, 9:20:18 PM (17 years ago)
- File:
-
- 1 edited
-
branches/ia32/compiler/X86/x862.lisp (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/ia32/compiler/X86/x862.lisp
r7708 r7764 205 205 (defvar *x862-allocptr* nil) 206 206 207 (defvar *x862-fp0* nil) 208 (defvar *x862-fp1* nil) 209 210 207 211 (declaim (fixnum *x862-vstack* *x862-cstack*)) 208 212 … … 503 507 (*x862-allocptr* (target-arch-case (:x8632 x8632::allocptr) 504 508 (:x8664 x8664::allocptr))) 505 509 (*x862-fp0* (target-arch-case (:x8632 x8632::fp0) 510 (:x8664 x8664::fp0))) 511 (*x862-fp1* (target-arch-case (:x8632 x8632::fp1) 512 (:x8664 x8664::fp1))) 506 513 507 514 (*x862-target-num-arg-regs* (target-arch-case … … 2474 2481 value result-reg))) 2475 2482 (when safe 2476 (let* ((*available-backend-imm-temps* *available-backend-imm-temps*) 2477 (value (if (eql (hard-regspec-class result-reg) 2478 hard-reg-class-gpr) 2479 (hard-regspec-value result-reg)))) 2480 (when (and value (logbitp value *available-backend-imm-temps*)) 2481 (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))) 2482 (if (typep safe 'fixnum) 2483 (! trap-unless-typecode= src safe)) 2484 (unless index-known-fixnum 2485 (! trap-unless-fixnum unscaled-idx)) 2486 (! check-misc-bound unscaled-idx src))) 2483 (with-additional-imm-reg (src unscaled-idx result-reg) 2484 (let* ((*available-backend-imm-temps* *available-backend-imm-temps*) 2485 (value (if (eql (hard-regspec-class result-reg) 2486 hard-reg-class-gpr) 2487 (hard-regspec-value result-reg)))) 2488 (when (and value (logbitp value *available-backend-imm-temps*)) 2489 (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))) 2490 (if (typep safe 'fixnum) 2491 (! trap-unless-typecode= src safe)) 2492 (unless index-known-fixnum 2493 (! trap-unless-fixnum unscaled-idx)) 2494 (! check-misc-bound unscaled-idx src)))) 2487 2495 (x862-vset1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum result-reg (x862-unboxed-reg-for-aset seg type-keyword result-reg safe constval) constval needs-memoization))))) 2488 2496 … … 3791 3799 (! trap-unless-macptr src)) 3792 3800 (! deref-macptr dest src))))) 3801 ((#.hard-reg-class-gpr-mode-u32 3802 #.hard-reg-class-gpr-mode-s32 3803 #.hard-reg-class-gpr-mode-address) 3804 (unless (eql dest-gpr src-gpr) 3805 (! copy-gpr dest src))) 3806 (#.hard-reg-class-gpr-mode-u16 3807 (! u16->u32 dest src)) 3808 (#.hard-reg-class-gpr-mode-s16 3809 (! s16->s32 dest src)) 3810 (#.hard-reg-class-gpr-mode-u8 3811 (! u8->u32 dest src)) 3812 (#.hard-reg-class-gpr-mode-s8 3813 (! s8->s32 dest src)))) 3814 (#.hard-reg-class-gpr-mode-s32 3815 (case src-mode 3816 (#.hard-reg-class-gpr-mode-node 3817 (! unbox-s32 dest src)) 3793 3818 ((#.hard-reg-class-gpr-mode-u32 3794 3819 #.hard-reg-class-gpr-mode-s32 … … 4380 4405 4381 4406 4382 4407 ;; xxx imm regs 4383 4408 (defun x862-%immediate-set-ptr (seg vreg xfer ptr offset val) 4384 4409 (with-x86-local-vinsn-macros (seg vreg xfer) … … 5305 5330 (setq n 0)) 5306 5331 (if *x862-open-code-inline* 5307 (let* ((*available-backend-node-temps* (bitclr *x862-arg-z* (bitclr x8664::rcx *available-backend-node-temps*)))) 5332 (let* ((*available-backend-node-temps* 5333 (target-arch-case 5334 ;; I don't see where %ecx is used... 5335 (:x8632 (bitclr x8632::arg_z *available-backend-node-temps*)) 5336 (:x8664 (bitclr x8664::arg_z (bitclr x8664::rcx *available-backend-node-temps*)))))) 5308 5337 (! unbind-interrupt-level-inline)) 5309 5338 (! unbind-interrupt-level))) … … 7107 7136 (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line))))) 7108 7137 (if otherform 7109 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift))7138 (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*)) 7110 7139 (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*))) 7111 7140 (-> done) 7112 7141 (@ out-of-line) 7113 7142 (if otherform 7114 (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift)))7143 (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*))) 7115 7144 (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*)) 7116 7145 (@ done) … … 7408 7437 (target-arch-case 7409 7438 (:x8632 7410 (! setup-uvector-allocation n)) 7439 (! setup-uvector-allocation header) 7440 (x862-lri seg x8632::imm0 n)) 7411 7441 (:x8664 7412 7442 (x862-lri seg x8664::imm1 n))) … … 8565 8595 (x862-vpop-register seg *x862-arg-z*) 8566 8596 (unless (or *x862-reckless* (x862-form-typep x 'macptr)) 8567 (with-imm-temps (src-reg) () 8568 (! trap-unless-macptr *x862-arg-z*))) 8597 (with-additional-imm-reg () 8598 (with-imm-temps (src-reg) () 8599 (! trap-unless-macptr *x862-arg-z*)))) 8569 8600 (! set-macptr-address src-reg *x862-arg-z*) 8570 8601 (<- *x862-arg-z*) … … 8573 8604 (defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval) 8574 8605 (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*)) 8575 (let* ((target ($ x8664::fp1:class :fpr :mode :double-float))8606 (let* ((target ($ *x862-fp1* :class :fpr :mode :double-float)) 8576 8607 (node ($ *x862-arg-z*))) 8577 8608 (x862-one-targeted-reg-form seg fval target) … … 8728 8759 (x862-mvcall seg vreg xfer fn arglist)) 8729 8760 8730 8761 (defx862 x862-i386-syscall i386-syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports) 8762 (format t "i386-syscall")) 8731 8763 8732 8764 (defx862 x862-syscall syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports) … … 8822 8854 (^))) 8823 8855 8824 8825 8856 (defx862 x862-i386-ff-call i386-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor) 8826 8857 (declare (ignore monitor)) 8858 #|| 8859 (let* ((*x862-vstack* *x862-vstack*) 8860 (*x862-top-vstack-lcell* *x862-top-vstack-lcell*) 8861 (*x862-cstack* *x862-cstack*) 8862 (return-registers ()) 8863 (simple-foreign-args nil) 8864 (nwords 0)) 8865 (dolist (argspec argspecs) 8866 (case argspec 8867 ((:double-float :unsigned-doubleword :signed-doubleword) 8868 (incf nwords 2)) 8869 (t (incf nwords)))) 8870 (when (null argspecs) 8871 (setq simple-foreign-args t)) 8872 (! alloc-c-frame nwords) 8873 (x862-open-undo $undo-x86-c-frame) 8874 (unless simple-foreign-args 8875 (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8632::arg_z))) 8876 ;; Evaluate each form into the C frame, according to the 8877 ;; matching argspec. 8878 (do* ((specs argspecs (cdr specs)) 8879 (vals argvals (cdr vals))) 8880 ((null specs)) 8881 (declare (list specs vals)) 8882 (let* ((valform (car vals)) 8883 (spec (car specs)) 8884 (absptr (acode-absolute-ptr-p valform))) 8885 (case spec 8886 (:registers) 8887 (:double-float) 8888 (:single-float) 8889 (:address) 8890 (t))))) 8891 ||# 8827 8892 (format t "~&i386-ff-call") 8828 8893 ) … … 8875 8940 (setq ngpr-args 0 nfpr-args 0) 8876 8941 (unless simple-foreign-args 8877 (x862-vpush-register seg (x862-one-untargeted-reg-form seg address *x862-arg-z*)))8942 (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8664::arg_z))) 8878 8943 ;; Evaluate each form into the C frame, according to the 8879 8944 ;; matching argspec. Remember type and arg offset of any FP … … 8888 8953 (case spec 8889 8954 (:registers 8890 (let* ((reg (x862-one-untargeted-reg-form seg valform *x862-arg-z*)))8955 (let* ((reg (x862-one-untargeted-reg-form seg valform x8664::arg_z))) 8891 8956 (unless *x862-reckless* 8892 8957 (! trap-unless-macptr reg)) … … 8957 9022 (! reload-single-c-arg ($ fpreg :class :fpr :mode :single-float) from)))) 8958 9023 (if return-registers 8959 (x862-vpop-register seg ($ *x862-arg-y*)))9024 (x862-vpop-register seg ($ x8664::arg_y))) 8960 9025 (if simple-foreign-args 8961 (x862-one-targeted-reg-form seg address *x862-arg-z*)8962 (x862-vpop-register seg ($ *x862-arg-z*)))9026 (x862-one-targeted-reg-form seg address x8664::arg_z) 9027 (x862-vpop-register seg ($ x8664::arg_z))) 8963 9028 (x862-lri seg x8664::rax (min 8 nfpr-args)) 8964 9029 (if return-registers … … 8976 9041 (progn 8977 9042 (! makeu64) 8978 (<- ($ *x862-arg-z*)))9043 (<- ($ x8664::arg_z))) 8979 9044 (<- ($ x8664::rax :class :gpr :mode :u64)))) 8980 9045 ((eq resultspec :signed-doubleword) … … 8982 9047 (progn 8983 9048 (! makes64) 8984 (<- ($ *x862-arg-z*)))9049 (<- ($ x8664::arg_z))) 8985 9050 (<- ($ x8664::rax :class :gpr :mode :s64)))) 8986 9051 (t 8987 9052 (case resultspec 8988 (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*))8989 (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*))8990 (:signed-fullword (! sign-extend-s32 *x862-imm0* *x862-imm0*))8991 (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*))8992 (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*))8993 (:unsigned-fullword (! zero-extend-u32 *x862-imm0* *x862-imm0*)))8994 (<- (make-wired-lreg *x862-imm0*9053 (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0)) 9054 (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0)) 9055 (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0)) 9056 (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0)) 9057 (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0)) 9058 (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0))) 9059 (<- (make-wired-lreg x8664::imm0 8995 9060 :mode 8996 9061 (gpr-mode-name-value … … 9090 9155 (if (not constant) 9091 9156 (with-imm-target () (xreg :natural) 9092 (with-imm-target (xreg) (yreg :natural) 9093 (x862-two-targeted-reg-forms seg x xreg y yreg) 9094 (! %natural-logior xreg yreg)) 9157 (with-additional-imm-reg () 9158 (with-imm-target (xreg) (yreg :natural) 9159 (x862-two-targeted-reg-forms seg x xreg y yreg) 9160 (! %natural-logior xreg yreg))) 9095 9161 (<- xreg)) 9096 9162 (let* ((other (if u31x y x)))
Note:
See TracChangeset
for help on using the changeset viewer.
