Changeset 12885


Ignore:
Timestamp:
Sep 27, 2009, 3:39:26 AM (10 years ago)
Author:
rme
Message:

Support watching individual cons cells.

Location:
branches/watchpoints
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/watchpoints/level-0/X86/x86-utils.lisp

    r12837 r12885  
    445445  (jmp-subprim .SPmakeu64))
    446446
    447 (defx86lapfunction %watch ((uvector arg_z))
     447(defx86lapfunction %watch ((thing arg_z))
    448448  (check-nargs 1)
    449   ;; This traps on symbols and functions, which have their own tags.
    450   ;; This may be undesirable.
    451   (trap-unless-lisptag= uvector x8664::tag-misc imm0)
    452449  (movl ($ arch::watch-trap-function-watch) (%l imm0))
    453450  (uuo-watch-trap)
  • branches/watchpoints/level-1/x86-trap-support.lisp

    r12881 r12885  
    441441                                         :object object)
    442442                                        nil frame-ptr)
    443                   (unwatch ()
    444                     :report (lambda (s)
    445                               (format s "Unwatch ~s and perform the write." object))
    446                     (unwatch (%int-to-object other)))))))))
     443                    (unwatch ()
     444                      :report (lambda (s)
     445                                (format s "Unwatch ~s and perform the write." object))
     446                      (unwatch object))))))))
    447447          ((= signal #+win32-target 10 #-win32-target #$SIGBUS)
    448448           (if (= code -1)
     
    456456                     frame-ptr)))))
    457457  0)
    458 
    459 #||
    460 (defun analyze-faulting-instruction (xp)
    461   (let* ((ds (make-x86-disassembly-state
    462               :mode-64 #+x8664-target t #+x8632-target nil))
    463          (insn (make-x86-disassembled-instruction
    464                 :address (indexed-gpr-integer xp rip-register-offset)
    465 ||#
  • branches/watchpoints/lib/misc.lisp

    r12838 r12885  
    10461046(defun watch (&optional thing)
    10471047  (if thing
    1048     ;; typecheck thing?
    1049     (%watch thing)
     1048    (progn
     1049      (require-type thing '(or cons (satisfies uvectorp)))
     1050      (%watch thing))
    10501051    (let (result)
    10511052      (%map-areas #'(lambda (x) (push x result)) area-watched area-watched)
     
    10591060                    ;; list while %map-areas iterates over it, but I
    10601061                    ;; think we'll get away with it.
    1061                     (let ((new (%alloc-misc (uvsize thing) (typecode thing))))
     1062                    (let ((new (if (uvectorp thing)
     1063                                 (%alloc-misc (uvsize thing) (typecode thing))
     1064                                 (cons nil nil))))
    10621065                      (return-from unwatch (%unwatch thing new)))))
    10631066              area-watched area-watched))
  • branches/watchpoints/lisp-kernel/x86-exceptions.c

    r12880 r12885  
    827827      if (a && a->code == AREA_WATCHED && addr < a->high) {
    828828        /* caught a write to a watched object */
     829        LispObj *p = (LispObj *)a->low;
     830        LispObj node = *p;
     831        unsigned tag_n = fulltag_of(node);
    829832        LispObj cmain = nrs_CMAIN.vcell;
    830         LispObj obj = (LispObj)a->low + fulltag_misc; /* always uvectors */
     833        LispObj obj;
     834
     835        if (immheader_tag_p(tag_n) || nodeheader_tag_p(tag_n))
     836          obj = (LispObj)p + fulltag_misc;
     837        else
     838          obj = (LispObj)p + fulltag_cons;
    831839
    832840        if ((fulltag_of(cmain) == fulltag_misc) &&
     
    37063714 * Other threads are suspended and pc-lusered.
    37073715 *
    3708  * param contains a tagged pointer to a uvector.
     3716 * param contains a tagged pointer to a uvector or a cons cell
    37093717 */
    37103718signed_natural
    37113719watch_object(TCR *tcr, signed_natural param)
    37123720{
    3713   LispObj uvector = (LispObj)param;
    3714   LispObj *noderef = (LispObj *)untag(uvector);
    3715   natural size = uvector_total_size_in_bytes(noderef);
    3716   area *uvector_area = area_containing((BytePtr)noderef);
    3717 
    3718   if (uvector_area && uvector_area->code != AREA_WATCHED) {
     3721  LispObj object = (LispObj)param;
     3722  unsigned tag = fulltag_of(object);
     3723  LispObj *noderef = (LispObj *)untag(object);
     3724  area *object_area = area_containing((BytePtr)noderef);
     3725  natural size;
     3726
     3727  if (tag == fulltag_cons)
     3728    size = 2 * node_size;
     3729  else
     3730    size = uvector_total_size_in_bytes(noderef);
     3731
     3732  if (object_area && object_area->code != AREA_WATCHED) {
    37193733    area *a = new_watched_area(size);
    3720     LispObj old = uvector;
    3721     LispObj new = (LispObj)((natural)a->low + fulltag_misc);
     3734    LispObj old = object;
     3735    LispObj new = (LispObj)((natural)a->low + tag);
    37223736
    37233737    add_area_holding_area_lock(a);
     
    37423756  ExceptionInformation *xp = tcr->xframe->curr;
    37433757  LispObj old = xpGPR(xp, Iarg_y);
     3758  unsigned tag = fulltag_of(old);
    37443759  LispObj new = xpGPR(xp, Iarg_z);
    37453760  LispObj *oldnode = (LispObj *)untag(old);
     
    37483763
    37493764  if (a && a->code == AREA_WATCHED) {
    3750     natural size = uvector_total_size_in_bytes(oldnode);
     3765    natural size;
     3766
     3767    if (tag == fulltag_cons)
     3768      size = 2 * node_size;
     3769    else
     3770      size = uvector_total_size_in_bytes(oldnode);
    37513771
    37523772    memcpy(newnode, oldnode, size);
     
    37653785{
    37663786  LispObj selector = xpGPR(xp,Iimm0);
    3767   LispObj uvector = xpGPR(xp, Iarg_z);
     3787  LispObj object = xpGPR(xp, Iarg_z);
    37683788 
    37693789  switch (selector) {
    37703790    case WATCH_TRAP_FUNCTION_WATCH:
    3771       gc_like_from_xp(xp, watch_object, uvector);
     3791      gc_like_from_xp(xp, watch_object, object);
    37723792      break;
    37733793    case WATCH_TRAP_FUNCTION_UNWATCH:
Note: See TracChangeset for help on using the changeset viewer.