Index: /trunk/source/lisp-kernel/memory.c
===================================================================
--- /trunk/source/lisp-kernel/memory.c	(revision 15436)
+++ /trunk/source/lisp-kernel/memory.c	(revision 15437)
@@ -32,4 +32,7 @@
 #include <strings.h>
 #endif
+#ifdef DARWIN64
+#include <pthread.h>
+#endif
 
 #ifndef WINDOWS
@@ -972,2 +975,123 @@
 }
 
+#ifdef DARWIN64
+/*
+  On 64-bit Darwin, we try to make a TCR's address serve as a Mach port
+  name, which means that it has to fit in 32 bits (and not conflict with
+  an existing port name, but that's a separate issue.)  Darwin doesn't
+  seem to offer means of mapping/allocating memory that's guaranteed to
+  return a 32-bit address on 64-bit systems, and trial-and-error doesn't
+  scale well.
+  
+  Since it's a PITA to allocate 32-bit TCR pointers, we never free them
+  once we've done so.  (We maintain a queue of "freed" TCRs but never
+  unmap the memory.)  When we need to allocate TCR pointers, we try to
+  allocate substantially more than we need.
+
+  The bulk allocation works by scanning the task's mapped memory regions
+  until a free region of appropriate size is found, then mapping that
+  region.  There is no way that I know of to prevent a foreign thread
+  from trying to map this region while we're doing so.
+*/
+
+pthread_mutex_t darwin_tcr_lock = PTHREAD_MUTEX_INITIALIZER;
+
+TCR _free_tcr_queue, *darwin_tcr_freelist=&_free_tcr_queue;
+
+#define TCR_CLUSTER_COUNT 1024   /* Enough that we allocate clusters rarely,
+but not so much that we waste lots of 32-bit memory. */
+
+void
+map_tcr_cluster(TCR *head)
+{
+  TCR *work = NULL, *prev = head;
+  int i;
+  vm_address_t addr = (vm_address_t)0, nextaddr;
+
+  vm_size_t request_size = align_to_power_of_2((TCR_CLUSTER_COUNT*sizeof(TCR)),log2_page_size), vm_size;
+  vm_region_basic_info_data_64_t vm_info;
+  mach_msg_type_number_t vm_info_size = VM_REGION_BASIC_INFO_COUNT_64;
+  mach_port_t vm_object_name = (mach_port_t) 0;
+  kern_return_t kret;
+
+  while (1) {
+    nextaddr = addr;
+    vm_info_size = VM_REGION_BASIC_INFO_COUNT_64;
+    kret = vm_region_64(mach_task_self(),
+                        &nextaddr,
+                        &vm_size,
+                        VM_REGION_BASIC_INFO_64,
+                        (vm_region_info_t)&vm_info,
+                        &vm_info_size,
+                        &vm_object_name);
+    if (kret != KERN_SUCCESS) {
+      break;
+    }
+    if (addr && ((nextaddr - addr) > request_size)) {
+      if ((addr + request_size) > (1L << 32L)) {
+        break;
+      }
+      if (mmap((void *)addr,
+               request_size,
+               PROT_READ|PROT_WRITE,
+               MAP_PRIVATE|MAP_ANON|MAP_FIXED,
+               -1,
+               0) != (void *)addr) {
+        break;
+      }
+      work = (TCR *)addr;
+      break;
+    }
+    addr = nextaddr + vm_size;    
+  }
+  if (!work) {
+    Fatal("Can't allocate memory for thread-local storage.", "");
+  }
+  
+  for (i=0; i < TCR_CLUSTER_COUNT; i++, work++) {
+    prev->next = work;
+    work->prev = prev;
+    head->prev = work;
+    work->next = head;
+    prev = work;
+  }
+}
+
+void
+darwin_free_tcr(TCR *tcr)
+{
+  TCR  *head = darwin_tcr_freelist, *tail;
+
+  pthread_mutex_lock(&darwin_tcr_lock);
+  tail = head->prev;
+  tail->next = tcr;
+  head->prev = tcr;
+  tcr->prev = tail;
+  tcr->next = head;
+  pthread_mutex_unlock(&darwin_tcr_lock);
+}
+
+TCR *
+darwin_allocate_tcr()
+{
+  TCR  *head = darwin_tcr_freelist, *tail, *tcr;
+  pthread_mutex_lock(&darwin_tcr_lock);
+  if (head->next == NULL) { /* First time */
+    head->next = head->prev = head;
+  }
+
+  if (head->next == head) {
+    map_tcr_cluster(head);
+  }
+  tcr = head->next;
+  tail = tcr->next;
+  tail->prev = head;
+  head->next = tail;
+  pthread_mutex_unlock(&darwin_tcr_lock);
+  return tcr;
+}
+  
+
+
+
+#endif
Index: /trunk/source/lisp-kernel/platform-darwinx8664.h
===================================================================
--- /trunk/source/lisp-kernel/platform-darwinx8664.h	(revision 15436)
+++ /trunk/source/lisp-kernel/platform-darwinx8664.h	(revision 15437)
@@ -90,2 +90,4 @@
 
 #include "os-darwin.h"
