attempted partial fix for github issue 352

- when thread_get_room exhausts the local allocation area, it now
  goes through a common path with S_get_more_room to allocate a new
  local allocation area when appropriate.  this can greatly reduce
  the use of global allocation (and the number of tc mutex acquires
  in threaded builds) when a lot of small objects are allocated by
  C code with no intervening Scheme-side allocation or dirty writes.
    alloc.c, types.h, externs.h

original commit: 93dfa7674a95837e5a22bc622fecc50b0224f60d

LOG

@@ -1009,3 +1009,10 @@
     c/*nt, wininstall/*nt.wxs
 - use uuid_generate on unix-like systems for S_unique_id
     BUILDING, c/Mf-*le, stats.c, objects.stex, release_notes.stex
+- when thread_get_room exhausts the local allocation area, it now
+  goes through a common path with S_get_more_room to allocate a new
+  local allocation area when appropriate.  this can greatly reduce
+  the use of global allocation (and the number of tc mutex acquires
+  in threaded builds) when a lot of small objects are allocated by
+  C code with no intervening Scheme-side allocation or dirty writes.
+    alloc.c, types.h, externs.h

c/alloc.c

@@ -150,14 +150,6 @@ ptr S_compute_bytes_allocated(xg, xs) ptr xg; ptr xs; {
   return Sunsigned(n);
 }
 
-ptr S_thread_get_more_room(t, n) iptr t; iptr n; {
-   ptr x;
-   tc_mutex_acquire()
-   find_room(space_new, 0, t, n, x);
-   tc_mutex_release()
-   return x;
-}
-
 static void maybe_fire_collector() {
   ISPC s;
   uptr bytes, fudge;
@@ -369,24 +361,29 @@ void S_scan_remembered_set() {
 
 void S_get_more_room() {
   ptr tc = get_thread_context();
-  ptr xp; uptr ap, eap, real_eap, type, size;
-
-  tc_mutex_acquire()
-
-  ap = (uptr)AP(tc);
-  eap = (uptr)EAP(tc);
-  real_eap = (uptr)REAL_EAP(tc);
+  ptr xp; uptr ap, type, size;
 
   xp = XP(tc);
   if ((type = TYPEBITS(xp)) == 0) type = typemod;
-  size = ap - (iptr)UNTYPE(xp,type);
-  ap -= size;
+  ap = (uptr)UNTYPE(xp, type);
+  size = (uptr)((iptr)AP(tc) - (iptr)ap);
+
+  XP(tc) = S_get_more_room_help(tc, ap, type, size);
+}
+
+ptr S_get_more_room_help(ptr tc, uptr ap, uptr type, uptr size) {
+  ptr x; uptr eap, real_eap;
+
+  eap = (uptr)EAP(tc);
+  real_eap = (uptr)REAL_EAP(tc);
+
+  tc_mutex_acquire()
 
   S_scan_dirty((ptr **)eap, (ptr **)real_eap);
   eap = real_eap;
 
   if (eap - ap >= size) {
-    XP(tc) = TYPE(ap, type);
+    x = TYPE(ap, type);
     ap += size;
     if (eap - ap > alloc_waste_maximum) {
       AP(tc) = (ptr)ap;
@@ -398,20 +395,22 @@ void S_get_more_room() {
   } else if (eap - ap > alloc_waste_maximum) {
     AP(tc) = (ptr)ap;
     EAP(tc) = (ptr)eap;
-    find_room(space_new, 0, type, size, XP(tc));
+    find_room(space_new, 0, type, size, x);
   } else {
     S_G.bytes_of_space[space_new][0] -= eap - ap;
     S_reset_allocation_pointer(tc);
     ap = (uptr)AP(tc);
     if (size + alloc_waste_maximum <= (uptr)EAP(tc) - ap) {
-      XP(tc) = TYPE(ap, type);
+      x = TYPE(ap, type);
       AP(tc) = (ptr)(ap + size);
     } else {
-      find_room(space_new, 0, type, size, XP(tc));
+      find_room(space_new, 0, type, size, x);
     }
   }
 
   tc_mutex_release()
+
+  return x;
 }
 
 /* S_cons_in is always called with mutex */

c/externs.h

@@ -59,6 +59,7 @@ extern void S_dirty_set PROTO((ptr *loc, ptr x));
 extern void S_scan_dirty PROTO((ptr **p, ptr **endp));
 extern void S_scan_remembered_set PROTO((void));
 extern void S_get_more_room PROTO((void));
+extern ptr S_get_more_room_help PROTO((ptr tc, uptr ap, uptr type, uptr size));
 extern ptr S_cons_in PROTO((ISPC s, IGEN g, ptr car, ptr cdr));
 extern ptr S_symbol PROTO((ptr name));
 extern ptr S_rational PROTO((ptr n, ptr d));
@@ -88,7 +89,6 @@ extern ptr S_string PROTO((const char *s, iptr n));
 extern ptr S_bignum PROTO((iptr n, IBOOL sign));
 extern ptr S_code PROTO((ptr tc, iptr type, iptr n));
 extern ptr S_relocation_table PROTO((iptr n));
-extern ptr S_thread_get_more_room PROTO((iptr t, iptr n));
 
 /* fasl.c */
 extern void S_fasl_init PROTO((void));

c/types.h

@@ -96,7 +96,7 @@ typedef int IFASLCODE;      /* fasl type codes */
   ptr _tc = tc;\
   uptr _ap = (uptr)AP(_tc);\
   if ((uptr)n > ((uptr)EAP(_tc) - _ap)) {\
-    (x) = S_thread_get_more_room(t, n);\
+    (x) = S_get_more_room_help(_tc, _ap, t, n);\
   } else {\
     (x) = TYPE(_ap,t);\
     AP(_tc) = (ptr)(_ap + n);\