Changeset 6049 for branches

Timestamp:

Mar 16, 2007, 11:42:33 PM (18 years ago)

Author:

Gary Byers

Message:

FREE: be careful about gcable pointers.

File:

• branches/objc-gf/ccl/level-0/l0-io.lisp (modified) (1 diff)

branches/objc-gf/ccl/level-0/l0-io.lisp

@@ -110 +110 @@
 
 (defun free (ptr)
-  (ff-call 
-   (%kernel-import target::kernel-import-free)
-   :address ptr :void))
+  (let* ((size (uvsize ptr))
+         (flags (if (= size target::xmacptr.size)
+                  (uvref ptr target::xmacptr.flags-cell)
+                  $flags_DisposPtr)))
+    (declare (fixnum size flags))
+    (if (= flags $flags_DisposPtr)
+      (with-macptrs ((addr ptr))
+        (when (= size target::xmacptr.size)
+          (%setf-macptr ptr (%null-ptr))
+          (setf (uvref ptr target::xmacptr.flags-cell) $flags_Normal))
+        (ff-call 
+         (%kernel-import target::kernel-import-free)
+         :address addr :void)))))
 
 
-;;; Yield the CPU, via a platform-specific syscall.