+
+#define DARWIN64 1
Index: /trunk/source/lisp-kernel/thread_manager.c
===================================================================
--- /trunk/source/lisp-kernel/thread_manager.c	(revision 15436)
+++ /trunk/source/lisp-kernel/thread_manager.c	(revision 15437)
@@ -829,4 +829,8 @@
 #ifdef DARWIN
   extern Boolean use_mach_exception_handling;
+#ifdef DARWIN64
+  extern TCR* darwin_allocate_tcr(void);
+  extern void darwin_free_tcr(TCR *);
+#endif
   kern_return_t kret;
   mach_port_t 
@@ -835,13 +839,6 @@
 #endif
   for (;;) {
-    tcr = calloc(1, sizeof(TCR));
-#ifdef DARWIN
-#if WORD_SIZE == 64
-    if (((unsigned)((natural)tcr)) != ((natural)tcr)) {
-      tcr->next = chain;
-      chain = tcr;
-      continue;
-    }
-#endif
+#ifdef DARWIN64
+    tcr = darwin_allocate_tcr();
     if (use_mach_exception_handling) {
       thread_exception_port = (mach_port_t)((natural)tcr);
@@ -858,8 +855,14 @@
       continue;
     }
+#else
+    tcr = calloc(1, sizeof(TCR));
 #endif
     for (;chain;chain = next) {
       next = chain->next;
+#ifdef DARWIN64
+      darwin_free_tcr(chain);
+#else
       free(chain);
+#endif
     }
     return tcr;
@@ -1358,4 +1361,7 @@
 shutdown_thread_tcr(void *arg)
 {
+#ifdef DARWIN64
+  extern void darwin_free_tcr(TCR *);
+#endif
   TCR *tcr = TCR_FROM_TSD(arg),*current=get_tcr(0);
 
@@ -1433,5 +1439,5 @@
     tcr->interrupt_pending = 0;
     TCR_AUX(tcr)->termination_semaphore = NULL;
-#if defined(HAVE_TLS) || defined(WIN_32)
+#if defined(HAVE_TLS) || defined(WIN_32) || defined(DARWIN64)
     dequeue_tcr(tcr);
 #endif
@@ -1448,4 +1454,7 @@
     tcr->aux = NULL;
 #endif
+#endif
+#ifdef DARWIN64
+    darwin_free_tcr(tcr);
 #endif
     UNLOCK(lisp_global(TCR_AREA_LOCK),current);
@@ -2306,4 +2315,7 @@
 free_freed_tcrs ()
 {
+#ifdef DARWIN64
+  extern void darwin_free_tcr(TCR *);
+#endif
   TCR *current, *next;
 
@@ -2315,5 +2327,9 @@
      * tcr aux vector elsewhere. */
 #else
+#ifdef DARWIN64
+    darwin_free_tcr(current);
+#else
     free(current);
+#endif
 #endif
 #endif