Changeset 14017 for branches


Ignore:
Timestamp:
Jul 22, 2010, 12:42:13 PM (9 years ago)
Author:
gb
Message:

Handle new array UUOs.
Conditionalize for ARM, provide some missing stack-walking functions.

Location:
branches/arm
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/arm/level-1/arm-error-signal.lisp

    r13999 r14017  
    217217                           (arg-b (xp-gpr-lisp xp (ldb (byte 4 12) uuo)))
    218218                           (arg-c (xp-gpr-lisp xp (ldb (byte 4 16) uuo))))
     219                      (setq *error-reentry-count* 0)
    219220                      (setf (xp-gpr-lisp xp reg-a)
    220221                            (%slot-unbound-trap arg-b arg-c frame-ptr))))
     
    248249                             (%error "FPU exception, fpscr = ~d" (list (aref reginfo 0)) frame-ptr)))
    249250                         )
     251                        (6                   ;array rank
     252                         (%err-disp-internal $XNDIMS
     253                                             (list
     254                                              argb
     255                                              arga)
     256                                             frame-ptr))
     257                        (7              ;array flags
     258                         ;; This is currently only used to signal that
     259                         ;; a (purported) array header doesn't have the
     260                         ;; flags which denote a simple-array with
     261                         ;; a particular subtype.  Decode things, then
     262                         ;; signal a TYPE-ERROR.
     263                         (let* ((array (xp-gpr-lisp xp (ldb (byte 4 12) uuo)))
     264                                (flags (xp-gpr-lisp xp (ldb (byte 4 8) uuo)))
     265                                (subtag (ldb target::arrayH.flags-cell-subtag-byte flags))
     266                                (element-type
     267                                 (type-specifier
     268                                  (array-ctype-element-type
     269                                   (specifier-type (svref *arm-xtype-specifiers* subtag))))))
     270                           (%error (make-condition
     271                                    'type-error
     272                                    :datum array
     273                                    :expected-type `(simple-array ,element-type))
     274                                   nil
     275                                   frame-ptr)))                       
    250276                        (t
    251277                         (error "Unknown code in binary UUO: ~d" code)))))
  • branches/arm/level-1/arm-threads-utils.lisp

    r14006 r14017  
    1818
    1919(defun %frame-backlink (p &optional context)
     20  (declare (ignore context))
    2021  (cond ((fake-stack-frame-p p)
    2122         (%fixnum-ref p arm::fake-stack-frame.next-sp))
  • branches/arm/level-1/l1-lisp-threads.lisp

    r13962 r14017  
    680680  (%ptr-in-area-p idx (%fixnum-ref tcr target::tcr.vs-area)))
    681681
     682#-arm-target
    682683(defun %on-tsp-stack (tcr object)
    683684  (%ptr-in-area-p object (%fixnum-ref tcr target::tcr.ts-area)))
  • branches/arm/lib/arm-backtrace.lisp

    r13985 r14017  
    124124    (%%frame-savevsp p)))
    125125
     126;;; Lexprs ?
    126127(defun arg-check-call-arguments (frame function)
    127128  (declare (ignore function))
    128129  (xp-argument-list (%fixnum-ref frame arm::fake-stack-frame.xp)))
     130
     131;;; Should never be called.
     132(defun %find-register-argument-value (context csp regval bad)
     133  (declare (ignore context csp regval))
     134  bad)
     135
     136;;; Shouldn't be called.
     137(defun %set-register-argument-value (context csp regval new)
     138  (declare (ignore context csp regval))
     139  new)
     140
     141(defun %raw-frame-set (frame context idx new)
     142  (declare (fixnum frame idx))
     143  (let* ((base (parent-frame frame context))
     144         (raw-size (- base frame)))
     145    (declare (fixnum base raw-size))
     146    (if (and (>= idx 0)
     147             (< idx raw-size))
     148      (let* ((addr (- (the fixnum (1- base))
     149                      idx)))
     150        (multiple-value-bind (db-count first-db last-db)
     151            (count-db-links-in-frame frame base context)
     152          (let* ((is-db-link
     153                  (unless (zerop db-count)
     154                    (do* ((last last-db (previous-db-link last first-db)))
     155                         ((null last))
     156                      (when (= addr last)
     157                        (return t))))))
     158            (if is-db-link
     159              (setf (oldest-binding-frame-value context addr) new)
     160              (setf (%fixnum-ref addr) new))))))))
     161
     162(defun match-local-name (cellno info pc)
     163  (when info
     164    (let* ((syms (%car info))
     165           (ptrs (%cdr info)))
     166      (dotimes (i (length syms))
     167        (let ((j (%i+ i (%i+ i i ))))
     168          (and (eq (uvref ptrs j) (%ilogior (%ilsl (+ 6 target::word-shift) cellno) #o77))
     169               (%i>= pc (uvref ptrs (%i+ j 1)))
     170               (%i< pc (uvref ptrs (%i+ j 2)))
     171               (return (aref syms i))))))))
Note: See TracChangeset for help on using the changeset viewer.