add phantom byte strings

A phantom byte string is a small object that the memory
manager treats as an arbitrary-sized object, where the
size is specified when the phantom byte string is created
or or when size is changed via `set-phantom-bytes!'.

collects/scribblings/reference/memory.scrbl

@@ -252,3 +252,50 @@ information in a dump. The information that is available depends on
 your Racket build; check the end of a dump from a particular build to
 see if it offers additional information; otherwise, all @racket[v]s are
 ignored.}
+
+@;------------------------------------------------------------------------
+@section[#:tag "phantom-bytes"]{Phantom Byte Strings}
+
+A @deftech{phantom byte string} is a small Racket value that is
+treated by the Racket memory manager as having an arbitrary size,
+which is specified when the @tech{phantom byte string} is created or
+when it is changed via @racket[set-phantom-bytes!].
+
+A @tech{phantom byte string} acts as a hint to Racket's memory
+manager that memory is allocated within the process but through a
+separate allocator, such as through a foreign library that is accessed
+via @racketmodname[ffi/unsafe]. This hint is used to trigger
+@tech{garbage collections} or to compute the result of
+@racket[current-memory-use]. Currently, the hint is used only in
+Racket 3m (the main variant of Racket).
+
+@defproc[(phantom-bytes? [v any/c]) boolean?]{
+
+Returns @racket[#t] if @racket[v] is a @tech{phantom byte string},
+@racket[#f] otherwise.}
+
+
+@defproc[(make-phantom-bytes [k exact-nonnegative-integer?])
+         phantom-bytes?]{
+
+Creates a @tech{phantom byte string} that is treated by the Racket
+memory manager as being @racket[k] bytes in size. For a large enough
+@racket[k], the @exnraise[exn:fail:out-of-memory]---either because the
+size is implausibly large, or because a memory limit has been
+installed with @racket[custodian-limit-memory].}
+
+
+@defproc[(set-phantom-bytes! [phantom-bstr phantom-bytes?]
+                             [k exact-nonnegative-integer?])
+         phantom-bytes?]{
+
+Adjusts the size of a @tech{phantom byte string} as it is treated by
+the Racket memory manager.
+
+For example, if the memory that @racket[phantom-bstr] represents is
+released through a foreign library, then @racket[(set-phantom-bytes!
+phantom-bstr 0)] can reflect the change in memory use.
+
+When @racket[k] is larger than the current size of
+@racket[phantom-bstr], then this function can raise
+@racket[exn:fail:out-of-memory], like @racket[make-phantom-bytes].}

collects/tests/racket/will.rktl

@@ -185,6 +185,39 @@
                    (num-or (ephemeron-value (cdr p) 0) 1))))
   (test #t < n 50))
      
+;; ----------------------------------------
+;; Phantom bytes:
+
+(when (eq? '3m (system-type 'gc))
+  (define s (make-semaphore))
+  (define c (make-custodian))
+  (define t (parameterize ([current-custodian c])
+              (thread (lambda ()
+                        (semaphore-wait s)
+                        (define b (make-phantom-bytes (expt 2 29)))
+                        (test #t phantom-bytes? b)
+                        (test #f phantom-bytes? 0)
+                        (semaphore-wait s)
+                        (set-phantom-bytes! b 0)
+                        (semaphore-wait s)))))
+  (sync (system-idle-evt))
+  (collect-garbage)
+  (define m (current-memory-use))
+  (define mc (current-memory-use c))
+  (semaphore-post s)
+  (sync (system-idle-evt))
+  (test #t > (current-memory-use) (+ m (expt 2 28)))
+  (collect-garbage)
+  (test #t > (current-memory-use) (+ m (expt 2 28)))
+  (test #t > (current-memory-use c) (+ mc (expt 2 28)))
+  (semaphore-post s)
+  (sync (system-idle-evt))
+  (test #t < (current-memory-use) (+ m (expt 2 28)))
+  (collect-garbage)
+  (test #t < (current-memory-use) (+ m (expt 2 28)))
+  (test #t < (current-memory-use c) (+ mc (expt 2 28)))
+  (semaphore-post s))
+
 ;; ----------------------------------------
 
 (report-errs)

doc/release-notes/racket/HISTORY.txt

@@ -1,3 +1,6 @@
+Version 5.3.1.10
+Added phantom byte strings
+
 Version 5.3.1.9
 Changed case to use equal? instead of eqv?
 r5rs, r6rs: fixed case and cond to disallow internal definitions

src/racket/gc2/gc2.h

@@ -91,7 +91,8 @@ GC2_EXTERN void GC_add_roots(void *start, void *end);
    `start' (inclusive) and `end' (exclusive) contains pointers. */
 
 GC2_EXTERN void GC_init_type_tags(int count, int pair, int mutable_pair, int weakbox, 
-                                  int ephemeron, int weakarray, int custbox);
+                                  int ephemeron, int weakarray, int custbox,
+                                  int phantom);
 /*
    Called by Racket to indicate the number of different type tags it
    uses, starting from 0. `count' is always less than 256. The weakbox
@@ -276,6 +277,11 @@ GC2_EXTERN int GC_is_on_allocated_page(void *p);
    the GC allocates objects (although p may or may not
    be a valid pointer to the start of an alloctaed object). */
 
