add scheme_jit_find_code_end

pkgs/racket-pkgs/racket-doc/scribblings/inside/misc.scrbl

@@ -367,3 +367,14 @@ refer to garbage-collected memory.
 
 This function is intended for infrequent use with a small number of
 keys.}
+
+@function[(void* scheme_jit_find_code_end
+                 [void* p])]{
+
+Given the address of machine code generated by Racket's compiler,
+attempts to infer and return the address just after the end of the
+generated code (for a single source function, typically). The result
+is @racket[#f] if the address cannot be inferred, which may be because
+the given @var{p} does not refer to generated machine code.
+
+@history[#:added "6.0.1.9"]}

racket/src/racket/include/mzwin.def

@@ -633,3 +633,4 @@ EXPORTS
  scheme_register_process_global
  scheme_malloc_key
  scheme_free_key
+ scheme_jit_find_code_end

racket/src/racket/include/mzwin3m.def

@@ -649,3 +649,4 @@ EXPORTS
  scheme_register_process_global
  scheme_malloc_key
  scheme_free_key
+ scheme_jit_find_code_end

racket/src/racket/include/racket.exp

@@ -650,3 +650,4 @@ scheme_get_place_table
 scheme_register_process_global
 scheme_malloc_key
 scheme_free_key
+scheme_jit_find_code_end

racket/src/racket/include/racket3m.exp

@@ -657,3 +657,4 @@ scheme_get_place_table
 scheme_register_process_global
 scheme_malloc_key
 scheme_free_key
+scheme_jit_find_code_end

racket/src/racket/src/jit.c

@@ -30,7 +30,6 @@
 
 #ifdef MZ_PRECISE_GC
 static void register_traversers(void);
-static void release_native_code(void *fnlized, void *p);
 #endif
 
 static void generate_case_lambda(Scheme_Case_Lambda *c, Scheme_Native_Closure_Data *ndata, int is_method);

racket/src/racket/src/jitstack.c

@@ -613,6 +613,38 @@ void scheme_jit_release_native_code(void *fnlized, void *p)
 }
 #endif
 
+void* scheme_jit_find_code_end(void *_p)
+{
+  uintptr_t p = (uintptr_t)_p;
+  uintptr_t hi, lo, mid;
+  void *n;
+
+  n = find_symbol(p);
+  if (n) {
+    /* find overesitinate of ending point: */
+    hi = 1;
+    while (find_symbol(p+hi) == n) {
+      hi = hi*2;
+      if (p + hi < p) {
+        /* this shouldn't happen, but if something has gone really wrong,
+           we don't want to loop forever */
+        return NULL;
+      }
+    }
+    /* binary search for precise ending point: */
+    lo = hi / 2;
+    while (lo+1 < hi) {
+      mid = lo + (((hi - lo) + 1) / 2);
+      if (find_symbol(p+mid) == n)
+        lo = mid;
+      else
+        hi = mid;
+    }
+    return (void *)(p+hi);
+  } else
+    return NULL;
+}
+
 typedef void *(*Module_Run_Proc)(Scheme_Env *menv, Scheme_Env *env, Scheme_Object **name);
 typedef void *(*Module_Exprun_Proc)(Scheme_Env *menv, int set_ns, Scheme_Object **name);
 typedef void *(*Module_Start_Proc)(struct Start_Module_Args *a, Scheme_Object **name);
@@ -644,4 +676,8 @@ void *scheme_module_start_start(struct Start_Module_Args *a, Scheme_Object *name
     return scheme_module_start_finish(a);
 }
 
+#else
+
+void* scheme_jit_find_code_end(void *p) { return NULL; }
+
 #endif

racket/src/racket/src/schemef.h

@@ -1221,3 +1221,5 @@ MZ_EXTERN void *scheme_register_process_global(const char *key, void *val);
 
 MZ_EXTERN Scheme_Object *scheme_malloc_key(void);
 MZ_EXTERN void scheme_free_key(Scheme_Object *k);
+
+MZ_EXTERN void* scheme_jit_find_code_end(void *p);

racket/src/racket/src/schemex.h

@@ -994,6 +994,7 @@ Scheme_Hash_Table *(*scheme_get_place_table)(void);
 void *(*scheme_register_process_global)(const char *key, void *val);
 Scheme_Object *(*scheme_malloc_key)(void);
 void (*scheme_free_key)(Scheme_Object *k);
+ (*scheme_jit_find_code_end)(void *p);
 #ifndef SCHEME_EX_INLINE
 } Scheme_Extension_Table;
 #endif

racket/src/racket/src/schemex.inc

@@ -722,3 +722,4 @@
   scheme_extension_table->scheme_register_process_global = scheme_register_process_global;
   scheme_extension_table->scheme_malloc_key = scheme_malloc_key;
   scheme_extension_table->scheme_free_key = scheme_free_key;
+  scheme_extension_table->scheme_jit_find_code_end = scheme_jit_find_code_end;

racket/src/racket/src/schemexm.h

@@ -722,6 +722,7 @@
 #define scheme_register_process_global (scheme_extension_table->scheme_register_process_global)
 #define scheme_malloc_key (scheme_extension_table->scheme_malloc_key)
 #define scheme_free_key (scheme_extension_table->scheme_free_key)
+#define scheme_jit_find_code_end (scheme_extension_table->scheme_jit_find_code_end)
 #ifdef MZ_PRECISE_GC
 #pragma GC_VARIABLE_STACK_THOUGH_TABLE
 #endif