Index: /branches/ia32/compiler/X86/x862.lisp =================================================================== --- /branches/ia32/compiler/X86/x862.lisp (revision 7763) +++ /branches/ia32/compiler/X86/x862.lisp (revision 7764) @@ -205,4 +205,8 @@ (defvar *x862-allocptr* nil) +(defvar *x862-fp0* nil) +(defvar *x862-fp1* nil) + + (declaim (fixnum *x862-vstack* *x862-cstack*)) @@ -503,5 +507,8 @@ (*x862-allocptr* (target-arch-case (:x8632 x8632::allocptr) (:x8664 x8664::allocptr))) - + (*x862-fp0* (target-arch-case (:x8632 x8632::fp0) + (:x8664 x8664::fp0))) + (*x862-fp1* (target-arch-case (:x8632 x8632::fp1) + (:x8664 x8664::fp1))) (*x862-target-num-arg-regs* (target-arch-case @@ -2474,15 +2481,16 @@ value result-reg))) (when safe - (let* ((*available-backend-imm-temps* *available-backend-imm-temps*) - (value (if (eql (hard-regspec-class result-reg) - hard-reg-class-gpr) - (hard-regspec-value result-reg)))) - (when (and value (logbitp value *available-backend-imm-temps*)) - (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))) - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (unless index-known-fixnum - (! trap-unless-fixnum unscaled-idx)) - (! check-misc-bound unscaled-idx src))) + (with-additional-imm-reg (src unscaled-idx result-reg) + (let* ((*available-backend-imm-temps* *available-backend-imm-temps*) + (value (if (eql (hard-regspec-class result-reg) + hard-reg-class-gpr) + (hard-regspec-value result-reg)))) + (when (and value (logbitp value *available-backend-imm-temps*)) + (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))) + (if (typep safe 'fixnum) + (! trap-unless-typecode= src safe)) + (unless index-known-fixnum + (! trap-unless-fixnum unscaled-idx)) + (! check-misc-bound unscaled-idx src)))) (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))))) @@ -3791,4 +3799,21 @@ (! trap-unless-macptr src)) (! deref-macptr dest src))))) + ((#.hard-reg-class-gpr-mode-u32 + #.hard-reg-class-gpr-mode-s32 + #.hard-reg-class-gpr-mode-address) + (unless (eql dest-gpr src-gpr) + (! copy-gpr dest src))) + (#.hard-reg-class-gpr-mode-u16 + (! u16->u32 dest src)) + (#.hard-reg-class-gpr-mode-s16 + (! s16->s32 dest src)) + (#.hard-reg-class-gpr-mode-u8 + (! u8->u32 dest src)) + (#.hard-reg-class-gpr-mode-s8 + (! s8->s32 dest src)))) + (#.hard-reg-class-gpr-mode-s32 + (case src-mode + (#.hard-reg-class-gpr-mode-node + (! unbox-s32 dest src)) ((#.hard-reg-class-gpr-mode-u32 #.hard-reg-class-gpr-mode-s32 @@ -4380,5 +4405,5 @@ - +;; xxx imm regs (defun x862-%immediate-set-ptr (seg vreg xfer ptr offset val) (with-x86-local-vinsn-macros (seg vreg xfer) @@ -5305,5 +5330,9 @@ (setq n 0)) (if *x862-open-code-inline* - (let* ((*available-backend-node-temps* (bitclr *x862-arg-z* (bitclr x8664::rcx *available-backend-node-temps*)))) + (let* ((*available-backend-node-temps* + (target-arch-case + ;; I don't see where %ecx is used... + (:x8632 (bitclr x8632::arg_z *available-backend-node-temps*)) + (:x8664 (bitclr x8664::arg_z (bitclr x8664::rcx *available-backend-node-temps*)))))) (! unbind-interrupt-level-inline)) (! unbind-interrupt-level))) @@ -7107,10 +7136,10 @@ (! branch-unless-both-args-fixnums ($ *x862-arg-y*) ($ *x862-arg-z*) (aref *backend-labels* out-of-line))))) (if otherform - (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval x8664::fixnumshift)) + (! %logand-c ($ *x862-arg-z*) ($ *x862-arg-z*) (ash fixval *x862-target-fixnum-shift*)) (! %logand2 ($ *x862-arg-z*) ($ *x862-arg-z*) ($ *x862-arg-y*))) (-> done) (@ out-of-line) (if otherform - (x862-lri seg ($ *x862-arg-y*) (ash fixval x8664::fixnumshift))) + (x862-lri seg ($ *x862-arg-y*) (ash fixval *x862-target-fixnum-shift*))) (! call-subprim-2 ($ *x862-arg-z*) (subprim-name->offset '.SPbuiltin-logand) ($ *x862-arg-y*) ($ *x862-arg-z*)) (@ done) @@ -7408,5 +7437,6 @@ (target-arch-case (:x8632 - (! setup-uvector-allocation n)) + (! setup-uvector-allocation header) + (x862-lri seg x8632::imm0 n)) (:x8664 (x862-lri seg x8664::imm1 n))) @@ -8565,6 +8595,7 @@ (x862-vpop-register seg *x862-arg-z*) (unless (or *x862-reckless* (x862-form-typep x 'macptr)) - (with-imm-temps (src-reg) () - (! trap-unless-macptr *x862-arg-z*))) + (with-additional-imm-reg () + (with-imm-temps (src-reg) () + (! trap-unless-macptr *x862-arg-z*)))) (! set-macptr-address src-reg *x862-arg-z*) (<- *x862-arg-z*) @@ -8573,5 +8604,5 @@ (defx862 x862-%setf-double-float %setf-double-float (seg vref xfer fnode fval) (x862-vpush-register seg (x862-one-untargeted-reg-form seg fnode *x862-arg-z*)) - (let* ((target ($ x8664::fp1 :class :fpr :mode :double-float)) + (let* ((target ($ *x862-fp1* :class :fpr :mode :double-float)) (node ($ *x862-arg-z*))) (x862-one-targeted-reg-form seg fval target) @@ -8728,5 +8759,6 @@ (x862-mvcall seg vreg xfer fn arglist)) - +(defx862 x862-i386-syscall i386-syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports) + (format t "i386-syscall")) (defx862 x862-syscall syscall (seg vreg xfer idx argspecs argvals resultspec &optional monitor-exception-ports) @@ -8822,7 +8854,40 @@ (^))) - (defx862 x862-i386-ff-call i386-ff-call (seg vreg xfer address argspecs argvals resultspec &optional monitor) (declare (ignore monitor)) + #|| + (let* ((*x862-vstack* *x862-vstack*) + (*x862-top-vstack-lcell* *x862-top-vstack-lcell*) + (*x862-cstack* *x862-cstack*) + (return-registers ()) + (simple-foreign-args nil) + (nwords 0)) + (dolist (argspec argspecs) + (case argspec + ((:double-float :unsigned-doubleword :signed-doubleword) + (incf nwords 2)) + (t (incf nwords)))) + (when (null argspecs) + (setq simple-foreign-args t)) + (! alloc-c-frame nwords) + (x862-open-undo $undo-x86-c-frame) + (unless simple-foreign-args + (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8632::arg_z))) + ;; Evaluate each form into the C frame, according to the + ;; matching argspec. + (do* ((specs argspecs (cdr specs)) + (vals argvals (cdr vals))) + ((null specs)) + (declare (list specs vals)) + (let* ((valform (car vals)) + (spec (car specs)) + (absptr (acode-absolute-ptr-p valform))) + (case spec + (:registers) + (:double-float) + (:single-float) + (:address) + (t))))) + ||# (format t "~&i386-ff-call") ) @@ -8875,5 +8940,5 @@ (setq ngpr-args 0 nfpr-args 0) (unless simple-foreign-args - (x862-vpush-register seg (x862-one-untargeted-reg-form seg address *x862-arg-z*))) + (x862-vpush-register seg (x862-one-untargeted-reg-form seg address x8664::arg_z))) ;; Evaluate each form into the C frame, according to the ;; matching argspec. Remember type and arg offset of any FP @@ -8888,5 +8953,5 @@ (case spec (:registers - (let* ((reg (x862-one-untargeted-reg-form seg valform *x862-arg-z*))) + (let* ((reg (x862-one-untargeted-reg-form seg valform x8664::arg_z))) (unless *x862-reckless* (! trap-unless-macptr reg)) @@ -8957,8 +9022,8 @@ (! reload-single-c-arg ($ fpreg :class :fpr :mode :single-float) from)))) (if return-registers - (x862-vpop-register seg ($ *x862-arg-y*))) + (x862-vpop-register seg ($ x8664::arg_y))) (if simple-foreign-args - (x862-one-targeted-reg-form seg address *x862-arg-z*) - (x862-vpop-register seg ($ *x862-arg-z*))) + (x862-one-targeted-reg-form seg address x8664::arg_z) + (x862-vpop-register seg ($ x8664::arg_z))) (x862-lri seg x8664::rax (min 8 nfpr-args)) (if return-registers @@ -8976,5 +9041,5 @@ (progn (! makeu64) - (<- ($ *x862-arg-z*))) + (<- ($ x8664::arg_z))) (<- ($ x8664::rax :class :gpr :mode :u64)))) ((eq resultspec :signed-doubleword) @@ -8982,15 +9047,15 @@ (progn (! makes64) - (<- ($ *x862-arg-z*))) + (<- ($ x8664::arg_z))) (<- ($ x8664::rax :class :gpr :mode :s64)))) (t (case resultspec - (:signed-byte (! sign-extend-s8 *x862-imm0* *x862-imm0*)) - (:signed-halfword (! sign-extend-s16 *x862-imm0* *x862-imm0*)) - (:signed-fullword (! sign-extend-s32 *x862-imm0* *x862-imm0*)) - (:unsigned-byte (! zero-extend-u8 *x862-imm0* *x862-imm0*)) - (:unsigned-halfword (! zero-extend-u16 *x862-imm0* *x862-imm0*)) - (:unsigned-fullword (! zero-extend-u32 *x862-imm0* *x862-imm0*))) - (<- (make-wired-lreg *x862-imm0* + (:signed-byte (! sign-extend-s8 x8664::imm0 x8664::imm0)) + (:signed-halfword (! sign-extend-s16 x8664::imm0 x8664::imm0)) + (:signed-fullword (! sign-extend-s32 x8664::imm0 x8664::imm0)) + (:unsigned-byte (! zero-extend-u8 x8664::imm0 x8664::imm0)) + (:unsigned-halfword (! zero-extend-u16 x8664::imm0 x8664::imm0)) + (:unsigned-fullword (! zero-extend-u32 x8664::imm0 x8664::imm0))) + (<- (make-wired-lreg x8664::imm0 :mode (gpr-mode-name-value @@ -9090,7 +9155,8 @@ (if (not constant) (with-imm-target () (xreg :natural) - (with-imm-target (xreg) (yreg :natural) - (x862-two-targeted-reg-forms seg x xreg y yreg) - (! %natural-logior xreg yreg)) + (with-additional-imm-reg () + (with-imm-target (xreg) (yreg :natural) + (x862-two-targeted-reg-forms seg x xreg y yreg) + (! %natural-logior xreg yreg))) (<- xreg)) (let* ((other (if u31x y x)))