Changeset 13043


Ignore:
Timestamp:
Oct 19, 2009, 3:47:26 PM (10 years ago)
Author:
gz
Message:

More WATCH updates from trunk (r13011-r13019, r13022, r13028)

Location:
branches/working-0711/ccl
Files:
7 edited
1 copied

Legend:

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

    r13009 r13043  
    3636(defmethod print-object ((xdi x86-disassembled-instruction) stream)
    3737  (print-unreadable-object (xdi stream :type t :identity t)
    38     (format stream "~a" (x86-di-mnemonic xdi))))
     38    (dolist (p (x86-di-prefixes xdi))
     39      (format stream "(~a) " p))
     40    (format stream "(~a" (x86-di-mnemonic xdi))
     41    (let* ((op0 (x86-di-op0 xdi))
     42           (op1 (x86-di-op1 xdi))
     43           (op2 (x86-di-op2 xdi))
     44           (ds (make-x86-disassembly-state :mode-64 #+x8664-target t
     45                                                    #+x8632-target nil
     46                                           :code-vector nil
     47                                           :code-pointer 0)))
     48      (when op0
     49        (write-x86-lap-operand stream op0 ds)
     50        (when op1
     51          (write-x86-lap-operand stream op1 ds)
     52          (when op2
     53            (write-x86-lap-operand stream op2 ds)))))
     54    (format stream ")")))
    3955
    4056(defstruct (x86-disassembly-state (:conc-name x86-ds-))
     
    27582774      (out stream expr))))
    27592775
    2760 (defun x86-print-bare-disassembled-instruction (ds instruction)
    2761   (dolist (p (x86-di-prefixes instruction))
    2762     (format t "~&  (~a)~%" p))
    2763   (format t "  (~a" (x86-di-mnemonic instruction))
    2764   (let* ((op0 (x86-di-op0 instruction))
    2765          (op1 (x86-di-op1 instruction))
    2766          (op2 (x86-di-op2 instruction)))
    2767     (when op0
    2768       (write-x86-lap-operand t op0 ds)
    2769       (when op1
    2770         (write-x86-lap-operand t op1 ds)
    2771         (when op2
    2772           (write-x86-lap-operand t op2 ds)))))
    2773   (format t ")"))
    2774 
    27752776(defvar *previous-source-note*)
    27762777
     
    27922793      (setq seq 0))
    27932794    (format t "~&  [~D]~8T" pc)
    2794     (x86-print-bare-disassembled-instruction ds instruction)
     2795    (dolist (p (x86-di-prefixes instruction))
     2796      (format t "~&  (~a)~%" p))
     2797    (format t "  (~a" (x86-di-mnemonic instruction))
     2798    (let* ((op0 (x86-di-op0 instruction))
     2799           (op1 (x86-di-op1 instruction))
     2800           (op2 (x86-di-op2 instruction)))
     2801      (when op0
     2802        (write-x86-lap-operand t op0 ds)
     2803        (when op1
     2804          (write-x86-lap-operand t op1 ds)
     2805          (when op2
     2806            (write-x86-lap-operand t op2 ds)))))
     2807    (format t ")")
    27952808    (format t "~%")
    27962809    (1+ seq)))
  • branches/working-0711/ccl/level-1/l1-error-system.lisp

    r13009 r13043  
    109109   (offset :initarg :offset
    110110           :reader write-to-watched-object-offset)
    111    (instruction :initarg :instruction))
     111   (instruction :initarg :instruction
     112                :reader write-to-watched-object-instruction))
    112113  (:report report-write-to-watched-object))
    113114
     
    140141               object offset)))
    141142    (when instruction
    142       (let* ((ds (make-x86-disassembly-state :mode-64 #+x8664-target t
    143                                                       #+x8632-target nil
    144                                              :code-vector nil
    145                                              :code-pointer 0))
    146              (str (with-output-to-string (*standard-output*)
    147                     (x86-print-bare-disassembled-instruction ds instruction))))
    148         (format s "~&Faulting instruction: ~a" (string-trim " " str))))))
     143      (format s "~&Faulting instruction: ~s" instruction))))
    149144
    150145(define-condition type-error (error)
  • branches/working-0711/ccl/level-1/x86-trap-support.lisp

    r13009 r13043  
    445445                                         :instruction insn)
    446446                                        nil frame-ptr)
     447                    #-windows-target
     448                    (emulate ()
     449                      :test (lambda (c)
     450                              (declare (ignore c))
     451                              (x86-can-emulate-instruction insn))
     452                      :report
     453                      "Emulate this instruction, leaving the object watched."
     454                      (flet ((watchedp (object)
     455                               (%map-areas #'(lambda (x)
     456                                               (when (eq object x)
     457                                                 (return-from watchedp t)))
     458                                           area-watched area-watched)))
     459                        (let ((result nil))
     460                          (with-other-threads-suspended
     461                            (when (watchedp object)
     462                              ;; We now trust that the object is in a
     463                              ;; static gc area.
     464                              (let* ((a (+ (%address-of object) offset))
     465                                     (ptr (%int-to-ptr
     466                                           (logandc2 a (1- *host-page-size*)))))
     467                                (#_mprotect ptr *host-page-size* #$PROT_WRITE)
     468                                (setq result (x86-emulate-instruction xp insn))
     469                                (#_mprotect ptr *host-page-size*
     470                                            (logior #$PROT_READ #$PROT_EXEC)))))
     471                          (if result
     472                            (setq skip insn-length)
     473                            (error "could not emulate the instrution")))))
    447474                    (skip ()
    448475                      :test (lambda (c)
  • branches/working-0711/ccl/lib/compile-ccl.lisp

    r12948 r13043  
    175175          (case target
    176176            ((:ppc32 :ppc64) '(ppc-backtrace ppc-disassemble))
    177             ((:x8632 :x8664) '(x86-backtrace x86-disassemble)))))
     177            ((:x8632 :x8664) '(x86-backtrace x86-disassemble x86-watch)))))
    178178         
    179179
  • branches/working-0711/ccl/lib/misc.lisp

    r13009 r13043  
    10571057      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched))
    10581058    result))
    1059    
     1059
     1060(defun primitive-watch (thing)
     1061  (require-type thing '(or cons (satisfies uvectorp)))
     1062  (%watch thing))
     1063
    10601064(defun watch (&optional thing)
    1061   (if thing
    1062     (progn
    1063       (require-type thing '(or cons (satisfies uvectorp)))
    1064       (%watch thing))
    1065     (all-watched-objects)))
     1065  (cond ((null thing)
     1066         (all-watched-objects))
     1067        ((arrayp thing)
     1068         (primitive-watch (array-data-and-offset thing)))
     1069        ((hash-table-p thing)
     1070         (primitive-watch (nhash.vector thing)))
     1071        ((standard-instance-p thing)
     1072         (primitive-watch (instance-slots thing)))
     1073        (t
     1074         (primitive-watch thing))))
    10661075
    10671076(defun unwatch (thing)
     
    10751084                        (return-from unwatch (%unwatch thing new)))))
    10761085                area-watched area-watched)))
    1077      
  • branches/working-0711/ccl/lib/systems.lisp

    r12410 r13043  
    161161    (ppc-backtrace    "ccl:bin;ppc-backtrace"    ("ccl:lib;ppc-backtrace.lisp"))
    162162    (x86-backtrace    "ccl:bin;x86-backtrace"    ("ccl:lib;x86-backtrace.lisp"))
     163    (x86-watch        "ccl:bin;x86-watch"        ("ccl:lib;x86-watch.lisp"))
    163164    (backtrace-lds    "ccl:bin;backtrace-lds"    ("ccl:lib;backtrace-lds.lisp"))
    164165    (apropos          "ccl:bin;apropos"          ("ccl:lib;apropos.lisp"))
  • branches/working-0711/ccl/lisp-kernel/x86-exceptions.c

    r13009 r13043  
    37353735    size = uvector_total_size_in_bytes(noderef);
    37363736
    3737   if (object_area && object_area->code != AREA_WATCHED) {
     3737  if (object_area && object_area->code == AREA_DYNAMIC) {
    37383738    area *a = new_watched_area(size);
    37393739    LispObj old = object;
     
    37483748    wp_update_references(tcr, old, new);
    37493749    check_all_areas(tcr);
     3750    return 1;
    37503751  }
    37513752  return 0;
     
    37913792  LispObj selector = xpGPR(xp,Iimm0);
    37923793  LispObj object = xpGPR(xp, Iarg_z);
     3794  signed_natural result;
    37933795 
    37943796  switch (selector) {
    37953797    case WATCH_TRAP_FUNCTION_WATCH:
    3796       gc_like_from_xp(xp, watch_object, object);
     3798      result = gc_like_from_xp(xp, watch_object, object);
     3799      if (result == 0)
     3800        xpGPR(xp,Iarg_z) = lisp_nil;
    37973801      break;
    37983802    case WATCH_TRAP_FUNCTION_UNWATCH:
Note: See TracChangeset for help on using the changeset viewer.