Changeset 12256


Ignore:
Timestamp:
Jun 11, 2009, 12:23:17 PM (10 years ago)
Author:
gz
Message:

r11421 r11467 r11631 r11711 r11749 r11796 f11861 r11862 r11977 r12127 from trunk

Location:
branches/working-0711/ccl/compiler
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/X8632/x8632-arch.lisp

    r12202 r12256  
    697697  tcr-frame-ptr
    698698  register-xmacptr-dispose-function
    699   raise-thread-interrupt
     699  open-debug-output
    700700  get-r-debug
    701701  restore-soft-stack-limit
     
    703703  lisp-bug
    704704  NewThread
    705   YieldToThread
     705  cooperative-thread-startup
    706706  DisposeThread
    707707  ThreadCurrentStackSpace
  • branches/working-0711/ccl/compiler/X86/X8632/x8632-vinsns.lisp

    r12198 r12256  
    5454                                              ((v :lisp)
    5555                                               (idx :s32const)))
    56   (movsd (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx x8632::word-shift)) (:%l v)) (:%xmm dest)))
     56  (movsd (:@ (:apply + x8632::misc-dfloat-offset (:apply ash idx 3)) (:%l v)) (:%xmm dest)))
    5757
    5858(define-x8632-vinsn misc-ref-node  (((dest :lisp))
     
    14371437;;; IWBNI we could simply call the "trap-unless-typecode=" vinsn here,
    14381438;;; instead of replicating it ..
    1439 ;;; get-double?
    1440 
     1439(define-x8632-vinsn get-double? (((target :double-float))
     1440                                 ((source :lisp))
     1441                                 ((tag :u8)))
     1442  :resume
     1443  (movl (:%l source) (:%l tag))
     1444  ((:pred = (:apply %hard-regspec-value tag) x8632::eax)
     1445   (andl (:$b x8632::tagmask) (:%accl tag))
     1446   (cmpl (:$b x8632::tag-misc) (:%accl tag)))
     1447  ((:pred > (:apply %hard-regspec-value tag) x8632::eax)
     1448   (andl (:$b x8632::tagmask) (:%l tag))
     1449   (cmpl (:$b x8632::tag-misc) (:%l tag)))
     1450  (jne :have-tag)
     1451  (movsbl (:@ x8632::misc-subtag-offset (:%l source)) (:%l tag))
     1452  :have-tag
     1453  (cmpl (:$b x8632::subtag-double-float) (:%l tag))
     1454  (jne :bad)
     1455  (movsd (:@  x8632::double-float.value (:%l source)) (:%xmm target))
     1456
     1457  (:anchored-uuo-section :resume)
     1458  :bad
     1459  (:anchored-uuo (uuo-error-reg-not-tag (:%q source) (:$ub x8632::subtag-double-float))))
    14411460
    14421461(define-x8632-vinsn copy-double-float (((dest :double-float))
     
    18581877  (jmp (:@ .SPnmkunwind)))
    18591878
     1879(define-x8632-vinsn u16->u32 (((dest :u32))
     1880                              ((src :u16)))
     1881  (movzwl (:%w src) (:%l dest)))
     1882
     1883(define-x8632-vinsn u8->u32 (((dest :u32))
     1884                             ((src :u8)))
     1885  (movzbl (:%b src) (:%l dest)))
     1886
     1887(define-x8632-vinsn s16->s32 (((dest :s32))
     1888                              ((src :s16)))
     1889  (movswl (:%w src) (:%l dest)))
     1890
     1891(define-x8632-vinsn s8->s32 (((dest :s32))
     1892                             ((src :s8)))
     1893  (movsbl (:%b src) (:%l dest)))
    18601894
    18611895(define-x8632-subprim-jump-vinsn (tail-call-fn-gen) .SPtcallnfngen)
     
    31283162  ((:pred = 0 (:apply ash offset -5))
    31293163   (btrl (:$ub (:apply logand 31 offset))
    3130         (:@  (:%q src))))
     3164        (:@  (:%l src))))
    31313165  ((:not (:pred = 0 (:apply ash offset -5)))
    31323166   (btrl (:$ub (:apply logand 31 offset))
    3133          (:@ (:apply ash (:apply ash offset -5) 4) (:%q src))))
     3167         (:@ (:apply ash (:apply ash offset -5) 4) (:%l src))))
    31343168  (jmp :done)
    31353169  :set
    31363170  ((:pred = 0 (:apply ash offset -5))
    31373171   (btsl (:$ub (:apply logand 31 offset))
    3138          (:@  (:%q src))))
     3172         (:@  (:%l src))))
    31393173  ((:not (:pred = 0 (:apply ash offset -5)))
    31403174   (btsl (:$ub (:apply logand 31 offset))
    3141          (:@ (:apply ash (:apply ash offset -5) 2) (:%q src))))
     3175         (:@ (:apply ash (:apply ash offset -5) 2) (:%l src))))
    31423176  :done)
    31433177
     
    36863720                                   ((temp :imm)))
    36873721  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
    3688   (subl (:$l (:apply ash nwords x8632::word-shift))
     3722  ;; Work around Apple bug number 6386516 (open stub may clobber stack)
     3723  ;; by leaving an extra word of space in the parameter area.
     3724  (subl (:$l (:apply ash (:apply 1+ nwords) x8632::word-shift))
    36893725        (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
    36903726  ;; align stack to 16-byte boundary
     
    36993735                                            ((temp :imm)))
    37003736  (movd (:@ (:%seg :rcontext) x8632::tcr.foreign-sp) (:%mmx x8632::stack-temp))
    3701   (subl (:%l nwords) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
     3737  ;; Work around Apple bug number 6386516 (open stub may clobber stack)
     3738  ;; by leaving an extra word of space in the parameter area.
     3739  ;; Note that nwords is a fixnum.
     3740  (leal (:@ 4 (:%l nwords)) (:%l temp))
     3741  (subl (:%l temp) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
    37023742  ;; align stack to 16-byte boundary
    37033743  (andb (:$b -16) (:@ (:%seg :rcontext) x8632::tcr.foreign-sp))
     
    37773817  ((:not (:pred = 0 (:apply ash offset -5)))
    37783818   (btl (:$ub (:apply logand 31 offset))
    3779         (:@ (:apply ash (:apply ash offset -5) 2) (:%q src))))
    3780   (movl (:$l x8664::fixnumone) (:%l temp))
     3819        (:@ (:apply ash (:apply ash offset -5) 2) (:%l src))))
     3820  (movl (:$l x8632::fixnumone) (:%l temp))
    37813821  (movl (:$l 0) (:%l dest))
    37823822  (cmovbl (:%l temp) (:%l dest)))
  • branches/working-0711/ccl/compiler/X86/X8664/x8664-arch.lisp

    r12202 r12256  
    797797  tcr-frame-ptr
    798798  register-xmacptr-dispose-function
    799   raise-thread-interrupt
     799  open-debug-output
    800800  get-r-debug
    801801  restore-soft-stack-limit
  • branches/working-0711/ccl/compiler/X86/x86-arch.lisp

    r10972 r12256  
    5656    stack-size                          ; value of --stack-size arg
    5757    objc-2-begin-catch                  ; objc_begin_catch
    58     bad-funcall                         ; pseudo-target for funcall
     58    kernel-path
    5959    all-areas                           ; doubly-linked area list
    6060    lexpr-return                        ; multiple-value lexpr return address
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r12054 r12256  
    33193319           (csp-p (vinsn-attribute-p push-vinsn :csp)))
    33203320      (when csp-p                       ; vsp case is harder.
    3321         (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
    3322                                    push-vinsn pop-vinsn pushed-reg))
    3323                (popped-reg-is-set (if same-reg
    3324                                     pushed-reg-is-set
    3325                                     (vinsn-sequence-sets-reg-p
    3326                                      push-vinsn pop-vinsn popped-reg))))
    3327           (unless (and pushed-reg-is-set popped-reg-is-set)
    3328             (unless same-reg
    3329               (let* ((copy (if (eq (hard-regspec-class pushed-reg)
    3330                                    hard-reg-class-fpr)
    3331                              (if (= (get-regspec-mode pushed-reg)
    3332                                     hard-reg-class-fpr-mode-double)
    3333                                (! copy-double-float popped-reg pushed-reg)
    3334                                (! copy-single-float popped-reg pushed-reg))
    3335                              (! copy-gpr popped-reg pushed-reg))))
    3336                 (remove-dll-node copy)
    3337                 (if pushed-reg-is-set
    3338                   (insert-dll-node-after copy push-vinsn)
    3339                   (insert-dll-node-before copy push-vinsn))))
    3340             (elide-vinsn push-vinsn)
    3341             (elide-vinsn pop-vinsn)))))))
     3321        (unless (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :csp :discard)
     3322          (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
     3323                                     push-vinsn pop-vinsn pushed-reg))
     3324                 (popped-reg-is-set (if same-reg
     3325                                      pushed-reg-is-set
     3326                                      (vinsn-sequence-sets-reg-p
     3327                                       push-vinsn pop-vinsn popped-reg))))
     3328            (unless (and pushed-reg-is-set popped-reg-is-set)
     3329              (unless same-reg
     3330                (let* ((copy (if (eq (hard-regspec-class pushed-reg)
     3331                                     hard-reg-class-fpr)
     3332                               (if (= (get-regspec-mode pushed-reg)
     3333                                      hard-reg-class-fpr-mode-double)
     3334                                 (! copy-double-float popped-reg pushed-reg)
     3335                                 (! copy-single-float popped-reg pushed-reg))
     3336                               (! copy-gpr popped-reg pushed-reg))))
     3337                  (remove-dll-node copy)
     3338                  (if pushed-reg-is-set
     3339                    (insert-dll-node-after copy push-vinsn)
     3340                    (insert-dll-node-before copy push-vinsn))))
     3341              (elide-vinsn push-vinsn)
     3342              (elide-vinsn pop-vinsn))))))))
    33423343               
    33433344       
  • branches/working-0711/ccl/compiler/optimizers.lisp

    r12048 r12256  
    7979                     car cdr cadr cddr nth nthcdr last load-byte deposit-byte byte-mask
    8080                     member search count position assoc rassoc integer-length
    81                          float not null char-int expt abs))
     81                         float not null char-int expt abs
     82                     = /= < <= > >=))
    8283
    8384(defun %binop-cassoc (call)
  • branches/working-0711/ccl/compiler/vinsn.lisp

    r11412 r12256  
    491491       
    492492
     493;;; Return T if any vinsn between START and END (exclusive) has all
     494;;; attributes set in MASK set.
     495(defun %vinsn-sequence-has-attribute-p (start end attr)
     496  (do* ((element (vinsn-succ start) (vinsn-succ element)))
     497       ((eq element end))
     498    (when (typep element 'vinsn)
     499      (when (eql attr (logand (vinsn-template-attributes (vinsn-template element))))
     500        (return t)))))
     501
     502(defmacro vinsn-sequence-has-attribute-p (start end &rest attrs)
     503  `(%vinsn-sequence-has-attribute-p ,start ,end ,(encode-vinsn-attributes attrs)))
     504
     505                               
    493506;;; Flow-graph nodes (FGNs)
    494507
Note: See TracChangeset for help on using the changeset viewer.