mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-29 19:30:36 +02:00
Code Activity

allocate-words intrinsic

Browse source 
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* libguile/intrinsics.c (allocate_words, scm_bootstrap_intrinsics): New
  intrinsic.
* libguile/vm-engine.c (allocate-words, allocate-words/immediate): Use
  new intrinsic.
This commit is contained in:
Andy Wingo 2018-06-27 14:36:56 +02:00
parent 7883290d88
commit 0faa4144d1
3 changed files with 30 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

8
libguile/intrinsics.c
View file

@ -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",

2
libguile/intrinsics.h
View file

@ -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

27
libguile/vm-engine.c
View file

@ -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)