1.0.46.27: fix mach port leakage

 * store mach_thread_self() results in current_mach_thread and
   deallocate the mach_port after thread_set_exception_ports call

 * fix error messages in lose strings in mach_thread_init

 * catch_exception_raise now calls mach_port_deallocate for the
   exception_port, the thread and the task

 * These changes seem to get rid of most of the leaking port
   rights. However, MachPortDump shows when running the
   threads.impure.lisp tests, there are still a number of ports that
   stick around with a single send right.

diff --git a/src/runtime/darwin-os.c b/src/runtime/darwin-os.c
index f15e11b..2d79d06 100644 (file)
--- a/src/runtime/darwin-os.c
+++ b/src/runtime/darwin-os.c
@@ -104,10 +104,10 @@ kern_return_t
 mach_thread_init(mach_port_t thread_exception_port)
 {
     kern_return_t ret;
-    /* allocate a named port for the thread */
+    mach_port_t current_mach_thread;
 
+    /* allocate a named port for the thread */
     FSHOW((stderr, "Allocating mach port %x\n", thread_exception_port));
-
     ret = mach_port_allocate_name(current_mach_task,
                                   MACH_PORT_RIGHT_RECEIVE,
                                   thread_exception_port);
@@ -124,20 +124,26 @@ mach_thread_init(mach_port_t thread_exception_port)
         lose("mach_port_insert_right failed with return_code %d\n", ret);
     }
 
-    ret = thread_set_exception_ports(mach_thread_self(),
+    current_mach_thread = mach_thread_self();
+    ret = thread_set_exception_ports(current_mach_thread,
                                      EXC_MASK_BAD_ACCESS | EXC_MASK_BAD_INSTRUCTION,
                                      thread_exception_port,
                                      EXCEPTION_DEFAULT,
                                      THREAD_STATE_NONE);
     if (ret) {
-        lose("thread_set_exception_port failed with return_code %d\n", ret);
+        lose("thread_set_exception_ports failed with return_code %d\n", ret);
+    }
+
+    ret = mach_port_deallocate (current_mach_task, current_mach_thread);
+    if (ret) {
+        lose("mach_port_deallocate failed with return_code %d\n", ret);
     }
 
     ret = mach_port_move_member(current_mach_task,
                                 thread_exception_port,
                                 mach_exception_handler_port_set);
     if (ret) {
-        lose("mach_port_ failed with return_code %d\n", ret);
+        lose("mach_port_move_member failed with return_code %d\n", ret);
     }
 
     return ret;

diff --git a/src/runtime/x86-64-darwin-os.c b/src/runtime/x86-64-darwin-os.c
index 7b8ca68..7f24fb7 100644 (file)
--- a/src/runtime/x86-64-darwin-os.c
+++ b/src/runtime/x86-64-darwin-os.c
@@ -471,7 +471,8 @@ catch_exception_raise(mach_port_t exception_port,
 #ifdef LISP_FEATURE_SB_THREAD
         thread_mutex_unlock(&mach_exception_lock);
 #endif
-        return KERN_SUCCESS;
+        ret = KERN_SUCCESS;
+        break;
 
     case EXC_BAD_INSTRUCTION:
 
@@ -563,14 +564,21 @@ catch_exception_raise(mach_port_t exception_port,
 #ifdef LISP_FEATURE_SB_THREAD
         thread_mutex_unlock(&mach_exception_lock);
 #endif
-        return KERN_SUCCESS;
+        ret = KERN_SUCCESS;
+        break;
 
     default:
 #ifdef LISP_FEATURE_SB_THREAD
         thread_mutex_unlock(&mach_exception_lock);
 #endif
-        return KERN_INVALID_RIGHT;
+        ret = KERN_INVALID_RIGHT;
     }
+
+    mach_port_deallocate (current_mach_task, exception_port);
+    mach_port_deallocate (current_mach_task, thread);
+    mach_port_deallocate (current_mach_task, task);
+
+    return ret;
 }
 
 #endif

diff --git a/version.lisp-expr b/version.lisp-expr
index 2126bc0..8498d46 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -20,4 +20,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.46.26"
+"1.0.46.27"