Fix legacy screw-up on argument passed to GC_register_my_thread().

diff --git a/src/c/main.d b/src/c/main.d
index c1f5bde..8263552 100644 (file)
--- a/src/c/main.d
+++ b/src/c/main.d
@@ -872,6 +872,10 @@ long mkcl_exit_status(MKCL)
     return MKCL_THREAD_TERMINATED;
   else if (result_value == @':invalid-value')
     return MKCL_THREAD_INVALID_VALUE;
+  else if (result_value == @':imported')
+    return MKCL_THREAD_INVALID_VALUE;
+  else if (result_value == @':imported-and-gc-registered')
+    return MKCL_THREAD_INVALID_VALUE;
   else if (result_value == @':aborted')
     return MKCL_THREAD_ABORTED;
   else if (result_value == @':gc-abort')

diff --git a/src/c/print.d b/src/c/print.d
index cf6cc3b..173747f 100644 (file)
--- a/src/c/print.d
+++ b/src/c/print.d
@@ -1564,6 +1564,11 @@ mk_si_write_ugly_object(MKCL, mkcl_object x, mkcl_object stream)
        mkcl_write_char(env, ' ', stream);
        write_str(env, "imported", stream);
       }
+    else if (x->thread.result_value == @':imported-and-gc-registered')
+      {
+       mkcl_write_char(env, ' ', stream);
+       write_str(env, "imported-and-gc-registered", stream);
+      }
     mkcl_write_char(env, ' ', stream);
     mkcl_write_char(env, '(', stream);
     mk_si_write_object(env, MKCL_MAKE_FIXNUM(x->thread.tid), stream);

diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 6b47bda..5fe2f3e 100644 (file)
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -2072,14 +2072,11 @@ mkcl_symbol_initializer mkcl_root_symbols[] = {
   {{MKCL_EXT_ "OCTETS", MKCL_EXT_ORDINARY, mk_mkcl_octets, 1, MKCL_OBJNULL}},
   {{MKCL_EXT_ "DOUBLE-OCTETS", MKCL_EXT_ORDINARY, mk_mkcl_double_octets, 1, MKCL_OBJNULL}},
 
-#if 0
-  {{SYS_ "TRACE-CLOSURE-CREATION", SI_ORDINARY, mk_si_trace_closure_creation, 0, MKCL_OBJNULL}}, /* debug only */
-  {{SYS_ "UNTRACE-CLOSURE-CREATION", SI_ORDINARY, mk_si_untrace_closure_creation, 0, MKCL_OBJNULL}}, /* debug only */
-#endif
+  /* High water mark for MKCL 1.1.0 */
 
-#if 0
-  {{SYS_ "*ORIGINAL-ERROR-OUTPUT*", SI_SPECIAL, NULL, -1, MKCL_OBJNULL}},
-#endif
+  {{KEY_ "IMPORTED-AND-GC-REGISTERED", KEYWORD, NULL, -1, MKCL_OBJNULL}},
+
+  /* High water mark for MKCL 1.1.1 */
 
   /* Tag for end of list!
      This entry, with a first field of NULL value,

diff --git a/src/c/threads.d b/src/c/threads.d
index 1c435f3..666c818 100644 (file)
--- a/src/c/threads.d
+++ b/src/c/threads.d
@@ -130,7 +130,9 @@ thread_final_cleanup(MKCL, mkcl_object thread)
 
   mkcl_set_thread_env(NULL);
 
-  if (thread->thread.detached || thread->thread.result_value == @':imported')
+  if (thread->thread.detached
+      || thread->thread.result_value == @':imported'
+      || thread->thread.result_value == @':imported-and-gc-registered')
     {
       mkcl_remove_thread_from_global_thread_list(env, thread);
     }
@@ -1345,20 +1347,35 @@ mkcl_import_current_thread(mkcl_object name, mkcl_object bindings, mkcl_thread_i
     const mkcl_env env = (thread ? thread->thread.env : NULL);
 
     if (env)
+      { errno = ENOMEM; return NULL; }
+    else
       {
-       volatile bool locked = false;
-       
-       /* cannot be interrupted since we are not known yet by the rest of the Lisp world. */
-       MK_GC_register_my_thread((void *) &name);
+       struct MK_GC_stack_base sb;
 
-       thread->thread.thread = current;
-       thread->thread.base_thread = current;
+       if (MK_GC_SUCCESS != MK_GC_get_stack_base(&sb))
+         { errno = ENOSYS; return(NULL); }
 
-       /* imported threads are presumed not to be under lisp full (ultimate) control. */
-       thread->thread.result_value = @':imported';
-       
+       /* cannot be interrupted since we are not known yet by the rest of the Lisp world. */
+       switch (MK_GC_register_my_thread(&sb))
+         {
+         case MK_GC_SUCCESS:
+           thread->thread.thread = current;
+           thread->thread.base_thread = current;
+           /* imported threads are presumed not to be under lisp full (ultimate) control. */
+           thread->thread.result_value = @':imported-and-gc-registered';
+           return(env);
+         case MK_GC_DUPLICATE:
+           thread->thread.thread = current;
+           thread->thread.base_thread = current;
+           /* imported threads are presumed not to be under lisp full (ultimate) control. */
+           thread->thread.result_value = @':imported';
+           return(env);
+         default: /* This case should not be possible with Boehm GC 7.2 */
+           mkcl_release_current_thread(env);
+           errno = ENOSYS;
+           return NULL;
+         }
       }
-    return(env);
   }
 }
 
@@ -1366,12 +1383,15 @@ void
 mkcl_release_current_thread(MKCL)
 {
   mkcl_object thread = env->own_thread;
+  bool must_unregister = thread->thread.result_value == @':imported-and-gc-registered';
 
   thread_final_cleanup(env, thread);
 
   thread->thread.status = mkcl_thread_initialized;
   push_in_imported_thread_pool(env, thread);
-  MKCL_GC_NO_INTR(env, MK_GC_unregister_my_thread());
+  
+  if (must_unregister)
+    MKCL_GC_NO_INTR(env, MK_GC_unregister_my_thread());
 }
 
 
@@ -2875,10 +2895,13 @@ mkcl_object mk_mt_abandon_thread(MKCL, mkcl_object result_value)
 {
   mkcl_call_stack_check(env);
   mkcl_disable_interrupts(env);
-#if 0
-  if (env->own_thread->thread.result_value == MKCL_OBJNULL) /* Why this test??? In case of detached thread? */
-#endif
-    env->own_thread->thread.result_value = result_value;
+
+  {
+    mkcl_object current_result_value = env->own_thread->thread.result_value;
+      
+    if (!(current_result_value == @':imported-and-gc-registered' || current_result_value == @':imported'))
+      env->own_thread->thread.result_value = result_value;
+  }
 
   mkcl_unwind(env, NULL); /* With NULL there is no stack unwinding done. We jump directly to the root of the stack. */
 
@@ -2922,10 +2945,12 @@ mk_mt_exit_thread(MKCL, mkcl_object result_value)
 
   mkcl_call_stack_check(env);
   mkcl_disable_interrupts(env);
-#if 0
-  if (env->own_thread->thread.result_value == MKCL_OBJNULL)
-#endif
-    env->own_thread->thread.result_value = result_value;
+  {
+    mkcl_object current_result_value = env->own_thread->thread.result_value;
+      
+    if (!(current_result_value == @':imported-and-gc-registered' || current_result_value == @':imported'))
+      env->own_thread->thread.result_value = result_value;
+  }
 
   mkcl_unwind(env, env->frs_org);