mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-30 06:50:31 +02:00
Add thread-vm' and
set-thread-vm!'.
* libguile/vm.c (thread_vm, scm_thread_vm, scm_set_thread_vm_x): New functions. (scm_the_vm): Add docstring. Use `thread_vm'. * libguile/vm.h (scm_thread_vm, scm_set_thread_vm_x): New declarations. * module/system/vm/vm.scm: Export `thread-vm' and `set-thread-vm!'.
This commit is contained in:
parent
f4a23f910f
commit
271c3d3196
3 changed files with 46 additions and 8 deletions
|
@ -597,18 +597,53 @@ SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
|
|||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0,
|
||||
(void),
|
||||
"")
|
||||
#define FUNC_NAME s_scm_the_vm
|
||||
/* Return T's VM. */
|
||||
static inline SCM
|
||||
thread_vm (scm_i_thread *t)
|
||||
{
|
||||
scm_i_thread *t = SCM_I_CURRENT_THREAD;
|
||||
|
||||
if (SCM_UNLIKELY (scm_is_false ((t->vm))))
|
||||
if (SCM_UNLIKELY (scm_is_false (t->vm)))
|
||||
t->vm = make_vm ();
|
||||
|
||||
return t->vm;
|
||||
}
|
||||
|
||||
SCM_DEFINE (scm_thread_vm, "thread-vm", 1, 0, 0,
|
||||
(SCM thread),
|
||||
"Return @var{thread}'s VM.")
|
||||
#define FUNC_NAME s_scm_thread_vm
|
||||
{
|
||||
SCM_VALIDATE_THREAD (1, thread);
|
||||
|
||||
return thread_vm (SCM_I_THREAD_DATA (thread));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_set_thread_vm_x, "set-thread-vm!", 2, 0, 0,
|
||||
(SCM thread, SCM vm),
|
||||
"Set @var{thread}'s VM to @var{vm}. Warning: Code being\n"
|
||||
"executed by @var{thread}'s current VM won't automatically\n"
|
||||
"switch to @var{vm}.")
|
||||
#define FUNC_NAME s_scm_set_thread_vm_x
|
||||
{
|
||||
scm_i_thread *t;
|
||||
|
||||
SCM_VALIDATE_THREAD (1, thread);
|
||||
SCM_VALIDATE_VM (2, vm);
|
||||
|
||||
t = SCM_I_THREAD_DATA (thread);
|
||||
t->vm = vm;
|
||||
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0,
|
||||
(void),
|
||||
"Return the current thread's VM.")
|
||||
#define FUNC_NAME s_scm_the_vm
|
||||
{
|
||||
return thread_vm (SCM_I_CURRENT_THREAD);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
||||
|
|
|
@ -68,6 +68,8 @@ SCM_API SCM scm_vm_option_ref (SCM vm, SCM key);
|
|||
SCM_API SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);
|
||||
|
||||
SCM_API SCM scm_vm_version (void);
|
||||
SCM_API SCM scm_thread_vm (SCM t);
|
||||
SCM_API SCM scm_set_thread_vm_x (SCM t, SCM vm);
|
||||
SCM_API SCM scm_the_vm (void);
|
||||
SCM_API SCM scm_vm_p (SCM obj);
|
||||
SCM_API SCM scm_vm_ip (SCM vm);
|
||||
|
|
|
@ -21,7 +21,8 @@
|
|||
(define-module (system vm vm)
|
||||
#:use-module (system vm frame)
|
||||
#:use-module (system vm program)
|
||||
#:export (vm? the-vm make-vm vm-version vm-apply
|
||||
#:export (vm? make-vm vm-version vm-apply
|
||||
the-vm thread-vm set-thread-vm!
|
||||
vm:ip vm:sp vm:fp vm:last-ip
|
||||
|
||||
vm-load vm-option set-vm-option! vm-version
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue