Changeset 12888


Ignore:
Timestamp:
Sep 28, 2009, 2:31:03 PM (10 years ago)
Author:
rme
Message:

Support watching individual cons cells; add "unwatch and contiune" restart.
(r12874 through r12887 from watchpoints branch)

Location:
trunk/source
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-0/X86/x86-utils.lisp

    r12837 r12888  
    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)
  • trunk/source/level-1/x86-trap-support.lisp

    r12817 r12888  
    435435                         (setf (%get-ptr a) (%int-to-ptr i))
    436436                         (%get-object a 0))))
    437                 (%error (make-condition
    438                          'write-to-watched-object
    439                          :address addr
    440                          :object (%int-to-object other))
    441                         nil frame-ptr)))))
     437                (let ((object (%int-to-object other)))
     438                  (restart-case (%error (make-condition
     439                                         'write-to-watched-object
     440                                         :address addr
     441                                         :object object)
     442                                        nil frame-ptr)
     443                    (unwatch ()
     444                      :report (lambda (s)
     445                                (format s "Unwatch ~s and perform the write." object))
     446                      (unwatch object))))))))
    442447          ((= signal #+win32-target 10 #-win32-target #$SIGBUS)
    443448           (if (= code -1)
     
    451456                     frame-ptr)))))
    452457  0)
    453 
  • trunk/source/lib/misc.lisp

    r12838 r12888  
    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))
  • trunk/source/lisp-kernel/x86-exceptions.c

    r12837 r12888  
    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) &&
    833841            (header_subtag(header_of(cmain)) == subtag_macptr)) {
     842          LispObj save_vsp = xpGPR(xp, Isp);
     843          LispObj save_fp = xpGPR(xp, Ifp);
    834844          LispObj xcf = create_exception_callback_frame(xp, tcr);
    835845          int skip;
     
    838848          skip = callback_to_lisp(tcr, cmain, xp, xcf, SIGSEGV, 2, (natural) addr, obj);
    839849          xpPC(xp) += skip;
     850          xpGPR(xp, Ifp) = save_fp;
     851          xpGPR(xp, Isp) = save_vsp;
    840852          return true;
    841853        }
     
    37023714 * Other threads are suspended and pc-lusered.
    37033715 *
    3704  * param contains a tagged pointer to a uvector.
     3716 * param contains a tagged pointer to a uvector or a cons cell
    37053717 */
    37063718signed_natural
    37073719watch_object(TCR *tcr, signed_natural param)
    37083720{
    3709   LispObj uvector = (LispObj)param;
    3710   LispObj *noderef = (LispObj *)untag(uvector);
    3711   natural size = uvector_total_size_in_bytes(noderef);
    3712   area *uvector_area = area_containing((BytePtr)noderef);
    3713 
    3714   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) {
    37153733    area *a = new_watched_area(size);
    3716     LispObj old = uvector;
    3717     LispObj new = (LispObj)((natural)a->low + fulltag_misc);
     3734    LispObj old = object;
     3735    LispObj new = (LispObj)((natural)a->low + tag);
    37183736
    37193737    add_area_holding_area_lock(a);
     
    37383756  ExceptionInformation *xp = tcr->xframe->curr;
    37393757  LispObj old = xpGPR(xp, Iarg_y);
     3758  unsigned tag = fulltag_of(old);
    37403759  LispObj new = xpGPR(xp, Iarg_z);
    37413760  LispObj *oldnode = (LispObj *)untag(old);
     
    37443763
    37453764  if (a && a->code == AREA_WATCHED) {
    3746     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);
    37473771
    37483772    memcpy(newnode, oldnode, size);
     
    37613785{
    37623786  LispObj selector = xpGPR(xp,Iimm0);
    3763   LispObj uvector = xpGPR(xp, Iarg_z);
     3787  LispObj object = xpGPR(xp, Iarg_z);
    37643788 
    37653789  switch (selector) {
    37663790    case WATCH_TRAP_FUNCTION_WATCH:
    3767       gc_like_from_xp(xp, watch_object, uvector);
     3791      gc_like_from_xp(xp, watch_object, object);
    37683792      break;
    37693793    case WATCH_TRAP_FUNCTION_UNWATCH:
Note: See TracChangeset for help on using the changeset viewer.