VM: new primitive free-callback which is able to free a callback

previously allocated using <callback>

diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor
index 17a66653cbae267e1d3ddb03930ca343a8a689fc..10297eb071171459a91180730f5540b168347005 100644 (file)
--- a/basis/stack-checker/known-words/known-words.factor
+++ b/basis/stack-checker/known-words/known-words.factor
@@ -418,6 +418,7 @@ M: object infer-call* \ call bad-macro-input ;
 \ fpu-state { } { } define-primitive
 \ fputc { object alien } { } define-primitive
 \ fread-unsafe { integer c-ptr alien } { integer } define-primitive
+\ free-callback { alien } { } define-primitive
 \ fseek { integer integer alien } { } define-primitive
 \ ftell { alien } { integer } define-primitive
 \ fwrite { c-ptr integer alien } { } define-primitive

diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor
index d67189ac026a23fa92294af17d00e444179b33ce..c1e25d48549c61364101570f3c0cd1df8734e98b 100755 (executable)
--- a/core/bootstrap/primitives.factor
+++ b/core/bootstrap/primitives.factor
@@ -450,6 +450,7 @@ tuple
     { "fgetc" "io.streams.c" "primitive_fgetc" ( alien -- byte/f ) }
     { "fputc" "io.streams.c" "primitive_fputc" ( byte alien -- ) }
     { "fread-unsafe" "io.streams.c" "primitive_fread" ( n buf alien -- count ) }
+    { "free-callback" "alien" "primitive_free_callback" ( alien -- ) }
     { "fseek" "io.streams.c" "primitive_fseek" ( alien offset whence -- ) }
     { "ftell" "io.streams.c" "primitive_ftell" ( alien -- n ) }
     { "fwrite" "io.streams.c" "primitive_fwrite" ( data length alien -- ) }

diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp
index 45e54af0d3f35b4a8f312e020d406e401a6d98d8..9cccd1b933ee864793fdaefc3d203cffe2de1e9f 100644 (file)
--- a/vm/callbacks.cpp
+++ b/vm/callbacks.cpp
@@ -136,6 +136,12 @@ void factor_vm::primitive_callback() {
   ctx->push(allot_alien(func));
 }
 
+void factor_vm::primitive_free_callback() {
+  void* entry_point = alien_offset(ctx->pop());
+  code_block* stub = (code_block*)entry_point - 1;
+  callbacks->allocator->free(stub);
+}
+
 /* Allocates memory */
 void factor_vm::primitive_callback_room() {
   allocator_room room = callbacks->allocator->as_allocator_room();

diff --git a/vm/primitives.hpp b/vm/primitives.hpp
index d7cefd5d92ddbcc69b52b807b8358a261179b814..01dd919c519cd299994c6874fda292bde9fffd7b 100644 (file)
--- a/vm/primitives.hpp
+++ b/vm/primitives.hpp
@@ -9,9 +9,9 @@ namespace factor {
       _(bignum_less) _(bignum_lesseq) _(bignum_log2) _(bignum_mod)             \
       _(bignum_gcd) _(bignum_multiply) _(bignum_not) _(bignum_or)              \
       _(bignum_shift) _(bignum_subtract) _(bignum_to_fixnum)                   \
-      _(bignum_to_fixnum_strict) _(bignum_xor)                                 \
-      _(bits_double) _(bits_float) _(byte_array) _(callback) _(callback_room)  \
-      _(callstack) _(callstack_bounds) _(callstack_for) _(callstack_to_array)  \
+      _(bignum_to_fixnum_strict) _(bignum_xor) _(bits_double) _(bits_float)    \
+      _(byte_array) _(callback) _(callback_room) _(callstack)                  \
+      _(callstack_bounds) _(callstack_for) _(callstack_to_array)               \
       _(check_datastack) _(clear_samples) _(clone) _(code_blocks) _(code_room) \
       _(compact_gc) _(compute_identity_hashcode) _(context_object)             \
       _(context_object_for) _(current_callback) _(data_room) _(datastack)      \
@@ -23,19 +23,20 @@ namespace factor {
       _(float_bits) _(float_divfloat) _(float_eq) _(float_greater)             \
       _(float_greatereq) _(float_less) _(float_lesseq) _(float_multiply)       \
       _(float_subtract) _(float_to_bignum) _(float_to_fixnum) _(fopen)         \
-      _(format_float) _(fputc) _(fread) _(fseek) _(ftell) _(full_gc) _(fwrite) \
-      _(get_samples) _(identity_hashcode) _(innermost_stack_frame_executing)   \
-      _(innermost_stack_frame_scan) _(jit_compile) _(load_locals)              \
-      _(lookup_method) _(mega_cache_miss) _(minor_gc) _(modify_code_heap)      \
-      _(nano_count) _(optimized_p) _(quot_compiled_p) _(quotation_code)        \
-      _(reset_dispatch_stats) _(resize_array) _(resize_byte_array)             \
-      _(resize_string) _(retainstack) _(retainstack_for) _(sampling_profiler)  \
-      _(save_image) _(save_image_and_exit) _(set_context_object)               \
-      _(set_datastack) _(set_innermost_stack_frame_quot) _(set_retainstack)    \
-      _(set_slot) _(set_special_object) _(set_string_nth_fast) _(size)         \
-      _(sleep) _(special_object) _(string) _(strip_stack_traces) _(tuple)      \
-      _(tuple_boa) _(unimplemented) _(uninitialized_byte_array) _(word)        \
-      _(word_code) _(wrapper)
+      _(format_float) _(fputc) _(fread) _(free_callback) _(fseek) _(ftell)     \
+      _(full_gc) _(fwrite) _(get_samples) _(identity_hashcode)                 \
+      _(innermost_stack_frame_executing) _(innermost_stack_frame_scan)         \
+      _(jit_compile) _(load_locals) _(lookup_method) _(mega_cache_miss)        \
+      _(minor_gc) _(modify_code_heap) _(nano_count) _(optimized_p)             \
+      _(quot_compiled_p) _(quotation_code) _(reset_dispatch_stats)             \
+      _(resize_array) _(resize_byte_array) _(resize_string) _(retainstack)     \
+      _(retainstack_for) _(sampling_profiler) _(save_image)                    \
+      _(save_image_and_exit) _(set_context_object) _(set_datastack)            \
+      _(set_innermost_stack_frame_quot) _(set_retainstack) _(set_slot)         \
+      _(set_special_object) _(set_string_nth_fast) _(size) _(sleep)            \
+      _(special_object) _(string) _(strip_stack_traces) _(tuple) _(tuple_boa)  \
+      _(unimplemented) _(uninitialized_byte_array) _(word) _(word_code)        \
+      _(wrapper)
 
 #define EACH_ALIEN_PRIMITIVE(_)                               \
   _(signed_cell, fixnum, from_signed_cell, to_fixnum)         \

diff --git a/vm/vm.hpp b/vm/vm.hpp
index d1c49f7fb22a025d7eb245aa4fca894ffa032e46..6cc9f0f5057d0f305e865046aeffea28c1ebe918 100644 (file)
--- a/vm/vm.hpp
+++ b/vm/vm.hpp
@@ -612,6 +612,7 @@ struct factor_vm {
 
   // callbacks
   void init_callbacks(cell size);
+  void primitive_free_callback();
   void primitive_callback();
   void primitive_callback_room();