Changeset 9936


Ignore:
Timestamp:
Jul 10, 2008, 8:45:19 AM (11 years ago)
Author:
gb
Message:

Always generate pc-source-map as an ivector (element-type determined
by width of largest entry.)

Handle comparisons to (lisp) constants a bit more sanely.

X862-%VALID-CODE-CHAR: don't typecheck unless full safety.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/X86/x862.lisp

    r9911 r9936  
    685685(defun x862-generate-pc-source-map (definition-source-note emitted-source-notes)
    686686  (when *fasl-save-source-locations*
    687     (let ((def-start (source-note-start-pos definition-source-note))
    688           (vec (make-array (length emitted-source-notes))))
    689       (loop
    690         for start in emitted-source-notes
    691         for pc-start = (x862-vinsn-note-label-address start t)
    692         for pc-end   = (x862-vinsn-note-label-address (vinsn-note-peer start) nil)
    693         for text-start = (- (source-note-start-pos (aref (vinsn-note-info start) 0)) def-start)
    694         for text-end = (- (source-note-end-pos (aref (vinsn-note-info start) 0)) def-start)
    695         for index upfrom 0
    696         for mapping = (cond
    697                         ((and (<= 0 pc-start   #x8000)
    698                               (<= 0 pc-end     #x8000)
    699                               (<= 0 text-start #x8000)
    700                               (<= 0 text-end   #x8000))
    701                          (let ((mapping 0))
    702                            (setf (ldb (byte 15 0) mapping)  pc-start
    703                                  (ldb (byte 15 15) mapping) pc-end
    704                                  (ldb (byte 15 30) mapping) text-start
    705                                  (ldb (byte 15 45) mapping) text-end)
    706                            mapping))
    707                         ((and (plusp pc-start) (plusp pc-end) (plusp text-start) (plusp text-end))
    708                          (vector pc-start pc-end text-start text-end))
    709                         (t nil))
    710         do (setf (aref vec index) mapping))
    711       ;; Remove source notes that didn't pan out (forms from other sources)
    712       (delete nil vec))))
     687    (let* ((def-start (source-note-start-pos definition-source-note))
     688           (n (length emitted-source-notes))
     689           (nvalid 0)
     690           (max 0)
     691           (pc-starts (make-array n))
     692           (pc-ends (make-array n))
     693           (text-starts (make-array n))
     694           (text-ends (make-array n)))
     695      (declare (fixnum n nvalid)
     696               (dynamic-extent pc-starts pc-ends text-starts text-ends))
     697      (dolist (start emitted-source-notes)
     698        (let* ((pc-start (x862-vinsn-note-label-address start t))
     699               (pc-end (x862-vinsn-note-label-address (vinsn-note-peer start) nil))
     700               (text-start (- (source-note-start-pos (aref (vinsn-note-info start) 0)) def-start))
     701               (text-end (- (source-note-end-pos (aref (vinsn-note-info start) 0)) def-start)))
     702          (declare (fixnum pc-start pc-end text-start text-end))
     703          (when (and (plusp pc-start)
     704                     (plusp pc-end)
     705                     (plusp text-start)
     706                     (plusp text-end))
     707            (if (> pc-start max) (setq max pc-start))
     708            (if (> pc-end max) (setq max pc-end))
     709            (if (> text-start max) (setq max text-start))
     710            (if (> text-end max) (setq max text-end))
     711            (setf (svref pc-starts nvalid) pc-start
     712                  (svref pc-ends nvalid) pc-end
     713                  (svref text-starts nvalid) text-start
     714                  (svref text-ends nvalid) text-end)
     715            (incf nvalid))))
     716      (let* ((nentries (* nvalid 4))
     717             (vec (cond ((< max #x100) (make-array nentries :element-type '(unsigned-byte 8)))
     718                        ((< max #x10000) (make-array nentries :element-type '(unsigned-byte 16)))
     719                        (t (make-array nentries :element-type '(unsigned-byte 32))))))
     720        (declare (fixnum nentries))
     721        (do* ((i 0 (+ i 4))
     722              (j 1 (+ j 4))
     723              (k 2 (+ k 4))
     724              (l 3 (+ l 4))
     725              (idx 0 (1+ idx)))
     726             ((= i nentries) vec)
     727          (declare (fixnum i j k l idx))
     728          (setf (aref vec i) (svref pc-starts idx)
     729                (aref vec j) (svref pc-ends idx)
     730                (aref vec k) (svref text-starts idx)
     731                (aref vec l) (svref text-ends idx)))))))
     732
    713733
    714734(defun x862-vinsn-note-label-address (note &optional start-p sym)
     
    17231743        (when safe
    17241744          (if (typep safe 'fixnum)
    1725             (! trap-unless-typecode= src safe))
     1745            (! trap-unless-subtag= src safe))
    17261746          (unless index-known-fixnum
    17271747            (! trap-unless-fixnum unscaled-idx))
     
    19902010          (with-imm-temps (target) ()   ; Don't use target in type/bounds check
    19912011            (if (typep safe 'fixnum)
    1992               (! trap-unless-typecode= src safe))
     2012              (! trap-unless-subtag= src safe))
    19932013            (unless index-known-fixnum
    19942014              (! trap-unless-fixnum unscaled-idx))
     
    24382458              (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*)))
    24392459            (if (typep safe 'fixnum)
    2440               (! trap-unless-typecode= src safe))
     2460              (! trap-unless-subtag= src safe))
    24412461            (unless index-known-fixnum
    24422462              (! trap-unless-fixnum unscaled-idx))
     
    33713391              (let* ((operator (acode-operator value)))
    33723392                (member operator *x862-operator-supports-push*)))
    3373         (acode-unwrapped-form form)))))
     3393        value))))
    33743394
    33753395(defun x862-compare-u8 (seg vreg xfer form u8constant cr-bit true-p u8-operator)
     
    34183438                   (setq src (x862-one-untargeted-reg-form seg vector x8664::arg_z)))
    34193439                 (when safe
    3420                    (! trap-unless-typecode= src (nx-lookup-target-uvector-subtag :bit-vector))
     3440                   (! trap-unless-subtag= src (nx-lookup-target-uvector-subtag :bit-vector))
    34213441                   (unless index-known-fixnum
    34223442                     (! trap-unless-fixnum unscaled-idx))
     
    35573577           (^))))
    35583578      (^))))
     3579
     3580(defun x862-compare-register-to-constant (seg vreg xfer ireg cr-bit true-p constant)
     3581  (cond ((eq constant *nx-nil*)
     3582         (x862-compare-register-to-nil seg vreg xfer ireg cr-bit true-p))
     3583        (t
     3584         (with-x86-local-vinsn-macros (seg vreg xfer)
     3585           (when vreg
     3586             (if (eq constant *nx-t*)
     3587               (! compare-to-t ireg)
     3588               (let* ((imm (x862-immediate-operand constant))
     3589                      (reg (x862-register-constant-p imm)))
     3590                 (if reg
     3591                   (! compare-registers reg ireg)
     3592                   (! compare-constant-to-register (x86-immediate-label imm) ireg))))
     3593             (regspec-crf-gpr-case
     3594              (vreg dest)
     3595              (^ cr-bit true-p)
     3596              (progn
     3597                (ensuring-node-target (target dest)
     3598                  (if (not true-p)
     3599                    (setq cr-bit (logxor 1 cr-bit)))
     3600                  (! cr-bit->boolean target cr-bit))
     3601                (^))))))))
    35593602
    35603603(defun x862-compare-register-to-nil (seg vreg xfer ireg cr-bit true-p)
     
    58045847                (when hardopt
    58055848                  (x862-reserve-vstack-lcells num-opt)
    5806                   (x862-lri seg x8664::imm0 (ash num-opt *x862-target-fixnum-shift*))
    58075849
    58085850                  ;; ! opt-supplied-p wants nargs to contain the
     
    58165858                        ((= 2 num-opt)
    58175859                         (! two-opt-supplied-p))
    5818                         (t (! opt-supplied-p))))
     5860                        (t (! opt-supplied-p num-opt))))
    58195861                (let* ((nwords-vpushed (+ num-fixed
    58205862                                          num-opt
     
    59315973                       (= (get-regspec-mode vreg) hard-reg-class-gpr-mode-node)))
    59325974             (first (pop forms)))
    5933         (x862-push-register seg
    5934                             (if (or node-p crf-p)
    5935                               (x862-one-untargeted-reg-form seg first x8664::arg_z)
    5936                               (x862-one-targeted-reg-form seg first vreg)))
    5937         (dolist (form forms)
    5938           (x862-form seg nil nil form))
    5939         (if crf-p
     5975        (if (and node-p
     5976                 (nx-null (car forms))
     5977                 (null (cdr forms)))
     5978          (x862-form seg vreg xfer first)
    59405979          (progn
    5941             (x862-vpop-register seg x8664::arg_z)
    5942             (<- x8664::arg_z))
    5943           (x862-pop-register seg vreg))
    5944         (^)))))
     5980            (x862-push-register seg
     5981                                (if (or node-p crf-p)
     5982                                  (x862-one-untargeted-reg-form seg first x8664::arg_z)
     5983                                  (x862-one-targeted-reg-form seg first vreg)))
     5984            (dolist (form forms)
     5985              (x862-form seg nil nil form))
     5986            (if crf-p
     5987              (progn
     5988                (x862-vpop-register seg x8664::arg_z)
     5989                (<- x8664::arg_z))
     5990              (x862-pop-register seg vreg))
     5991            (^)))))))
    59455992
    59465993(defx862 x862-free-reference free-reference (seg vreg xfer sym)
     
    63696416(defx862 x862-%valid-code-char %valid-code-char (seg vreg xfer c)
    63706417  (let* ((reg (x862-one-untargeted-reg-form seg c x8664::arg_z)))
    6371     ;; Typecheck even if result unused.
    6372     (unless *x862-reckless* (! require-char-code reg))
     6418    (when *x862-full-safety* (! require-char-code reg))
    63736419    (if vreg
    63746420      (ensuring-node-target (target vreg)
     
    63766422    (^)))
    63776423
     6424(defun x862-eq-test (seg vreg xfer cc form1 form2)
     6425  (with-x86-local-vinsn-macros (seg)
     6426    (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
     6427      (let* ((f1 (acode-unwrapped-form form1))
     6428             (f2 (acode-unwrapped-form form2)))
     6429        (cond ((or (eq f1 *nx-nil*)
     6430                   (eq f1 *nx-t*)
     6431                   (and (acode-p f1)
     6432                        (eq (acode-operator f1) (%nx1-operator immediate))))
     6433               (x862-compare-register-to-constant seg vreg xfer (x862-one-untargeted-reg-form seg form2 ($ x8664::arg_z)) cr-bit true-p f1))
     6434              ((or (eq f2 *nx-nil*)
     6435                   (eq f2 *nx-t*)
     6436                   (and (acode-p f2)
     6437                        (eq (acode-operator f2) (%nx1-operator immediate))))
     6438               (x862-compare-register-to-constant seg vreg xfer
     6439                                                  (x862-one-untargeted-reg-form seg form1 ($ x8664::arg_z))
     6440                                                  cr-bit true-p f2))
     6441              (t (x862-compare seg vreg xfer form1 form2 cr-bit true-p)))))))
     6442
    63786443(defx862 x862-eq eq (seg vreg xfer cc form1 form2)
    6379   (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
    6380     (x862-compare seg vreg xfer form1 form2 cr-bit true-p)))
     6444  (x862-eq-test seg vreg xfer cc form1 form2))
    63816445
    63826446(defx862 x862-neq neq (seg vreg xfer cc form1 form2)
    6383   (multiple-value-bind (cr-bit true-p) (acode-condition-to-x86-cr-bit cc)
    6384     (x862-compare seg vreg xfer form1 form2 cr-bit true-p)))
     6447  (x862-eq-test seg vreg xfer cc form1 form2))
    63856448
    63866449(defx862 x862-numcmp numcmp (seg vreg xfer cc form1 form2)
     
    92009263   (when vreg
    92019264     (ensuring-node-target (target vreg)
    9202                                 (! %foreign-stack-pointer target)))
     9265      (! %foreign-stack-pointer target)))
    92039266   (^))
    92049267
     
    93719434                                         '%short-float)
    93729435                             (list nil (list arg))))))))
     9436
     9437
     9438                       
    93739439   
    93749440
Note: See TracChangeset for help on using the changeset viewer.