Changeset 12837

Timestamp:

Sep 14, 2009, 11:47:46 AM (15 years ago)

Author:

R. Matthew Emerson

Message:

When unwatching an object, allocate space for it from lisp rather than
from the kernel. Change UNWATCH, %UNWATCH, and unwatch_object()
accordingly.

In unwatch_object(), just tenure everything after unwatching.

Location:

trunk/source

Files:

• level-0/X86/X8632/x8632-utils.lisp (modified) (1 diff)
• level-0/X86/x86-utils.lisp (modified) (1 diff)
• lib/misc.lisp (modified) (1 diff)
• lisp-kernel/x86-exceptions.c (modified) (3 diffs)

trunk/source/level-0/X86/X8632/x8632-utils.lisp

@@ -402 +402 @@
   (single-value-return))
 
-(defx8632lapfunction %unwatch ((watched arg_z))
-  (check-nargs 1)
+(defx8632lapfunction %unwatch ((watched arg_y) (new arg_z))
+  (check-nargs 2)
   (movl ($ arch::watch-trap-function-unwatch) (%l imm0))
   (uuo-watch-trap)
-  (movl ($ nil) (%l arg_z))
   (single-value-return))
 

trunk/source/level-0/X86/x86-utils.lisp

@@ -455 +455 @@
   (single-value-return))
 
-(defx86lapfunction %unwatch ((watched arg_z))
-  (check-nargs 1)
+(defx86lapfunction %unwatch ((watched arg_y) (new arg_z))
+  (check-nargs 2)
   (movl ($ arch::watch-trap-function-unwatch) (%l imm0))
   (uuo-watch-trap)
-  (movl ($ nil) (%l arg_z))
   (single-value-return))
 

trunk/source/lib/misc.lisp

@@ -1060 +1060 @@
                     ;; list while %map-areas iterates over it, but I
                     ;; think we'll get away with it.
-                    (%unwatch thing)
-                    (return-from unwatch)))
+                    (let ((new (%alloc-misc (uvsize thing) (typecode thing))))
+                      (return-from unwatch (%unwatch thing new)))))
               area-watched area-watched))
       

trunk/source/lisp-kernel/x86-exceptions.c

@@ -3707 +3707 @@
 watch_object(TCR *tcr, signed_natural param)
 {
-  TCR *other_tcr;
   LispObj uvector = (LispObj)param;
   LispObj *noderef = (LispObj *)untag(uvector);
@@ -3730 +3729 @@
 }
 
+/*
+ * We expect the watched object in arg_y, and the new uninitialized
+ * object (which is just zeroed) in arg_z.
+ */
 signed_natural
 unwatch_object(TCR *tcr, signed_natural param)
 {
-  TCR *other_tcr;
-  LispObj uvector = (LispObj)param;
-  LispObj *noderef = (LispObj *)untag(uvector);
-  LispObj old = uvector;
-  LispObj new;
-  natural size = uvector_total_size_in_bytes(noderef);
-  area *a = area_containing((BytePtr)noderef);
   ExceptionInformation *xp = tcr->xframe->curr;
+  LispObj old = xpGPR(xp, Iarg_y);
+  LispObj new = xpGPR(xp, Iarg_z);
+  LispObj *oldnode = (LispObj *)untag(old);
+  LispObj *newnode = (LispObj *)untag(new);
+  area *a = area_containing((BytePtr)old);
 
   if (a && a->code == AREA_WATCHED) {
-    update_bytes_allocated(tcr, (void *)tcr->save_allocptr);
-    if (allocate_object(xp, size, size - fulltag_misc, tcr)) {
-      new = (LispObj)tcr->save_allocptr;
-      tcr->save_allocptr -= fulltag_misc;
-    } else {
-      lisp_allocation_failure(xp, tcr, size);
-    }
-
-    memcpy(tcr->save_allocptr, noderef, size);
+    natural size = uvector_total_size_in_bytes(oldnode);
+
+    memcpy(newnode, oldnode, size);
     delete_watched_area(a, tcr);
     wp_update_references(tcr, old, new);
+    /* because wp_update_references doesn't update refbits */
+    tenure_to_area(tenured_area);
     check_all_areas(tcr);
+    xpGPR(xp, Iarg_z) = new;
   }
   return 0;
@@ -3770 +3768 @@
       break;
     case WATCH_TRAP_FUNCTION_UNWATCH:
-      gc_like_from_xp(xp, unwatch_object, uvector);
+      gc_like_from_xp(xp, unwatch_object, 0);
       break;
     default: