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

Intrinsic for "prompt"

Browse source 
* libguile/intrinsics.h (SCM_FOR_ALL_VM_INTRINSICS):
* libguile/intrinsics.c (push_prompt, scm_bootstrap_intrinsics): New
  intrinsic.
* libguile/vm-engine.c (prompt): Use push-prompt intrinsic.
This commit is contained in:
Andy Wingo 2018-06-27 15:29:49 +02:00
parent 85ab5f0299
commit 294e627c6b
3 changed files with 23 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

14
libguile/intrinsics.c
View file

@ -26,6 +26,7 @@
#include "cache-internal.h" #include "cache-internal.h"
#include "extensions.h" #include "extensions.h"
#include "fluids.h" #include "fluids.h"
#include "frames.h"
#include "gc-inline.h" #include "gc-inline.h"
#include "goops.h" #include "goops.h"
#include "gsubr.h" #include "gsubr.h"
@ -346,6 +347,18 @@ current_module (scm_thread *thread)
return scm_i_current_module (thread); return scm_i_current_module (thread);
} }
static void
push_prompt (scm_thread *thread, jmp_buf *registers, uint8_t escape_only_p,
SCM tag, const union scm_vm_stack_element *sp, void *ra)
{
struct scm_vm *vp = &thread->vm;
scm_t_dynstack_prompt_flags flags;
flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
scm_dynstack_push_prompt (&thread->dynstack, flags, tag,
vp->stack_top - vp->fp, vp->stack_top - sp,
ra, registers);
}
void void
scm_bootstrap_intrinsics (void) scm_bootstrap_intrinsics (void)
@ -401,6 +414,7 @@ scm_bootstrap_intrinsics (void)
scm_vm_intrinsics.error_wrong_number_of_values = error_wrong_number_of_values; scm_vm_intrinsics.error_wrong_number_of_values = error_wrong_number_of_values;
scm_vm_intrinsics.allocate_words = allocate_words; scm_vm_intrinsics.allocate_words = allocate_words;
scm_vm_intrinsics.current_module = current_module; scm_vm_intrinsics.current_module = current_module;
scm_vm_intrinsics.push_prompt = push_prompt;
scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
"scm_init_intrinsics", "scm_init_intrinsics",

5
libguile/intrinsics.h
View file

@ -64,6 +64,10 @@ typedef void (*scm_t_scm_noreturn_intrinsic) (SCM) SCM_NORETURN;
typedef void (*scm_t_u32_noreturn_intrinsic) (uint32_t) 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); typedef SCM (*scm_t_scm_from_thread_u64_intrinsic) (scm_thread*, uint64_t);
typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*); typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
typedef void (*scm_t_thread_regs_u8_scm_sp_ra_intrinsic) (scm_thread*, jmp_buf*,
uint8_t, SCM,
const union scm_vm_stack_element*,
void*);
#define SCM_FOR_ALL_VM_INTRINSICS(M) \ #define SCM_FOR_ALL_VM_INTRINSICS(M) \
M(scm_from_scm_scm, add, "add", ADD) \ M(scm_from_scm_scm, add, "add", ADD) \
@ -129,6 +133,7 @@ typedef SCM (*scm_t_scm_from_thread_intrinsic) (scm_thread*);
M(thread, apply_non_program, "apply-non-program", APPLY_NON_PROGRAM) \ M(thread, apply_non_program, "apply-non-program", APPLY_NON_PROGRAM) \
M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \ M(scm_from_thread_u64, allocate_words, "allocate-words", ALLOCATE_WORDS) \
M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \ M(scm_from_thread, current_module, "current-module", CURRENT_MODULE) \
M(thread_regs_u8_scm_sp_ra, push_prompt, "push-prompt", PUSH_PROMPT) \
/* Add new intrinsics here; also update scm_bootstrap_intrinsics. */ /* Add new intrinsics here; also update scm_bootstrap_intrinsics. */
enum scm_vm_intrinsic enum scm_vm_intrinsic

12
libguile/vm-engine.c
View file

@ -1671,7 +1671,6 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume)
uint32_t tag, proc_slot; uint32_t tag, proc_slot;
int32_t offset; int32_t offset;
uint8_t escape_only_p; uint8_t escape_only_p;
scm_t_dynstack_prompt_flags flags;
UNPACK_24 (op, tag); UNPACK_24 (op, tag);
escape_only_p = ip[1] & 0x1; escape_only_p = ip[1] & 0x1;
@ -1680,14 +1679,11 @@ VM_NAME (scm_thread *thread, jmp_buf *registers, int resume)
offset >>= 8; /* Sign extension */ offset >>= 8; /* Sign extension */
/* Push the prompt onto the dynamic stack. */ /* Push the prompt onto the dynamic stack. */
flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
SYNC_IP (); SYNC_IP ();
scm_dynstack_push_prompt (&thread->dynstack, flags, scm_vm_intrinsics.push_prompt (thread, registers, escape_only_p,
SP_REF (tag), SP_REF (tag), FP_SLOT (proc_slot),
VP->stack_top - VP->fp, ip + offset);
VP->stack_top - FP_SLOT (proc_slot),
ip + offset,
registers);
NEXT (3); NEXT (3);
} }