+GC2_EXTERN int GC_allocate_phantom_bytes(intptr_t);
+/* 
+   Returns 0 if allocation should fail due to a memory limit, 
+   1 otherwise. */
+
 /***************************************************************************/
 /* Memory tracing                                                          */
 /***************************************************************************/

src/racket/gc2/mem_account.c

@@ -447,6 +447,9 @@ static void BTC_do_accounting(NewGC *gc)
     last = cur;
     while(cur) {
       int owner = custodian_to_owner_set(gc, cur);
+      uintptr_t save_count = gc->phantom_count;
+
+      gc->phantom_count = 0;
 
       gc->current_mark_owner = owner;
       GCDEBUG((DEBUGOUTF,"MARKING THREADS OF OWNER %i (CUST %p)\n", owner, cur));
@@ -458,6 +461,10 @@ static void BTC_do_accounting(NewGC *gc)
 
       last = cur;
       box = cur->global_next; cur = box ? SCHEME_PTR1_VAL(box) : NULL;
+
+      owner_table[owner]->memory_use = add_no_overflow(owner_table[owner]->memory_use, 
+                                                       gcBYTES_TO_WORDS(gc->phantom_count));
+      gc->phantom_count = save_count;
     }
 
     /* walk backward folding totals int parent */
@@ -470,7 +477,8 @@ static void BTC_do_accounting(NewGC *gc)
         int powner = custodian_to_owner_set(gc, parent);
 
         owner_table = gc->owner_table;
-        owner_table[powner]->memory_use += owner_table[owner]->memory_use;
+        owner_table[powner]->memory_use = add_no_overflow(owner_table[powner]->memory_use,
+                                                          owner_table[owner]->memory_use);
         owner_table[powner]->master_memory_use += owner_table[owner]->master_memory_use;
       }
 

src/racket/gc2/newgc.c

@@ -1492,6 +1492,44 @@ intptr_t GC_alloc_alignment()
 
 intptr_t GC_malloc_stays_put_threshold() { return MAX_OBJECT_SIZE; }
 
