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

Add thread-vm' and set-thread-vm!'.

Browse source 
* 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:
Ludovic Courtès 2010-09-24 15:14:11 +02:00
parent f4a23f910f
commit 271c3d3196
3 changed files with 46 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

49
libguile/vm.c
View file

@ -597,18 +597,53 @@ SCM_DEFINE (scm_vm_version, "vm-version", 0, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM_DEFINE (scm_the_vm, "the-vm", 0, 0, 0, /* Return T's VM. */
(void), static inline SCM
"") thread_vm (scm_i_thread *t)
#define FUNC_NAME s_scm_the_vm
{ {
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 (); t->vm = make_vm ();
return t->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 #undef FUNC_NAME

2
libguile/vm.h
View file

@ -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_option_set_x (SCM vm, SCM key, SCM val);
SCM_API SCM scm_vm_version (void); 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_the_vm (void);
SCM_API SCM scm_vm_p (SCM obj); SCM_API SCM scm_vm_p (SCM obj);
SCM_API SCM scm_vm_ip (SCM vm); SCM_API SCM scm_vm_ip (SCM vm);

3
module/system/vm/vm.scm
View file

@ -21,7 +21,8 @@
(define-module (system vm vm) (define-module (system vm vm)
#:use-module (system vm frame) #:use-module (system vm frame)
#:use-module (system vm program) #: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:ip vm:sp vm:fp vm:last-ip
vm-load vm-option set-vm-option! vm-version vm-load vm-option set-vm-option! vm-version