From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 10 Jun 2008 18:33:06 +0000 (+0100)
Subject: weak: Kill race condition in ECL weak pointer implementation.
X-Git-Url: https://git.distorted.org.uk/~mdw/lisp/commitdiff_plain/6d23b6ba1cdc4a0667b4534936b76357d3d176e7

weak: Kill race condition in ECL weak pointer implementation.
---

diff --git a/weak.lisp b/weak.lisp
index ff7c9c3..b7325d7 100644
--- a/weak.lisp
+++ b/weak.lisp
@@ -39,18 +39,24 @@
 
 #+ecl
 (progn
+  (ffi:clines
+   "static GC_PTR fetch_obj(GC_PTR p) { return *(cl_object *)p; }")
   (defun make-weak-pointer (object)
-    (ffi:c-inline (object) (:object) :pointer-void
-      "{ cl_object *weak = GC_malloc_atomic(sizeof(cl_object));
-	 *weak = #0;
-	 GC_general_register_disappearing_link(weak, GC_base(#0));
-	 @(return) = weak; }"
+    (ffi:c-inline (object) (:object) :pointer-void "
+      {
+	cl_object *weak = GC_malloc_atomic(sizeof(cl_object));
+	*weak = #0;
+	GC_general_register_disappearing_link(weak, GC_base(#0));
+	@(return) = weak;
+      }"
       :one-liner nil))
   (defun weak-pointer-value (weak)
-    (ffi:c-inline (weak) (:pointer-void) (values :object :object)
-      "{ cl_object *weak = #0;
-	 if (*weak) { @(return 0) = *weak; @(return 1) = @t; }
-	 else { @(return 0) = @nil; @(return 1) = @nil; } }"
+    (ffi:c-inline (weak) (:pointer-void) (values :object :object) "
+      {
+	cl_object obj = GC_call_with_alloc_lock(fetch_obj, #0);
+	if (obj) { @(return 0) = obj; @(return 1) = @t; }
+	else { @(return 0) = @nil; @(return 1) = @nil; }
+      }"
       :one-liner nil)))
 
 #-(or sbcl cmu clisp allegro common-lispworks ecl)