#+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)