[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/02: Explicit interrupt handling in VM
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 02/02: Explicit interrupt handling in VM |
|
Date: |
Thu, 17 Nov 2016 21:20:10 +0000 (UTC) |
wingo pushed a commit to branch master
in repository guile.
commit 4985ef13e68c83adf3e83f2c981205806ed9b621
Author: Andy Wingo <address@hidden>
Date: Thu Nov 17 22:13:53 2016 +0100
Explicit interrupt handling in VM
* libguile/foreign.c (CODE, get_foreign_stub_code): Add explicit
handle-interrupts and return-values calls, as foreign-call will fall
through.
* libguile/gsubr.c (A, B, C, AB, AC, BC, ABC, SUBR_STUB_CODE)
(scm_i_primitive_call_ip): Same.
* libguile/vm-engine.c (VM_HANDLE_INTERRUPTS): Inline into
handle-interrupts.
(RETURN_ONE_VALUE, RETURN_VALUE_LIST): Inline into callers, and fall
through instead of returning.
(BR_BINARY, BR_UNARY, BR_ARITHMETIC, BR_U64_ARITHMETIC): Remove
conditional VM_HANDLE_INTERRUPTS, as the compiler already inserted the
handle-interrupts calls if needed.
(vm_engine): Remove VM_HANDLE_INTERRUPTS invocations except in the
handle-interrupts instruction.
---
libguile/foreign.c | 6 ++-
libguile/gsubr.c | 26 ++++++++--
libguile/vm-engine.c | 133 +++++++++++++++++---------------------------------
3 files changed, 70 insertions(+), 95 deletions(-)
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 0992ef4..17a3eed 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -767,7 +767,9 @@ SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure",
3, 0, 0,
#define CODE(nreq) \
SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \
- SCM_PACK_OP_12_12 (foreign_call, 0, 1)
+ SCM_PACK_OP_12_12 (foreign_call, 0, 1), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0)
#define CODE_10(n) \
CODE (n + 0), CODE (n + 1), CODE (n + 2), CODE (n + 3), CODE (n + 4), \
@@ -789,7 +791,7 @@ get_foreign_stub_code (unsigned int nargs)
scm_misc_error ("make-foreign-function", "args >= 100 currently
unimplemented",
SCM_EOL);
- return &foreign_stub_code[nargs * 2];
+ return &foreign_stub_code[nargs * 4];
}
static SCM
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index b456b22..e22d163 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -75,6 +75,8 @@
#define A(nreq) \
SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \
SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0), \
0, \
0
@@ -82,11 +84,15 @@
SCM_PACK_OP_24 (assert_nargs_le, nopt + 1), \
SCM_PACK_OP_24 (alloc_frame, nopt + 1), \
SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0), \
0
#define C() \
SCM_PACK_OP_24 (bind_rest, 1), \
SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0), \
0, \
0
@@ -94,17 +100,23 @@
SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
SCM_PACK_OP_24 (assert_nargs_le, nreq + nopt + 1), \
SCM_PACK_OP_24 (alloc_frame, nreq + nopt + 1), \
- SCM_PACK_OP_24 (subr_call, 0)
+ SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0)
#define AC(nreq) \
SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
SCM_PACK_OP_24 (bind_rest, nreq + 1), \
SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0), \
0
#define BC(nopt) \
SCM_PACK_OP_24 (bind_rest, nopt + 1), \
SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0), \
0, \
0
@@ -112,6 +124,8 @@
SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
SCM_PACK_OP_24 (bind_rest, nreq + nopt + 1), \
SCM_PACK_OP_24 (subr_call, 0), \
+ SCM_PACK_OP_24 (handle_interrupts, 0), \
+ SCM_PACK_OP_24 (return_values, 0), \
0
@@ -212,7 +226,7 @@ static const scm_t_uint32 subr_stub_code[] = {
/* (nargs * nargs) + nopt + rest * (nargs + 1) */
#define SUBR_STUB_CODE(nreq,nopt,rest) \
&subr_stub_code[((nreq + nopt + rest) * (nreq + nopt + rest) \
- + nopt + rest * (nreq + nopt + rest + 1)) * 4]
+ + nopt + rest * (nreq + nopt + rest + 1)) * 6]
static const scm_t_uint32*
get_subr_stub_code (unsigned int nreq, unsigned int nopt, unsigned int rest)
@@ -265,12 +279,16 @@ scm_i_primitive_code_p (const scm_t_uint32 *code)
scm_t_uintptr
scm_i_primitive_call_ip (SCM subr)
{
+ size_t i;
const scm_t_uint32 *code = SCM_PROGRAM_CODE (subr);
- /* A stub is 4 32-bit words long, or 16 bytes. The call will be one
+ /* A stub is 6 32-bit words long, or 24 bytes. The call will be one
instruction, in either the fourth, third, or second word. Return a
byte offset from the entry. */
- return (scm_t_uintptr)(code + (code[3] ? 3 : code[2] ? 2 : 1));
+ for (i = 1; i < 4; i++)
+ if ((code[i] & 0xff) == scm_op_subr_call)
+ return (scm_t_uintptr) (code + i);
+ abort ();
}
SCM
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 4de1971..ac8f32e 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -127,22 +127,6 @@
#define ABORT_CONTINUATION_HOOK() \
RUN_HOOK0 (abort)
-/* TODO: Invoke asyncs without trampolining out to C. That will let us
- preempt computations via an asynchronous interrupt. */
-#define VM_HANDLE_INTERRUPTS \
- do \
- if (SCM_LIKELY (thread->block_asyncs == 0)) \
- { \
- SCM asyncs = scm_atomic_ref_scm (&thread->pending_asyncs); \
- if (SCM_UNLIKELY (!scm_is_null (asyncs))) \
- { \
- SYNC_IP (); \
- scm_async_tick (); \
- CACHE_SP (); \
- } \
- } \
- while (0)
-
@@ -282,38 +266,6 @@
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED))
-#define RETURN_ONE_VALUE(ret) \
- do { \
- SCM val = ret; \
- union scm_vm_stack_element *old_fp; \
- VM_HANDLE_INTERRUPTS; \
- ALLOC_FRAME (2); \
- old_fp = vp->fp; \
- ip = SCM_FRAME_RETURN_ADDRESS (old_fp); \
- vp->fp = SCM_FRAME_DYNAMIC_LINK (old_fp); \
- /* Clear frame. */ \
- old_fp[0].as_scm = SCM_BOOL_F; \
- old_fp[1].as_scm = SCM_BOOL_F; \
- /* Leave proc. */ \
- SP_SET (0, val); \
- POP_CONTINUATION_HOOK (old_fp); \
- NEXT (0); \
- } while (0)
-
-/* While we could generate the list-unrolling code here, it's fine for
- now to just tail-call (apply values vals). */
-#define RETURN_VALUE_LIST(vals_) \
- do { \
- SCM vals = vals_; \
- VM_HANDLE_INTERRUPTS; \
- ALLOC_FRAME (3); \
- SP_SET (2, vm_builtin_apply); \
- SP_SET (1, vm_builtin_values); \
- SP_SET (0, vals); \
- ip = (scm_t_uint32 *) vm_builtin_apply_code; \
- goto op_tail_apply; \
- } while (0)
-
#define BR_NARGS(rel) \
scm_t_uint32 expected; \
UNPACK_24 (op, expected); \
@@ -334,8 +286,6 @@
{ \
scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (2)
@@ -351,8 +301,6 @@
{ \
scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (3)
@@ -373,8 +321,6 @@
{ \
scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (3); \
@@ -389,8 +335,6 @@
{ \
scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (3); \
@@ -409,8 +353,6 @@
{ \
scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (3); \
@@ -587,8 +529,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, proc);
UNPACK_24 (ip[1], nlocals);
- VM_HANDLE_INTERRUPTS;
-
PUSH_CONTINUATION_HOOK ();
old_fp = vp->fp;
@@ -628,8 +568,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (ip[1], nlocals);
label = ip[2];
- VM_HANDLE_INTERRUPTS;
-
PUSH_CONTINUATION_HOOK ();
old_fp = vp->fp;
@@ -658,8 +596,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, nlocals);
- VM_HANDLE_INTERRUPTS;
-
RESET_FRAME (nlocals);
if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0))))
@@ -685,8 +621,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, nlocals);
label = ip[1];
- VM_HANDLE_INTERRUPTS;
-
RESET_FRAME (nlocals);
ip += label;
@@ -709,8 +643,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, from);
- VM_HANDLE_INTERRUPTS;
-
VM_ASSERT (from > 0, abort ());
nlocals = FRAME_LOCALS_COUNT ();
@@ -789,8 +721,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
union scm_vm_stack_element *old_fp;
scm_t_uint32 nlocals;
- VM_HANDLE_INTERRUPTS;
-
UNPACK_24 (op, nlocals);
if (nlocals)
RESET_FRAME (nlocals);
@@ -831,10 +761,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
CACHE_SP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
- /* multiple values returned to continuation */
- RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
+ {
+ SCM vals = scm_struct_ref (ret, SCM_INUM0);
+ long len = scm_ilength (vals);
+ ALLOC_FRAME (1 + len);
+ while (len--)
+ {
+ SP_SET (len, SCM_CAR (vals));
+ vals = SCM_CDR (vals);
+ }
+ NEXT (1);
+ }
else
- RETURN_ONE_VALUE (ret);
+ {
+ ALLOC_FRAME (2);
+ SP_SET (0, ret);
+ NEXT (1);
+ }
}
/* foreign-call cif-idx:12 ptr-idx:12
@@ -864,10 +807,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
CACHE_SP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret)))
- /* multiple values returned to continuation */
- RETURN_VALUE_LIST (scm_struct_ref (ret, SCM_INUM0));
+ {
+ SCM vals = scm_struct_ref (ret, SCM_INUM0);
+ long len = scm_ilength (vals);
+ ALLOC_FRAME (1 + len);
+ while (len--)
+ {
+ SP_SET (len, SCM_CAR (vals));
+ vals = SCM_CDR (vals);
+ }
+ NEXT (1);
+ }
else
- RETURN_ONE_VALUE (ret);
+ {
+ ALLOC_FRAME (2);
+ SP_SET (0, ret);
+ NEXT (1);
+ }
}
/* continuation-call contregs:24
@@ -936,8 +892,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
int i, list_idx, list_len, nlocals;
SCM list;
- VM_HANDLE_INTERRUPTS;
-
nlocals = FRAME_LOCALS_COUNT ();
// At a minimum, there should be apply, f, and the list.
VM_ASSERT (nlocals >= 3, abort ());
@@ -983,8 +937,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
scm_t_dynstack *dynstack;
int first;
- VM_HANDLE_INTERRUPTS;
-
SYNC_IP ();
dynstack = scm_dynstack_capture_all (&thread->dynstack);
vm_cont = scm_i_vm_capture_stack (vp->stack_top,
@@ -1407,8 +1359,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{
scm_t_int32 offset = op;
offset >>= 8; /* Sign-extending shift. */
- if (offset <= 0)
- VM_HANDLE_INTERRUPTS;
NEXT (offset);
}
@@ -3704,8 +3654,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{ \
scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (3); \
@@ -3720,8 +3668,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{ \
scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \
- if (offset <= 0) \
- VM_HANDLE_INTERRUPTS; \
NEXT (offset); \
} \
NEXT (3); \
@@ -3926,7 +3872,18 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
*/
VM_DEFINE_OP (183, handle_interrupts, "handle-interrupts", OP1 (X32))
{
- VM_HANDLE_INTERRUPTS;
+ /* TODO: Invoke asyncs without trampolining out to C. That will
+ let us preempt computations via an asynchronous interrupt. */
+ if (SCM_LIKELY (thread->block_asyncs == 0))
+ {
+ SCM asyncs = scm_atomic_ref_scm (&thread->pending_asyncs);
+ if (SCM_UNLIKELY (!scm_is_null (asyncs)))
+ {
+ SYNC_IP ();
+ scm_async_tick ();
+ CACHE_SP ();
+ }
+ }
NEXT (1);
}
@@ -4045,8 +4002,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
#undef POP_CONTINUATION_HOOK
#undef PUSH_CONTINUATION_HOOK
#undef RETURN
-#undef RETURN_ONE_VALUE
-#undef RETURN_VALUE_LIST
#undef RUN_HOOK
#undef RUN_HOOK0
#undef RUN_HOOK1