mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 09:10:22 +02:00
Code Activity

Explicit interrupt handling in VM

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2016-11-17 22:13:53 +01:00
parent ca74e3fae5
commit 4985ef13e6
3 changed files with 70 additions and 95 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/foreign.c
View file

@ -767,7 +767,9 @@ SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0,
#define CODE(nreq) \ #define CODE(nreq) \
SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \ 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) \ #define CODE_10(n) \
CODE (n + 0), CODE (n + 1), CODE (n + 2), CODE (n + 3), CODE (n + 4), \ 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_misc_error ("make-foreign-function", "args >= 100 currently unimplemented",
SCM_EOL); SCM_EOL);
return &foreign_stub_code[nargs * 2]; return &foreign_stub_code[nargs * 4];
} }
static SCM static SCM

26
libguile/gsubr.c
View file

@ -75,6 +75,8 @@
#define A(nreq) \ #define A(nreq) \
SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \ SCM_PACK_OP_24 (assert_nargs_ee, nreq + 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), \
0, \ 0, \
0 0
@ -82,11 +84,15 @@
SCM_PACK_OP_24 (assert_nargs_le, nopt + 1), \ SCM_PACK_OP_24 (assert_nargs_le, nopt + 1), \
SCM_PACK_OP_24 (alloc_frame, nopt + 1), \ SCM_PACK_OP_24 (alloc_frame, 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), \
0 0
#define C() \ #define C() \
SCM_PACK_OP_24 (bind_rest, 1), \ SCM_PACK_OP_24 (bind_rest, 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), \
0, \ 0, \
0 0
@ -94,17 +100,23 @@
SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \ SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
SCM_PACK_OP_24 (assert_nargs_le, nreq + nopt + 1), \ SCM_PACK_OP_24 (assert_nargs_le, nreq + nopt + 1), \
SCM_PACK_OP_24 (alloc_frame, 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) \ #define AC(nreq) \
SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \ SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
SCM_PACK_OP_24 (bind_rest, nreq + 1), \ SCM_PACK_OP_24 (bind_rest, nreq + 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), \
0 0
#define BC(nopt) \ #define BC(nopt) \
SCM_PACK_OP_24 (bind_rest, nopt + 1), \ SCM_PACK_OP_24 (bind_rest, 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), \
0, \ 0, \
0 0
@ -112,6 +124,8 @@
SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \ SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
SCM_PACK_OP_24 (bind_rest, nreq + nopt + 1), \ SCM_PACK_OP_24 (bind_rest, 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), \
0 0
@ -212,7 +226,7 @@ static const scm_t_uint32 subr_stub_code[] = {
/* (nargs * nargs) + nopt + rest * (nargs + 1) */ /* (nargs * nargs) + nopt + rest * (nargs + 1) */
#define SUBR_STUB_CODE(nreq,nopt,rest) \ #define SUBR_STUB_CODE(nreq,nopt,rest) \
&subr_stub_code[((nreq + nopt + rest) * (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* static const scm_t_uint32*
get_subr_stub_code (unsigned int nreq, unsigned int nopt, unsigned int rest) 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_t_uintptr
scm_i_primitive_call_ip (SCM subr) scm_i_primitive_call_ip (SCM subr)
{ {
size_t i;
const scm_t_uint32 *code = SCM_PROGRAM_CODE (subr); 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 instruction, in either the fourth, third, or second word. Return a
byte offset from the entry. */ 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 SCM

133
libguile/vm-engine.c
View file

@ -127,22 +127,6 @@
#define ABORT_CONTINUATION_HOOK() \ #define ABORT_CONTINUATION_HOOK() \
RUN_HOOK0 (abort) 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_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (!scm_is_eq (VARIABLE_REF (v), SCM_UNDEFINED)) #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) \ #define BR_NARGS(rel) \
scm_t_uint32 expected; \ scm_t_uint32 expected; \
UNPACK_24 (op, expected); \ UNPACK_24 (op, expected); \
@ -334,8 +286,6 @@
{ \ { \
scm_t_int32 offset = ip[1]; \ scm_t_int32 offset = ip[1]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (2) NEXT (2)
@ -351,8 +301,6 @@
{ \ { \
scm_t_int32 offset = ip[2]; \ scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (3) NEXT (3)
@ -373,8 +321,6 @@
{ \ { \
scm_t_int32 offset = ip[2]; \ scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (3); \ NEXT (3); \
@ -389,8 +335,6 @@
{ \ { \
scm_t_int32 offset = ip[2]; \ scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (3); \ NEXT (3); \
@ -409,8 +353,6 @@
{ \ { \
scm_t_int32 offset = ip[2]; \ scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (3); \ NEXT (3); \
@ -587,8 +529,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, proc); UNPACK_24 (op, proc);
UNPACK_24 (ip[1], nlocals); UNPACK_24 (ip[1], nlocals);
VM_HANDLE_INTERRUPTS;
PUSH_CONTINUATION_HOOK (); PUSH_CONTINUATION_HOOK ();
old_fp = vp->fp; old_fp = vp->fp;
@ -628,8 +568,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (ip[1], nlocals); UNPACK_24 (ip[1], nlocals);
label = ip[2]; label = ip[2];
VM_HANDLE_INTERRUPTS;
PUSH_CONTINUATION_HOOK (); PUSH_CONTINUATION_HOOK ();
old_fp = vp->fp; old_fp = vp->fp;
@ -658,8 +596,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, nlocals); UNPACK_24 (op, nlocals);
VM_HANDLE_INTERRUPTS;
RESET_FRAME (nlocals); RESET_FRAME (nlocals);
if (SCM_LIKELY (SCM_PROGRAM_P (FP_REF (0)))) 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); UNPACK_24 (op, nlocals);
label = ip[1]; label = ip[1];
VM_HANDLE_INTERRUPTS;
RESET_FRAME (nlocals); RESET_FRAME (nlocals);
ip += label; ip += label;
@ -709,8 +643,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_24 (op, from); UNPACK_24 (op, from);
VM_HANDLE_INTERRUPTS;
VM_ASSERT (from > 0, abort ()); VM_ASSERT (from > 0, abort ());
nlocals = FRAME_LOCALS_COUNT (); 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; union scm_vm_stack_element *old_fp;
scm_t_uint32 nlocals; scm_t_uint32 nlocals;
VM_HANDLE_INTERRUPTS;
UNPACK_24 (op, nlocals); UNPACK_24 (op, nlocals);
if (nlocals) if (nlocals)
RESET_FRAME (nlocals); RESET_FRAME (nlocals);
@ -831,10 +761,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
CACHE_SP (); CACHE_SP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret))) 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 else
RETURN_ONE_VALUE (ret); {
ALLOC_FRAME (2);
SP_SET (0, ret);
NEXT (1);
}
} }
/* foreign-call cif-idx:12 ptr-idx:12 /* foreign-call cif-idx:12 ptr-idx:12
@ -864,10 +807,23 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
CACHE_SP (); CACHE_SP ();
if (SCM_UNLIKELY (SCM_VALUESP (ret))) 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 else
RETURN_ONE_VALUE (ret); {
ALLOC_FRAME (2);
SP_SET (0, ret);
NEXT (1);
}
} }
/* continuation-call contregs:24 /* 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; int i, list_idx, list_len, nlocals;
SCM list; SCM list;
VM_HANDLE_INTERRUPTS;
nlocals = FRAME_LOCALS_COUNT (); nlocals = FRAME_LOCALS_COUNT ();
// At a minimum, there should be apply, f, and the list. // At a minimum, there should be apply, f, and the list.
VM_ASSERT (nlocals >= 3, abort ()); VM_ASSERT (nlocals >= 3, abort ());
@ -983,8 +937,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
scm_t_dynstack *dynstack; scm_t_dynstack *dynstack;
int first; int first;
VM_HANDLE_INTERRUPTS;
SYNC_IP (); SYNC_IP ();
dynstack = scm_dynstack_capture_all (&thread->dynstack); dynstack = scm_dynstack_capture_all (&thread->dynstack);
vm_cont = scm_i_vm_capture_stack (vp->stack_top, 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; scm_t_int32 offset = op;
offset >>= 8; /* Sign-extending shift. */ offset >>= 8; /* Sign-extending shift. */
if (offset <= 0)
VM_HANDLE_INTERRUPTS;
NEXT (offset); NEXT (offset);
} }
@ -3704,8 +3654,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{ \ { \
scm_t_int32 offset = ip[2]; \ scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (3); \ NEXT (3); \
@ -3720,8 +3668,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{ \ { \
scm_t_int32 offset = ip[2]; \ scm_t_int32 offset = ip[2]; \
offset >>= 8; /* Sign-extending shift. */ \ offset >>= 8; /* Sign-extending shift. */ \
if (offset <= 0) \
VM_HANDLE_INTERRUPTS; \
NEXT (offset); \ NEXT (offset); \
} \ } \
NEXT (3); \ 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_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); NEXT (1);
} }
@ -4045,8 +4002,6 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
#undef POP_CONTINUATION_HOOK #undef POP_CONTINUATION_HOOK
#undef PUSH_CONTINUATION_HOOK #undef PUSH_CONTINUATION_HOOK
#undef RETURN #undef RETURN
#undef RETURN_ONE_VALUE
#undef RETURN_VALUE_LIST
#undef RUN_HOOK #undef RUN_HOOK
#undef RUN_HOOK0 #undef RUN_HOOK0
#undef RUN_HOOK1 #undef RUN_HOOK1