Changeset 6470


Ignore:
Timestamp:
May 9, 2007, 7:36:38 AM (15 years ago)
Author:
gb
Message:

Support the new (call/ret) calling sequence, new tra/talign scheme.
One more imm reg, so 3d aset is less nasty.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/ccl/compiler/X86/x862.lisp

    r6307 r6470  
    1616
    1717(in-package "CCL")
    18 6
     18
    1919(eval-when (:compile-toplevel :execute)
    2020  (require "NXENV")
     
    3636(defparameter *x862-target-num-arg-regs* 0)
    3737(defparameter *x862-target-num-save-regs* 0)
     38(defparameter *x862-target-half-fixnum-type* nil)
    3839
    3940(defparameter *x862-operator-supports-u8-target* ())
     
    457458           (*x862-target-bits-in-word* (arch::target-nbits-in-word (backend-target-arch *target-backend*)))
    458459           (*x862-target-node-size* *x862-target-lcell-size*)
     460           (*x862-target-half-fixnum-type* `(signed-byte ,(- *x862-target-bits-in-word*
     461                                                            (1+ *x862-target-fixnum-shift*))))
    459462           (*x862-target-dnode-size* (* 2 *x862-target-lcell-size*))
    460463           (*x862-all-lcells* ())
     
    17351738                                          new val-reg)
    17361739            (x862-pop-register seg src)))
    1737         (let* ((need-push-val-reg
    1738                 (and (= (hard-regspec-class val-reg) hard-reg-class-gpr)
     1740        (let* ((*available-backend-imm-temps* *available-backend-imm-temps*))
     1741          (when (and (= (hard-regspec-class val-reg) hard-reg-class-gpr)
    17391742                     (logbitp (hard-regspec-value val-reg)
    1740                               *backend-imm-temps*))))
    1741           (when need-push-val-reg (x862-push-register seg val-reg))
     1743                              *backend-imm-temps*))
     1744            (use-imm-temp (hard-regspec-value val-reg)))
     1745       
    17421746          (when safe     
    17431747            (when (typep safe 'fixnum)
     
    17661770                (let* ((v ($ x8664::arg_x)))
    17671771                  (! array-data-vector-ref v src)
    1768                   (when need-push-val-reg
    1769                     (x862-pop-register seg val-reg))
    17701772                  (x862-vset1 seg vreg xfer type-keyword v idx-reg constidx val-reg (x862-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval needs-memoization))))))))))
    17711773
     
    21002102                          (if (typep constval '(unsigned-byte 32))
    21012103                            (x862-lri seg reg constval)
    2102                             (! unbox-u32 reg result-reg))))
     2104                            (if *x862-reckless*
     2105                              (! %unbox-u32 reg result-reg)
     2106                              (! unbox-u32 reg result-reg)))))
    21032107                   reg)))
    21042108              (is-16-bit
     
    21072111                   (if (typep constval '(signed-byte 16))
    21082112                     (x862-lri seg reg constval)
    2109                      (! unbox-s16 reg result-reg))
     2113                     (if *x862-reckless*
     2114                       (! %unbox-s16 reg result-reg)
     2115                       (! unbox-s16 reg result-reg)))
    21102116                   reg)
    21112117                 (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u16)))
    21122118                   (if (typep constval '(unsigned-byte 16))
    21132119                     (x862-lri seg reg constval)
    2114                      (! unbox-u16 reg result-reg))
     2120                     (if *x862-reckless*
     2121                       (! %unbox-u16 reg result-reg)
     2122                       (! unbox-u16 reg result-reg)))
    21152123                   reg)))
    21162124              (is-8-bit
     
    21192127                   (if (typep constval '(signed-byte 8))
    21202128                     (x862-lri seg reg constval)
    2121                      (! unbox-s8 reg result-reg))
     2129                     (if *x862-reckless*
     2130                       (! %unbox-s8 reg result-reg)
     2131                       (! unbox-s8 reg result-reg)))
    21222132                   reg)
    21232133                 (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u8)))
    21242134                   (if (typep constval '(unsigned-byte 8))
    21252135                     (x862-lri seg reg constval)
    2126                      (! unbox-u8 reg result-reg))
     2136                     (if *x862-reckless*
     2137                       (! %unbox-u8 reg result-reg)
     2138                       (! unbox-u8 reg result-reg)))
    21272139                   reg)))
    21282140              (t
     
    24262438  (with-x86-local-vinsn-macros (seg)
    24272439    (! emit-aligned-label (aref *backend-labels* labelnum))
    2428     (@ labelnum)))
     2440    (@ labelnum)
     2441    (! recover-fn-from-rip)))
    24292442
    24302443 
     
    24442457           (label-p (and (fixnump fn)
    24452458                         (locally (declare (fixnum fn))
    2446                            (and (= fn -1) (- fn)))))
     2459                           (and (= fn -2) (- fn)))))
    24472460           (tail-p (eq xfer $backend-return))
    24482461           (func (if (consp f-op) (%cadr f-op)))
     
    24992512                (! pass-multiple-values))
    25002513              (when mvpass-label
    2501                 (@= mvpass-label)
    2502                 (! recover-fn-from-ra0 (aref *backend-labels* mvpass-label))))
     2514                (@= mvpass-label)))
    25032515            (progn
    25042516              (if label-p
    25052517                (progn
    2506                   (! call-label (aref *backend-labels* 1)))
     2518                  (! call-label (aref *backend-labels* 2)))
    25072519                (progn
    25082520                  (if a-reg
     
    25552567              (progn (! pass-multiple-values)
    25562568                     (when mvpass-label
    2557                        (@= mvpass-label)
    2558                        (! recover-fn-from-ra0 (aref *backend-labels* mvpass-label))))
     2569                       (@= mvpass-label)))
    25592570              (! funcall))                 
    25602571            (cond ((or (null nargs) spread-p)
     
    26062617             (dest ($ x8664::arg_z))
    26072618             (vsize (+ (length inherited-vars)
    2608                        4                ; %closure-code%, afunc
     2619                       5                ; %closure-code%, afunc
    26092620                       1)))             ; lfun-bits
    26102621        (declare (list inherited-vars))
    2611         (let* ((cell 3))
     2622        (let* ((cell 4))
    26122623          (declare (fixnum cell))
    26132624          (if downward-p
     
    26242635              (x862-lri seg x8664::imm1 (- (ash (logandc2 (+ vsize 2) 1) (arch::target-word-shift arch)) (target-arch-case  (:x8664 x8664::fulltag-misc))))
    26252636              (! %allocate-uvector dest)))
    2626           (! init-closure x8664::arg_z)
     2637          (! init-nclosure x8664::arg_z)
    26272638          (x862-store-immediate seg (x862-afunc-lfun-ref afunc) x8664::ra0)
    26282639          (with-node-temps (x8664::arg_z) (t0 t1 t2 t3)
     
    41364147      (x862-%immediate-set-ptr seg vreg xfer  ptr offset val)
    41374148      (let* ((size (logand #xf bits))
    4138              (signed (logbitp 5 bits))
     4149             (signed (not (logbitp 5 bits)))
    41394150             (nbits (ash size 3))
    41404151             (intval (acode-integer-constant-p val nbits))
     
    49224933                  (push reason unbind))))
    49234934            (if unbind
    4924               (x862-dpayback-list seg (nreverse unbind)))
     4935              (let* ((*available-backend-imm-temps* *available-backend-imm-temps*))
     4936                (when retval (use-imm-temp x8664::nargs.q))
     4937                (x862-dpayback-list seg (nreverse unbind))))
    49254938            (when (and (neq lastcatch dest)
    49264939                       (%i>
     
    52945307                         (:long (frag-list-push-32 frag-list val))
    52955308                         (:quad (frag-list-push-64 frag-list val))
    5296                          (:align (finish-frag-for-align frag-list val))))
     5309                         (:align (finish-frag-for-align frag-list val))
     5310                         (:talign (finish-frag-for-talign frag-list val))))
    52975311                     (let* ((pos (frag-list-position frag-list))
    52985312                            (frag (frag-list-current frag-list))
     
    53075321                         (:quad (frag-list-push-64 frag-list 0)
    53085322                                (setq reloctype :expr64))
    5309                          (:align (error ":align expression ~s not constant" arg)))
     5323                         ((:align :talign) (error "~s expression ~s not constant" directive arg)))
    53105324                       (when reloctype
    53115325                         (push
     
    54345448          (x862-allocate-global-registers *x862-fcells* *x862-vcells* (afunc-all-vars afunc) no-regs))
    54355449        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
     5450        (! establish-fn)
     5451        (@ (backend-get-next-label)) ; self-call label
    54365452        (unless next-method-p
    54375453          (setq method-var nil))
     
    62976313(defx862 x862-self-call self-call (seg vreg xfer arglist &optional spread-p)
    62986314  (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
    6299   (x862-call-fn seg vreg xfer -1 arglist spread-p))
     6315  (x862-call-fn seg vreg xfer -2 arglist spread-p))
    63006316
    63016317
     
    67756791         (keyword (if (and atype
    67766792                           (let* ((dims (array-ctype-dimensions atype)))
    6777                              (or (atom dims)
    6778                                  (= (length dims) 1)))
     6793                             (and (not (atom dims))
     6794                                  (= (length dims) 1)))
    67796795                           (not (array-ctype-complexp atype)))
    67806796                    (funcall
     
    67926808         (keyword (if (and atype
    67936809                           (let* ((dims (array-ctype-dimensions atype)))
    6794                              (or (atom dims)
     6810                             (and (not (atom dims))
    67956811                                 (= (length dims) 1)))
    67966812                           (not (array-ctype-complexp atype)))
     
    68046820
    68056821(defx862 x862-%i+ %i+ (seg vreg xfer form1 form2 &optional overflow)
     6822  (when overflow
     6823    (let* ((type *x862-target-half-fixnum-type*))
     6824      (when (and (x862-form-typep form1 type)
     6825               (x862-form-typep form2 type))
     6826        (setq overflow nil))))
    68066827  (cond ((null vreg)
    68076828         (x862-form seg nil nil form1)
     
    68546875
    68556876(defx862 x862-%i- %i- (seg vreg xfer num1 num2 &optional overflow)
     6877  (when overflow
     6878    (let* ((type *x862-target-half-fixnum-type*))
     6879      (when (and (x862-form-typep num1 type)
     6880                 (x862-form-typep num2 type))
     6881        (setq overflow nil))))
    68566882  (let* ((v1 (acode-fixnum-form-p num1))
    68576883         (v2 (acode-fixnum-form-p num2)))
     
    75557581        (push v real-vars)
    75567582        (push func real-funcs)
    7557         (let* ((i 4)                    ; skip 3 words of code, inner function
     7583        (let* ((i 5)                    ; skip 4 words of code, inner function
    75587584               (our-var nil)
    75597585               (item nil))
     
    77387764    (x862-one-targeted-reg-form seg tag ($ x8664::arg_z))
    77397765    (if mv-pass
    7740       (! mkcatchmv tag-label-value)
    7741       (! mkcatch1v tag-label-value))
     7766      (! nmkcatchmv tag-label-value)
     7767      (! nmkcatch1v tag-label-value))
    77427768    (x862-open-undo)
    77437769    (if mv-pass
     
    77507776    (x862-close-undo)
    77517777    (@= tag-label)
    7752     (! recover-fn-from-ra0  (aref *backend-labels* tag-label))
    77537778    (unless mv-pass (if vreg (<- x8664::arg_z)))
    77547779    (let* ((*x862-returning-values* mv-pass)) ; nlexit keeps values on stack
     
    77807805                       (let* ((dims (array-ctype-dimensions atype)))
    77817806                         (and (typep dims 'list)
    7782                              
    77837807                              (= 2 (length dims))))
    77847808                       (not (array-ctype-complexp atype))
     
    77987822                         j
    77997823                         (if *x862-reckless*
    7800                            *nx-nil*
     7824                           nil
    78017825                           (nx-lookup-target-uvector-subtag keyword ))
    78027826                         keyword ;(make-acode (%nx1-operator immediate) )
     
    78517875                         k
    78527876                         (if *x862-reckless*
    7853                            *nx-nil*
     7877                           nil
    78547878                           (nx-lookup-target-uvector-subtag keyword ))
    78557879                         keyword ;(make-acode (%nx1-operator immediate) )
     
    82008224         (protform-label (backend-get-next-label))
    82018225         (old-stack (x862-encode-stack))
    8202          (yreg ($ x8664::arg_y)))
    8203     (! ref-interrupt-level yreg)
    8204     (x862-dbind seg (make-acode (%nx1-operator fixnum) -1) '*interrupt-level*)
    8205     (! mkunwind (aref *backend-labels* protform-label)
     8226         (ilevel '*interrupt-level*))
     8227    (! nmkunwind
     8228       (aref *backend-labels* protform-label)
    82068229       (aref *backend-labels* cleanup-label))
     8230    (x862-open-undo $undointerruptlevel)
     8231    (x862-new-vstack-lcell :special-value *x862-target-lcell-size* 0 ilevel)
     8232    (x862-new-vstack-lcell :special *x862-target-lcell-size* (ash 1 $vbitspecial) ilevel)
     8233    (x862-new-vstack-lcell :special-link *x862-target-lcell-size* 0 ilevel)
     8234    (x862-adjust-vstack (* 3 *x862-target-node-size*))   
    82078235    (@= cleanup-label)
    82088236    (let* ((*x862-vstack* *x862-vstack*)
    82098237           (*x862-top-vstack-lcell* *x862-top-vstack-lcell*))
    82108238      (x862-open-undo $undostkblk)      ; tsp frame created by nthrow.
    8211       (! save-cleanup-context (aref *backend-labels* cleanup-label))
    8212       (x862-vpush-register seg x8664::ra0)
     8239      (x862-new-vstack-lcell :cleanup-return *x862-target-lcell-size* 0 nil)
     8240      (x862-adjust-vstack *x862-target-node-size*)     
    82138241      (x862-form seg nil nil cleanup-form)
    82148242      (x862-close-undo)
    8215       (x862-vpop-register seg x8664::ra0)
    82168243      (! jump-return-pc))
    82178244    (x862-open-undo)
    82188245    (@=  protform-label)
    8219     (x862-dbind seg yreg '*interrupt-level*)
     8246    (x862-open-undo $undointerruptlevel)
     8247    (x862-new-vstack-lcell :special-value *x862-target-lcell-size* 0 ilevel)
     8248    (x862-new-vstack-lcell :special *x862-target-lcell-size* (ash 1 $vbitspecial) ilevel)
     8249    (x862-new-vstack-lcell :special-link *x862-target-lcell-size* 0 ilevel)
     8250    (x862-adjust-vstack (* 3 *x862-target-node-size*))
    82208251    (x862-undo-body seg vreg xfer protected-form old-stack)))
    82218252
Note: See TracChangeset for help on using the changeset viewer.