Let the allocator use memory blocks with right size but wrong tag. (#…

…1006)

Worst case, this means we push a fresh allocation to later rather than
now, so it should not have any negative consequences.

That said, our free list logic is still fairly crude, and there is
likely room for further refinement.

rts/c/cuda.h

@@ -527,7 +527,7 @@ static CUresult cuda_alloc(struct cuda_context *ctx, size_t min_size,
   }
 
   size_t size;
-  if (free_list_find(&ctx->free_list, tag, &size, mem_out) == 0) {
+  if (free_list_find(&ctx->free_list, tag, min_size, &size, mem_out) == 0) {
     if (size >= min_size) {
       return CUDA_SUCCESS;
     } else {
@@ -561,7 +561,7 @@ static CUresult cuda_free(struct cuda_context *ctx, CUdeviceptr mem,
   CUdeviceptr existing_mem;
 
   // If there is already a block with this tag, then remove it.
-  if (free_list_find(&ctx->free_list, tag, &size, &existing_mem) == 0) {
+  if (free_list_find(&ctx->free_list, tag, -1, &size, &existing_mem) == 0) {
     CUresult res = cuMemFree(existing_mem);
     if (res != CUDA_SUCCESS) {
       return res;

rts/c/free_list.h

@@ -82,21 +82,36 @@ static void free_list_insert(struct free_list *l, size_t size, fl_mem_t mem, con
   l->used++;
 }
 
-/* Find and remove a memory block of at least the desired size and
-   tag.  Returns 0 on success.  */
-static int free_list_find(struct free_list *l, const char *tag, size_t *size_out, fl_mem_t *mem_out) {
+/* Find and remove a memory block of the indicated tag, or if that
+   does not exist, another memory block with exactly the desired size.
+   Returns 0 on success. */
+static int free_list_find(struct free_list *l, const char *tag, size_t size,
+                          size_t *size_out, fl_mem_t *mem_out) {
+  int size_match = -1;
   int i;
   for (i = 0; i < l->capacity; i++) {
-    if (l->entries[i].valid && l->entries[i].tag == tag) {
-      l->entries[i].valid = 0;
-      *size_out = l->entries[i].size;
-      *mem_out = l->entries[i].mem;
-      l->used--;
-      return 0;
+    if (l->entries[i].valid) {
+      if (l->entries[i].tag == tag) {
+        break;
+      } else if (size == l->entries[i].size) {
+        size_match = i;
+      }
     }
   }
 
-  return 1;
+  if (i == l->capacity && size_match >= 0) {
+    i = size_match;
+  }
+
+  if (i != l->capacity) {
+    l->entries[i].valid = 0;
+    *size_out = l->entries[i].size;
+    *mem_out = l->entries[i].mem;
+    l->used--;
+    return 0;
+  } else {
+    return 1;
+  }
 }
 
 /* Remove the first block in the free list.  Returns 0 if a block was

rts/c/opencl.h

@@ -833,7 +833,7 @@ static int opencl_alloc(struct opencl_context *ctx, size_t min_size, const char
 
   size_t size;
 
-  if (free_list_find(&ctx->free_list, tag, &size, mem_out) == 0) {
+  if (free_list_find(&ctx->free_list, tag, min_size, &size, mem_out) == 0) {
     // Successfully found a free block.  Is it big enough?
     //
     // FIXME: we might also want to check whether the block is *too
@@ -892,7 +892,7 @@ static int opencl_free(struct opencl_context *ctx, cl_mem mem, const char *tag)
   cl_mem existing_mem;
 
   // If there is already a block with this tag, then remove it.
-  if (free_list_find(&ctx->free_list, tag, &size, &existing_mem) == 0) {
+  if (free_list_find(&ctx->free_list, tag, -1, &size, &existing_mem) == 0) {
     int error = clReleaseMemObject(existing_mem);
     if (error != CL_SUCCESS) {
       return error;