win32: reduce allocation in the scheduler

It's not clear that the changes affect anything in practice,
but they avoid unnecessary allocation and quadratic behavior
in principle.

racket/src/foreign/foreign.c

@@ -3248,7 +3248,11 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
   void *sh;
   int ready;
 
-  todo = (FFI_Orig_Place_Call *)malloc(sizeof(FFI_Orig_Place_Call));
+  if (cached_orig_place_todo) {
+    todo = cached_orig_place_todo;
+    cached_orig_place_todo = NULL;
+  } else
+    todo = (FFI_Orig_Place_Call *)malloc(sizeof(FFI_Orig_Place_Call));
   sh = scheme_get_signal_handle();
   todo->signal_handle = sh;
   todo->needs_queue = 1;
@@ -3299,7 +3303,10 @@ static void ffi_call_in_orig_place(ffi_cif *cif, void *c_func, intptr_t cfoff,
     if (!todo->signal_handle) {
       /* Done */
       mzrt_mutex_unlock(orig_place_mutex);
-      free(todo);
+      if (!cached_orig_place_todo)
+	cached_orig_place_todo = todo;
+      else
+	free(todo);
       break;
     } else {
       /* Pause to allow actions such as a master GC.... */

racket/src/racket/include/schthread.h

@@ -359,6 +359,7 @@ typedef struct Thread_Local_Variables {
   int atomic_timeout_atomic_level_;
   void *scheme_inotify_server_;
   struct Scheme_Object *configuration_callback_cache_[2];
+  struct FFI_Orig_Place_Call *cached_orig_place_todo_;
 } Thread_Local_Variables;
 
 #if defined(IMPLEMENT_THREAD_LOCAL_VIA_PTHREADS)
@@ -743,7 +744,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_THREAD_LOCAL;
 #define atomic_timeout_atomic_level XOA (scheme_get_thread_local_variables()->atomic_timeout_atomic_level_)
 #define scheme_inotify_server XOA (scheme_get_thread_local_variables()->scheme_inotify_server_)
 #define configuration_callback_cache XOA (scheme_get_thread_local_variables()->configuration_callback_cache_)
-
+#define cached_orig_place_todo XOA (scheme_get_thread_local_variables()->cached_orig_place_todo_)
 
 /* **************************************** */
 

racket/src/racket/src/port.c

@@ -1156,7 +1156,7 @@ static void reset_wait_array(win_extended_fd_set *efd)
   /* Allocate an array that may be big enough to hold all events
      when we eventually call WaitForMultipleObjects. One of the three
      arrays will be big enough. */
-  int sz = (3 * (SCHEME_INT_VAL(efd->alloc) + SCHEME_INT_VAL(efd->num_handles))) + 2;
+  int sz = (3 * (SCHEME_INT_VAL(efd->alloc) + SCHEME_INT_VAL(efd->alloc_handles))) + 2;
   HANDLE *wa;
   wa = MALLOC_N_ATOMIC(HANDLE, sz);
   efd->wait_array = wa;
@@ -1170,16 +1170,27 @@ void *scheme_init_fdset_array(void *fdarray, int count)
     int i;
     win_extended_fd_set *fd;
     for (i = 0; i < count; i++) {
+      int reset = 0;
       fd = (win_extended_fd_set *)scheme_get_fdset(fdarray, i);
-      fd->sockets = NULL;
       fd->added = scheme_make_integer(0);
-      fd->alloc = scheme_make_integer(0);
-      fd->handles = NULL;
+      if (SCHEME_INT_VAL(fd->alloc) > (2 * SCHEME_INT_VAL(fd->last_alloc))) {
+	fd->alloc = scheme_make_integer(0);
+	fd->sockets = NULL;
+	reset = 1;
+      }
+      fd->last_alloc = scheme_make_integer(0);
       fd->num_handles = scheme_make_integer(0);
+      if (SCHEME_INT_VAL(fd->alloc_handles) > (2 * SCHEME_INT_VAL(fd->last_alloc_handles))) {
+	fd->alloc_handles = scheme_make_integer(0);
+	fd->handles = NULL;
+	fd->repost_sema = NULL;
+	reset = 1;
+      }
+      fd->last_alloc_handles = scheme_make_integer(0);
       fd->no_sleep = NULL;
       fd->wait_event_mask = scheme_make_integer(0);
-      fd->wait_array = NULL;
-      reset_wait_array(fdarray);
+      if (reset)
+	reset_wait_array(fdarray);
     }
   }
 # endif
@@ -1224,14 +1235,23 @@ void scheme_fdclr(void *fd, int n)
 #endif
 }
 
+#if defined(WIN32_FD_HANDLES)
+static int next_size(int v) { return (v ? (2 * v) : 10); }
+#endif
+
 void scheme_fdset(void *fd, int n)
 {
 #if defined(WIN32_FD_HANDLES)
   win_extended_fd_set *efd = (win_extended_fd_set *)fd;
+  if (SCHEME_INT_VAL(efd->added) >= SCHEME_INT_VAL(efd->last_alloc)) {
+    int na;
+    na = next_size(SCHEME_INT_VAL(efd->last_alloc));
+    efd->last_alloc = scheme_make_integer(na);
+  }
   if (SCHEME_INT_VAL(efd->added) >= SCHEME_INT_VAL(efd->alloc)) {
     SOCKET *naya;
     int na;
-    na = (SCHEME_INT_VAL(efd->alloc) * 2) + 10;
+    na = next_size(SCHEME_INT_VAL(efd->alloc));
     naya = (SOCKET *)scheme_malloc_atomic(na * sizeof(SOCKET));
     memcpy(naya, efd->sockets, SCHEME_INT_VAL(efd->alloc) * sizeof(SOCKET));
     efd->sockets = naya;
@@ -1361,21 +1381,28 @@ void scheme_add_fd_handle(void *h, void *fds, int repost)
 #if defined(WIN32_FD_HANDLES)
   win_extended_fd_set *efd = (win_extended_fd_set *)fds;
   OS_SEMAPHORE_TYPE *hs;
-  int i, *rps;
+  int i, new_i, *rps;
 
-  i = SCHEME_INT_VAL(efd->num_handles);
-  hs = MALLOC_N_ATOMIC(OS_SEMAPHORE_TYPE, i + 1);
-  rps = MALLOC_N_ATOMIC(int, i + 1);
-  hs[i] = (OS_SEMAPHORE_TYPE)h;
-  rps[i] = repost;
-  while (i--) {
-    hs[i] = efd->handles[i];
-    rps[i] = efd->repost_sema[i];
+  if (SCHEME_INT_VAL(efd->num_handles) == SCHEME_INT_VAL(efd->last_alloc_handles)) {
+    i = next_size(SCHEME_INT_VAL(efd->last_alloc_handles));
+    efd->last_alloc_handles = scheme_make_integer(1);
   }
+  if (SCHEME_INT_VAL(efd->num_handles) == SCHEME_INT_VAL(efd->alloc_handles)) {
+    i = SCHEME_INT_VAL(efd->alloc_handles);
+    new_i = next_size(i);
+    hs = MALLOC_N_ATOMIC(OS_SEMAPHORE_TYPE, new_i);
+    rps = MALLOC_N_ATOMIC(int, new_i);
+    memcpy(hs, efd->handles, sizeof(OS_SEMAPHORE_TYPE)*i);
+    memcpy(rps, efd->repost_sema, sizeof(int)*i);
+    efd->handles = hs;
+    efd->repost_sema = rps;
+    efd->alloc_handles = scheme_make_integer(new_i);
+    reset_wait_array(efd);
+  }
+  i = SCHEME_INT_VAL(efd->num_handles);
+  efd->handles[i] = (OS_SEMAPHORE_TYPE)h;
+  efd->repost_sema[i] = repost;
   efd->num_handles = scheme_make_integer(1 + SCHEME_INT_VAL(efd->num_handles));
-  efd->handles = hs;
-  efd->repost_sema = rps;
-  reset_wait_array(efd);
 #else
   /* Do nothing. */
 #endif
@@ -10444,7 +10471,7 @@ static void clean_up_wait(intptr_t result, OS_SEMAPHORE_TYPE *array,
       ReleaseSemaphore(array[result], 1, NULL);
   }
 
-  /* Clear out break semaphore */
+  /* Clear out break semaphore */  
   WaitForSingleObject((HANDLE)scheme_break_semaphore, 0);
 }
 

racket/src/racket/src/schwinfd.h

@@ -8,8 +8,11 @@ typedef struct {
 
   Scheme_Object *added; /* fixnum */
   Scheme_Object *alloc; /* fixnum */
+  Scheme_Object *last_alloc; /* fixnum */
 
   Scheme_Object *num_handles; /* fixnum */
+  Scheme_Object *alloc_handles; /* fixnum */
+  Scheme_Object *last_alloc_handles; /* fixnum */
   OS_SEMAPHORE_TYPE *handles;
 
   int *repost_sema;