+uintptr_t add_no_overflow(uintptr_t a, uintptr_t b)
+{
+  uintptr_t c = a + b;
+
+  if (c < a)
+    c = (uintptr_t)-1;
+
+  return c;
+}
+
+int GC_allocate_phantom_bytes(intptr_t request_size_bytes)
+{
+#ifdef NEWGC_BTC_ACCOUNT
+  NewGC *gc = GC_get_GC();
+
+  if (premaster_or_place_gc(gc)) {
+    if (BTC_single_allocation_limit(gc, request_size_bytes))
+      return 0;
+  }
+#endif
+
+  if ((request_size_bytes > 0)
+      && ((gc->phantom_count + request_size_bytes) < gc->phantom_count))
+    /* overflow */
+    return 1;
+
+  gc->phantom_count += request_size_bytes;
+  /* adjust `gc->memory_in_use', but protect against {over,under}flow: */
+  if (request_size_bytes < 0) {
+    request_size_bytes = -request_size_bytes;
+    if (gc->memory_in_use > request_size_bytes)
+      gc->memory_in_use -= request_size_bytes;
+  } else
+    gc->memory_in_use = add_no_overflow(gc->memory_in_use, request_size_bytes);
+
+  return 1;
+}
+
 void GC_create_message_allocator() {
   NewGC *gc = GC_get_GC();
   Allocator *a;
@@ -1769,8 +1807,10 @@ inline static void master_set_max_size(NewGC *gc)
 inline static void reset_nursery(NewGC *gc)
 {
   uintptr_t new_gen0_size;
+  
   new_gen0_size = NUM((GEN0_SIZE_FACTOR * (float)gc->memory_in_use) + GEN0_SIZE_ADDITION);
-  if(new_gen0_size > GEN0_MAX_SIZE)
+  if ((new_gen0_size > GEN0_MAX_SIZE)
+      || (gc->memory_in_use > GEN0_MAX_SIZE)) /* => overflow */
     new_gen0_size = GEN0_MAX_SIZE;
 
   resize_gen0(gc, new_gen0_size);
@@ -2206,6 +2246,34 @@ inline static void check_finalizers(NewGC *gc, int level)
 #undef is_marked
 #undef weak_box_resolve
 
+/*****************************************************************************/
+/* phantom bytes and accounting                                              */
+/*****************************************************************************/
+
+typedef struct {
+  short tag;
+  intptr_t count;
+} Phantom_Bytes;
+
+static int size_phantom(void *p, struct NewGC *gc)
+{
+  return gcBYTES_TO_WORDS(sizeof(Phantom_Bytes));
+}
+
+static int mark_phantom(void *p, struct NewGC *gc)
+{
+  Phantom_Bytes *pb = (Phantom_Bytes *)p;
+
+  gc->phantom_count = add_no_overflow(gc->phantom_count, pb->count);
+
+  return gcBYTES_TO_WORDS(sizeof(Phantom_Bytes));
+}
+
+static int fixup_phantom(void *p, struct NewGC *gc)
+{
+  return gcBYTES_TO_WORDS(sizeof(Phantom_Bytes));
+}
+
 /*****************************************************************************/
 /* Internal Stack Routines                                                   */
 /*****************************************************************************/
@@ -2729,7 +2797,9 @@ static void NewGC_initialize(NewGC *newgc, NewGC *inheritgc, NewGC *parentgc) {
 
 /* NOTE This method sets the constructed GC as the new Thread Specific GC. */
 static NewGC *init_type_tags_worker(NewGC *inheritgc, NewGC *parentgc, 
-                                    int count, int pair, int mutable_pair, int weakbox, int ephemeron, int weakarray, int custbox)
+                                    int count, int pair, int mutable_pair, int weakbox, 
+                                    int ephemeron, int weakarray, 
+                                    int custbox, int phantom)
 {
   NewGC *gc;
 
@@ -2744,6 +2814,7 @@ static NewGC *init_type_tags_worker(NewGC *inheritgc, NewGC *parentgc,
 # ifdef NEWGC_BTC_ACCOUNT
   gc->cust_box_tag    = custbox;
 # endif
+  gc->phantom_tag  = phantom;
 
   NewGC_initialize(gc, inheritgc, parentgc);
 
@@ -2763,6 +2834,7 @@ static NewGC *init_type_tags_worker(NewGC *inheritgc, NewGC *parentgc,
     GC_register_traversers2(gc->weak_box_tag, size_weak_box, mark_weak_box, fixup_weak_box, 0, 0);
     GC_register_traversers2(gc->ephemeron_tag, size_ephemeron, mark_ephemeron, fixup_ephemeron, 0, 0);
     GC_register_traversers2(gc->weak_array_tag, size_weak_array, mark_weak_array, fixup_weak_array, 0, 0);
+    GC_register_traversers2(gc->phantom_tag, size_phantom, mark_phantom, fixup_phantom, 0, 0);
   }
   initialize_signal_handler(gc);
   GC_add_roots(&gc->park, (char *)&gc->park + sizeof(gc->park) + 1);
@@ -2771,13 +2843,15 @@ static NewGC *init_type_tags_worker(NewGC *inheritgc, NewGC *parentgc,
   return gc;
 }
 
-void GC_init_type_tags(int count, int pair, int mutable_pair, int weakbox, int ephemeron, int weakarray, int custbox)
+void GC_init_type_tags(int count, int pair, int mutable_pair, int weakbox, int ephemeron, int weakarray, 
+                       int custbox, int phantom)
 {
   static int initialized = 0;
 
   if (!initialized) {
     initialized = 1;
-    init_type_tags_worker(NULL, NULL, count, pair, mutable_pair, weakbox, ephemeron, weakarray, custbox);
+    init_type_tags_worker(NULL, NULL, count, pair, mutable_pair, weakbox, ephemeron, weakarray, 
+                          custbox, phantom);
   } else {
     GCPRINT(GCOUTF, "GC_init_type_tags should only be called once!\n");
     abort();
@@ -2791,7 +2865,8 @@ struct NewGC *GC_get_current_instance() {
 #ifdef MZ_USE_PLACES
 void GC_construct_child_gc(struct NewGC *parent_gc, intptr_t limit) {
   NewGC *gc = MASTERGC;
-  NewGC *newgc = init_type_tags_worker(gc, parent_gc, 0, 0, 0, gc->weak_box_tag, gc->ephemeron_tag, gc->weak_array_tag, gc->cust_box_tag);
+  NewGC *newgc = init_type_tags_worker(gc, parent_gc, 0, 0, 0, gc->weak_box_tag, gc->ephemeron_tag, 
+                                       gc->weak_array_tag, gc->cust_box_tag, gc->phantom_tag);
   newgc->primoridal_gc = MASTERGC;
   newgc->dont_master_gc_until_child_registers = 1;
   if (limit)
@@ -2972,19 +3047,20 @@ void GC_register_traversers(short tag, Size_Proc size, Mark_Proc mark,
 intptr_t GC_get_memory_use(void *o) 
 {
   NewGC *gc = GC_get_GC();
-  intptr_t amt;
+  uintptr_t amt;
 #ifdef NEWGC_BTC_ACCOUNT
-  if(o) {
+  if (o) {
     return BTC_get_memory_use(gc, o);
   }
 #endif
-  amt = gen0_size_in_use(gc) + gc->memory_in_use;
+  amt = add_no_overflow(gen0_size_in_use(gc), gc->memory_in_use);
 #ifdef MZ_USE_PLACES
   mzrt_mutex_lock(gc->child_total_lock);
-  amt += gc->child_gc_total;
+  amt = add_no_overflow(amt, gc->child_gc_total);
   mzrt_mutex_unlock(gc->child_total_lock);
 #endif
-  return amt;
+  
+  return (intptr_t)amt;
 }
 
 /*****************************************************************************/
@@ -4255,7 +4331,7 @@ inline static void gen0_free_big_pages(NewGC *gc) {
 static void clean_up_heap(NewGC *gc)
 {
   int i;
-  size_t memory_in_use = 0;
+  uintptr_t memory_in_use = 0;
   PageMap pagemap = gc->page_maps;
 
   gen0_free_big_pages(gc);
@@ -4346,6 +4422,8 @@ static void clean_up_heap(NewGC *gc)
     gc->med_freelist_pages[i] = prev;
   }
 
+  memory_in_use = add_no_overflow(memory_in_use, gc->phantom_count);
+
   gc->memory_in_use = memory_in_use;
   cleanup_vacated_pages(gc);
 }
@@ -4533,6 +4611,9 @@ static void garbage_collect(NewGC *gc, int force_full, int switching_master, Log
   gc->in_unsafe_allocation_mode = 1;
   gc->unsafe_allocation_abort = out_of_memory_gc;
 
+  if (gc->gc_full)
+    gc->phantom_count = 0;
+
   TIME_INIT();
 
   /* inform the system (if it wants us to) that we're starting collection */
@@ -4811,7 +4892,7 @@ intptr_t GC_propagate_hierarchy_memory_use()
   }
 #endif
 
-  return gc->memory_in_use + gc->child_gc_total;
+  return add_no_overflow(gc->memory_in_use, gc->child_gc_total);
 }
 
 #if MZ_GC_BACKTRACE

src/racket/gc2/newgc.h

@@ -231,6 +231,9 @@ typedef struct NewGC {
   unsigned short weak_box_tag;
   unsigned short ephemeron_tag;
   unsigned short cust_box_tag;
+  unsigned short phantom_tag;
+
+  uintptr_t phantom_count;
 
   Roots roots;
   GC_Weak_Array *weak_arrays;
@@ -246,7 +249,7 @@ typedef struct NewGC {
   intptr_t previously_reported_total; /* how much we previously reported to the parent */
   mzrt_mutex *child_total_lock; /* lock on `child_gc_total' */
 #endif
-  intptr_t child_gc_total;
+  uintptr_t child_gc_total;
 
   uintptr_t place_memory_limit; /* set to propagate a custodian limit from a parent place */  
 

src/racket/src/salloc.c

@@ -113,7 +113,7 @@ void scheme_set_stack_base(void *base, int no_auto_statics) XFORM_SKIP_PROC
   GC_init_type_tags(_scheme_last_type_, 
                     scheme_pair_type, scheme_mutable_pair_type, scheme_weak_box_type, 
                     scheme_ephemeron_type, scheme_rt_weak_array,
-                    scheme_cust_box_type);
+                    scheme_cust_box_type, scheme_phantom_bytes_type);
   /* We want to be able to allocate symbols early. */
   scheme_register_traversers();
 #endif

src/racket/src/schminc.h

@@ -14,7 +14,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 1073
+#define EXPECTED_PRIM_COUNT 1076
 #define EXPECTED_UNSAFE_COUNT 80
 #define EXPECTED_FLFXNUM_COUNT 69
 #define EXPECTED_FUTURES_COUNT 15

src/racket/src/schvers.h

@@ -13,12 +13,12 @@
    consistently.)
 */
 
-#define MZSCHEME_VERSION "5.3.1.9"
+#define MZSCHEME_VERSION "5.3.1.10"
 
 #define MZSCHEME_VERSION_X 5
 #define MZSCHEME_VERSION_Y 3
 #define MZSCHEME_VERSION_Z 1
-#define MZSCHEME_VERSION_W 9
+#define MZSCHEME_VERSION_W 10
 
 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
 #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

src/racket/src/stypes.h

@@ -200,83 +200,84 @@ enum {
   scheme_port_closed_evt_type,          /* 180 */
   scheme_proc_shape_type,               /* 181 */
   scheme_struct_proc_shape_type,        /* 182 */
+  scheme_phantom_bytes_type,            /* 183 */
 
 #ifdef MZTAG_REQUIRED
-  _scheme_last_normal_type_,            /* 183 */
+  _scheme_last_normal_type_,            /* 184 */
 
-  scheme_rt_weak_array,                 /* 184 */
+  scheme_rt_weak_array,                 /* 185 */
 
-  scheme_rt_comp_env,                   /* 185 */
+  scheme_rt_comp_env,                   /* 186 */
-  scheme_rt_constant_binding,           /* 186 */
+  scheme_rt_constant_binding,           /* 187 */
-  scheme_rt_resolve_info,               /* 187 */
+  scheme_rt_resolve_info,               /* 188 */
-  scheme_rt_unresolve_info,             /* 188 */
+  scheme_rt_unresolve_info,             /* 189 */
-  scheme_rt_optimize_info,              /* 189 */
+  scheme_rt_optimize_info,              /* 190 */
-  scheme_rt_compile_info,               /* 190 */
+  scheme_rt_compile_info,               /* 191 */
-  scheme_rt_cont_mark,                  /* 191 */
+  scheme_rt_cont_mark,                  /* 192 */
-  scheme_rt_saved_stack,                /* 192 */
+  scheme_rt_saved_stack,                /* 193 */
-  scheme_rt_reply_item,                 /* 193 */
+  scheme_rt_reply_item,                 /* 194 */
-  scheme_rt_closure_info,               /* 194 */
+  scheme_rt_closure_info,               /* 195 */
-  scheme_rt_overflow,                   /* 195 */
+  scheme_rt_overflow,                   /* 196 */
-  scheme_rt_overflow_jmp,               /* 196 */
+  scheme_rt_overflow_jmp,               /* 197 */
-  scheme_rt_meta_cont,                  /* 197 */
+  scheme_rt_meta_cont,                  /* 198 */
-  scheme_rt_dyn_wind_cell,              /* 198 */
+  scheme_rt_dyn_wind_cell,              /* 199 */
-  scheme_rt_dyn_wind_info,              /* 199 */
+  scheme_rt_dyn_wind_info,              /* 200 */
-  scheme_rt_dyn_wind,                   /* 200 */
+  scheme_rt_dyn_wind,                   /* 201 */
-  scheme_rt_dup_check,                  /* 201 */
+  scheme_rt_dup_check,                  /* 202 */
-  scheme_rt_thread_memory,              /* 202 */
+  scheme_rt_thread_memory,              /* 203 */
-  scheme_rt_input_file,                 /* 203 */
+  scheme_rt_input_file,                 /* 204 */
-  scheme_rt_input_fd,                   /* 204 */
+  scheme_rt_input_fd,                   /* 205 */
-  scheme_rt_oskit_console_input,        /* 205 */
+  scheme_rt_oskit_console_input,        /* 206 */
-  scheme_rt_tested_input_file,          /* 206 */
+  scheme_rt_tested_input_file,          /* 207 */
-  scheme_rt_tested_output_file,         /* 207 */
+  scheme_rt_tested_output_file,         /* 208 */
-  scheme_rt_indexed_string,             /* 208 */
+  scheme_rt_indexed_string,             /* 209 */
-  scheme_rt_output_file,                /* 209 */
+  scheme_rt_output_file,                /* 210 */
-  scheme_rt_load_handler_data,          /* 210 */
+  scheme_rt_load_handler_data,          /* 211 */
-  scheme_rt_pipe,                       /* 211 */
+  scheme_rt_pipe,                       /* 212 */
-  scheme_rt_beos_process,               /* 212 */
+  scheme_rt_beos_process,               /* 213 */
-  scheme_rt_system_child,               /* 213 */
+  scheme_rt_system_child,               /* 214 */
-  scheme_rt_tcp,                        /* 214 */
+  scheme_rt_tcp,                        /* 215 */
-  scheme_rt_write_data,                 /* 215 */
+  scheme_rt_write_data,                 /* 216 */
-  scheme_rt_tcp_select_info,            /* 216 */
+  scheme_rt_tcp_select_info,            /* 217 */
-  scheme_rt_param_data,                 /* 217 */
+  scheme_rt_param_data,                 /* 218 */
-  scheme_rt_will,                       /* 218 */
+  scheme_rt_will,                       /* 219 */
-  scheme_rt_linker_name,                /* 219 */
+  scheme_rt_linker_name,                /* 220 */
-  scheme_rt_param_map,                  /* 220 */
+  scheme_rt_param_map,                  /* 221 */
-  scheme_rt_finalization,               /* 221 */
+  scheme_rt_finalization,               /* 222 */
-  scheme_rt_finalizations,              /* 222 */
+  scheme_rt_finalizations,              /* 223 */
-  scheme_rt_cpp_object,                 /* 223 */
+  scheme_rt_cpp_object,                 /* 224 */
-  scheme_rt_cpp_array_object,           /* 224 */
+  scheme_rt_cpp_array_object,           /* 225 */
-  scheme_rt_stack_object,               /* 225 */
+  scheme_rt_stack_object,               /* 226 */
-  scheme_rt_preallocated_object,        /* 226 */
+  scheme_rt_preallocated_object,        /* 227 */
-  scheme_thread_hop_type,               /* 227 */
+  scheme_thread_hop_type,               /* 228 */
-  scheme_rt_srcloc,                     /* 228 */
+  scheme_rt_srcloc,                     /* 229 */
-  scheme_rt_evt,                        /* 229 */
+  scheme_rt_evt,                        /* 230 */
-  scheme_rt_syncing,                    /* 230 */
+  scheme_rt_syncing,                    /* 231 */
-  scheme_rt_comp_prefix,                /* 231 */
+  scheme_rt_comp_prefix,                /* 232 */
-  scheme_rt_user_input,                 /* 232 */
+  scheme_rt_user_input,                 /* 233 */
-  scheme_rt_user_output,                /* 233 */
+  scheme_rt_user_output,                /* 234 */
-  scheme_rt_compact_port,               /* 234 */
+  scheme_rt_compact_port,               /* 235 */
-  scheme_rt_read_special_dw,            /* 235 */
+  scheme_rt_read_special_dw,            /* 236 */
-  scheme_rt_regwork,                    /* 236 */
+  scheme_rt_regwork,                    /* 237 */
-  scheme_rt_rx_lazy_string,             /* 237 */
+  scheme_rt_rx_lazy_string,             /* 238 */
-  scheme_rt_buf_holder,                 /* 238 */
+  scheme_rt_buf_holder,                 /* 239 */
-  scheme_rt_parameterization,           /* 239 */
+  scheme_rt_parameterization,           /* 240 */
-  scheme_rt_print_params,               /* 240 */
+  scheme_rt_print_params,               /* 241 */
-  scheme_rt_read_params,                /* 241 */
+  scheme_rt_read_params,                /* 242 */
-  scheme_rt_native_code,                /* 242 */
+  scheme_rt_native_code,                /* 243 */
-  scheme_rt_native_code_plus_case,      /* 243 */
+  scheme_rt_native_code_plus_case,      /* 244 */
-  scheme_rt_jitter_data,                /* 244 */
+  scheme_rt_jitter_data,                /* 245 */
-  scheme_rt_module_exports,             /* 245 */
+  scheme_rt_module_exports,             /* 246 */
-  scheme_rt_delay_load_info,            /* 246 */
+  scheme_rt_delay_load_info,            /* 247 */
-  scheme_rt_marshal_info,               /* 247 */
+  scheme_rt_marshal_info,               /* 248 */
-  scheme_rt_unmarshal_info,             /* 248 */
+  scheme_rt_unmarshal_info,             /* 249 */
-  scheme_rt_runstack,                   /* 249 */
+  scheme_rt_runstack,                   /* 250 */
-  scheme_rt_sfs_info,                   /* 250 */
+  scheme_rt_sfs_info,                   /* 251 */
-  scheme_rt_validate_clearing,          /* 251 */
+  scheme_rt_validate_clearing,          /* 252 */
-  scheme_rt_avl_node,                   /* 252 */
+  scheme_rt_avl_node,                   /* 253 */
-  scheme_rt_lightweight_cont,           /* 253 */
+  scheme_rt_lightweight_cont,           /* 254 */
-  scheme_rt_export_info,                /* 254 */
+  scheme_rt_export_info,                /* 255 */
-  scheme_rt_cont_jmp,                   /* 255 */
+  scheme_rt_cont_jmp,                   /* 256 */
 #endif
 
   _scheme_last_type_

src/racket/src/thread.c

@@ -271,7 +271,7 @@ extern intptr_t GC_is_place();
 #ifdef MZ_PRECISE_GC
 extern intptr_t GC_get_memory_use(void *c);
 #else
-extern MZ_DLLIMPORT long GC_get_memory_use();
+extern MZ_DLLIMPORT intptr_t GC_get_memory_use();
 #endif
 
 typedef struct Thread_Cell {
@@ -316,6 +316,11 @@ SHARED_OK static Proc_Global_Rec *process_globals;
 static mzrt_mutex *process_global_lock;
 #endif
 
+typedef struct {
+  Scheme_Object so;
+  intptr_t size;
+} Scheme_Phantom_Bytes;
+
 #ifdef MZ_PRECISE_GC
 static void register_traversers(void);
 #endif
@@ -392,6 +397,10 @@ static Scheme_Object *current_thread_set(int argc, Scheme_Object *argv[]);
 
 static Scheme_Object *current_thread_initial_stack_size(int argc, Scheme_Object *argv[]);
 
+static Scheme_Object *phantom_bytes_p(int argc, Scheme_Object *argv[]);
+static Scheme_Object *make_phantom_bytes(int argc, Scheme_Object *argv[]);
+static Scheme_Object *set_phantom_bytes(int argc, Scheme_Object *argv[]);
+
 static void adjust_custodian_family(void *pr, void *ignored);
 
 static Scheme_Object *make_will_executor(int argc, Scheme_Object *args[]);
@@ -579,6 +588,10 @@ void scheme_init_thread(Scheme_Env *env)
   GLOBAL_PRIM_W_ARITY("choice-evt"                , evts_to_evt                  , 0, -1, env);
 
   GLOBAL_PARAMETER("current-thread-initial-stack-size", current_thread_initial_stack_size, MZCONFIG_THREAD_INIT_STACK_SIZE, env);
+
+  GLOBAL_PRIM_W_ARITY("phantom-bytes?", phantom_bytes_p, 1, 1, env);
+  GLOBAL_PRIM_W_ARITY("make-phantom-bytes", make_phantom_bytes, 1, 1, env);
+  GLOBAL_PRIM_W_ARITY("set-phantom-bytes!", set_phantom_bytes, 2, 2, env);
 }
 
 void scheme_init_thread_places(void) {
@@ -679,7 +692,7 @@ static Scheme_Object *collect_garbage(int c, Scheme_Object *p[])
 static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
 {
   Scheme_Object *arg = NULL;
-  intptr_t retval = 0;
+  uintptr_t retval = 0;
 
   if (argc) {
     if (SCHEME_FALSEP(args[0])) {
@@ -700,7 +713,7 @@ static Scheme_Object *current_memory_use(int argc, Scheme_Object *args[])
   retval = GC_get_memory_use();
 #endif
   
-  return scheme_make_integer_value(retval);
+  return scheme_make_integer_value_from_unsigned(retval);
 }
 
 
@@ -7586,7 +7599,7 @@ Scheme_Object *scheme_param_config(char *name, Scheme_Object *pos,
 static Scheme_Object *
 exact_positive_integer_p (int argc, Scheme_Object *argv[])
 {
-  Scheme_Object *n = argv[0];
+  Scheme_Object *n = argv[argc-1];
   if (SCHEME_INTP(n) && (SCHEME_INT_VAL(n) > 0))
     return scheme_true;
   if (SCHEME_BIGNUMP(n) && SCHEME_BIGPOS(n))
@@ -7603,6 +7616,58 @@ static Scheme_Object *current_thread_initial_stack_size(int argc, Scheme_Object
 			     -1, exact_positive_integer_p, "exact positive integer", 0);
 }
 
+static Scheme_Object *phantom_bytes_p(int argc, Scheme_Object *argv[])
+{
+  return (SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_phantom_bytes_type)
+          ? scheme_true
+          : scheme_false);
+}
+
+static Scheme_Object *make_phantom_bytes(int argc, Scheme_Object *argv[])
+{
+  Scheme_Phantom_Bytes *pb;
+
+  if (!scheme_nonneg_exact_p(argv[0]))
+    scheme_wrong_contract("make-phantom-bytes", "exact-nonnegative-integer?", 0, argc, argv);
+
+  if (!SCHEME_INTP(argv[0]))
+    scheme_raise_out_of_memory("make-phantom-bytes", NULL);
+
+  pb = MALLOC_ONE_TAGGED(Scheme_Phantom_Bytes);
+  pb->so.type = scheme_phantom_bytes_type;
+  pb->size = SCHEME_INT_VAL(argv[0]);
+
+# ifdef MZ_PRECISE_GC
+  if (!GC_allocate_phantom_bytes(pb->size))
+    scheme_raise_out_of_memory("make-phantom-bytes", NULL);
+# endif
+
+  return (Scheme_Object *)pb;
+}
+
+static Scheme_Object *set_phantom_bytes(int argc, Scheme_Object *argv[])
+{
+  Scheme_Phantom_Bytes *pb;
+  intptr_t amt;
+
+  if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_phantom_bytes_type))
+    scheme_wrong_contract("set-phantom-bytes!", "phantom-bytes?", 0, argc, argv);
+  if (!scheme_nonneg_exact_p(argv[1]))
+    scheme_wrong_contract("set-phantom-bytes!", "exact-nonnegative-integer?", 1, argc, argv);
+
+  pb = (Scheme_Phantom_Bytes *)argv[0];
+  amt = SCHEME_INT_VAL(argv[1]);
+
+# ifdef MZ_PRECISE_GC
+  if (!GC_allocate_phantom_bytes(amt - pb->size))
+    scheme_raise_out_of_memory("make-phantom-bytes", NULL);
+# endif
+
+  pb->size = amt;
+
+  return scheme_void;
+}
+
 /*========================================================================*/
 /*                              namespaces                                */
 /*========================================================================*/

src/racket/src/type.c

@@ -307,6 +307,8 @@ scheme_init_type ()
 
   set_name(scheme_resolved_module_path_type, "<resolve-module-path>");
 
+  set_name(scheme_phantom_bytes_type, "<phantom-bytes>");
+
 #ifdef MZ_GC_BACKTRACE
   set_name(scheme_rt_meta_cont, "<meta-continuation>");
 #endif