diff --git a/libguile/intrinsics.c b/libguile/intrinsics.c index 73ad2b0ce..cc8cd2b1e 100644 --- a/libguile/intrinsics.c +++ b/libguile/intrinsics.c @@ -26,6 +26,7 @@ #include "cache-internal.h" #include "extensions.h" #include "fluids.h" +#include "gc-inline.h" #include "goops.h" #include "gsubr.h" #include "keywords.h" @@ -333,6 +334,12 @@ error_wrong_number_of_values (uint32_t expected) scm_list_1 (scm_from_uint32 (expected))); } +static SCM +allocate_words (scm_thread *thread, uint64_t n) +{ + return SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, n)); +} + void scm_bootstrap_intrinsics (void) @@ -386,6 +393,7 @@ scm_bootstrap_intrinsics (void) scm_vm_intrinsics.error_no_values = error_no_values; scm_vm_intrinsics.error_not_enough_values = error_not_enough_values; scm_vm_intrinsics.error_wrong_number_of_values = error_wrong_number_of_values; + scm_vm_intrinsics.allocate_words = allocate_words; scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, "scm_init_intrinsics", diff --git a/libguile/intrinsics.h b/libguile/intrinsics.h index ac5966114..02045f3d5 100644 --- a/libguile/intrinsics.h +++ b/libguile/intrinsics.h @@ -62,6 +62,7 @@ typedef void (*scm_t_scm_scm_noreturn_intrinsic) (SCM, SCM) SCM_NORETURN; typedef void (*scm_t_noreturn_intrinsic) (void) SCM_NORETURN; typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN; typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN; +typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t); #define SCM_FOR_ALL_VM_INTRINSICS(M) \ M(scm_from_scm_scm, add, "add", ADD) \ @@ -125,6 +126,7 @@ typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) SCM_NORETURN; M(noreturn, error_not_enough_values, "not-enough-values", ERROR_NOT_ENOUGH_VALUES) \ M(u32_noreturn, error_wrong_number_of_values, "wrong-number-of-values", ERROR_WRONG_NUMBER_OF_VALUES) \ M(thread, apply_non_program, "apply-non-program", APPLY_NON_PROGRAM) \ + M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ enum scm_vm_intrinsic diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 88cfb614f..7988536ec 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -1155,10 +1155,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) UNPACK_12_12 (op, dst, size); SYNC_IP (); - SP_SET (dst, - SCM_PACK_POINTER - (scm_inline_gc_malloc_words (thread, SP_REF_U64 (size)))); - + SP_SET (dst, scm_vm_intrinsics.allocate_words (thread, SP_REF_U64 (size))); NEXT (1); } @@ -1169,8 +1166,7 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) UNPACK_12_12 (op, dst, size); SYNC_IP (); - SP_SET (dst, - SCM_PACK_POINTER (scm_inline_gc_malloc_words (thread, size))); + SP_SET (dst, scm_vm_intrinsics.allocate_words (thread, size)); NEXT (1); } @@ -1945,7 +1941,24 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume) NEXT (2); } - VM_DEFINE_OP (92, unused_92, NULL, NOP) + VM_DEFINE_OP (92, call_scm_from_thread, "call-scm<-thread", OP2 (X8_S24, C32) | OP_DST) + { + uint32_t dst; + scm_t_scm_from_thread_intrinsic intrinsic; + SCM res; + + UNPACK_24 (op, dst); + intrinsic = intrinsics[ip[1]]; + + SYNC_IP (); + res = intrinsic (thread); + CACHE_SP (); + + SP_SET (dst, res); + + NEXT (2); + } + VM_DEFINE_OP (93, unused_93, NULL, NOP) VM_DEFINE_OP (94, unused_94, NULL, NOP) VM_DEFINE_OP (95, unused_95, NULL, NOP)