Changeset 7206


Ignore:
Timestamp:
Sep 13, 2007, 1:49:59 AM (12 years ago)
Author:
gb
Message:

Replace START-MV-CALL with VPUSH-LABEL; set vinsn attributes on new vinsn.

Location:
trunk/ccl
Files:
2 edited

Legend:

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

    r6932 r7206  
    27462746  (with-x86-local-vinsn-macros (seg)
    27472747    (when mv-label
    2748       (! start-mv-call (aref *backend-labels* mv-label))
    2749       (setq *x862-vstack* (+  *x862-vstack* *x862-target-node-size*)))
     2748      (x862-vpush-label seg (aref *backend-labels* mv-label)))
    27502749    (when (car args)
    27512750      (! reserve-outgoing-frame)
     
    34953494      (! vpush-register src)
    34963495      (x862-new-vstack-lcell (or why :node) *x862-target-lcell-size* (or attr 0) info)
     3496      (x862-adjust-vstack *x862-target-node-size*))))
     3497
     3498(defun x862-vpush-label (seg label)
     3499  (with-x86-local-vinsn-macros (seg)
     3500    (prog1
     3501      (! vpush-label label)
     3502      (x862-new-vstack-lcell :label *x862-target-lcell-size* 0 nil)
    34973503      (x862-adjust-vstack *x862-target-node-size*))))
    34983504
     
    47514757          (let* ((label (when (or recursive-p (x862-mvpass-p xfer)) (backend-get-next-label))))
    47524758            (when label
    4753               (! start-mv-call (aref *backend-labels* label)))
     4759              (x862-vpush-label seg (aref *backend-labels* label)))
    47544760            (x862-temp-push-node seg (x862-one-untargeted-reg-form seg fn x8664::arg_z))
    47554761            (x862-multiple-value-body seg (pop arglist))
  • trunk/ccl/lib/x86-backtrace.lisp

    r6920 r7206  
    9595      bad)))
    9696
     97(defun %raw-frame-set (frame context idx new)
     98  (declare (fixnum frame idx))
     99  (let* ((base (parent-frame frame context))
     100         (raw-size (- base frame)))
     101    (declare (fixnum base raw-size))
     102    (if (and (>= idx 0)
     103             (< idx raw-size))
     104      (let* ((addr (- (the fixnum (1- base))
     105                      idx)))
     106        (multiple-value-bind (db-count first-db last-db)
     107            (count-db-links-in-frame frame base context)
     108          (let* ((is-db-link
     109                  (unless (zerop db-count)
     110                    (do* ((last last-db (previous-db-link last first-db)))
     111                         ((null last))
     112                      (when (= addr last)
     113                        (return t))))))
     114            (if is-db-link
     115              (oldest-binding-frame-value context addr)
     116              (setf (%fixnum-ref addr) new))))))))
     117
    97118(defun %stack< (index1 index2 &optional context)
    98119  (let* ((tcr (if context (bt.tcr context) (%current-tcr)))
     
    153174    (get-register-value nil last-catch index)))
    154175
     176(defun %set-register-argument-value (context cfp regval new)
     177  (let* ((last-catch (last-catch-since cfp context))
     178         (index (register-number->saved-register-index regval)))
     179    (do* ((frame cfp (child-frame frame context))
     180          (first t))
     181         ((null frame))
     182      (if (xcf-p frame)
     183        (with-macptrs (xp)
     184          (%setf-macptr-to-object xp (%fixnum-ref frame x8664::xcf.xp))
     185          (return-from %set-register-argument-value
     186            (setf (encoded-gpr-lisp xp regval) new)))
     187        (progn
     188          (unless first
     189            (multiple-value-bind (lfun pc)
     190                (cfp-lfun frame)
     191              (when lfun
     192                (multiple-value-bind (mask where)
     193                    (registers-used-by lfun pc)
     194                  (when (if mask (logbitp index mask))
     195                    (incf where (logcount (logandc2 mask (1- (ash 1 (1+ index))))))
     196
     197                    (return-from %set-register-argument-value
     198                      (raw-frame-set frame context where new)))))))
     199          (setq first nil))))
     200    (set-register-value new nil last-catch index)))
     201
    155202;;; Used for printing only.
    156203(defun index->address (p)
Note: See TracChangeset for help on using the changeset viewer.