[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-397-ga36c013
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-397-ga36c013 |
|
Date: |
Fri, 03 Aug 2012 13:47:43 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=a36c0137875ff463166d3b8cfbfd6ec8a082a0cf
The branch, wip-rtl has been updated
via a36c0137875ff463166d3b8cfbfd6ec8a082a0cf (commit)
via 9a6c66c4671be065d2fcc37f2f5394e756c4a6a2 (commit)
from 70e1afafb65ab54f8bd66d6df32fa9549f83d28b (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit a36c0137875ff463166d3b8cfbfd6ec8a082a0cf
Author: Andy Wingo <address@hidden>
Date: Fri Aug 3 15:46:59 2012 +0200
remove return_loc, instead put MV returns on the stack
* libguile/frames.h: Update description of how RTL frames work. The
details are commented.
(SCM_FRAME_RTL_MV_RETURN_ADDRESS):
(SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS): New macros.
* libguile/vm.c (rtl_apply, rtl_values): New static RTL programs.
* libguile/vm.c (vm_dispatch_hook):
* libguile/vm-engine.c (RUN_HOOK): Change hook dispatch mechanism to not
have the rest_p arg.
* libguile/vm-engine.c (PUSH_CONTINUATION_HOOK,
ABORT_CONTINUATION_HOOK): Don't take a rest_p.
(vm_engine, rtl_vm_engine):
* libguile/vm-i-system.c: Adapt {ABORT,POP}_CONTINUATION_HOOK
invocations to not have a rest_p.
* libguile/vm-engine.c (rtl_vm_engine): Adapt to new RTL stack frame
format.
commit 9a6c66c4671be065d2fcc37f2f5394e756c4a6a2
Author: Andy Wingo <address@hidden>
Date: Fri Aug 3 15:39:35 2012 +0200
fix compile warning in weak-set.c
* libguile/weak-set.c (move_weak_entry): Fix a compile warning.
-----------------------------------------------------------------------
Summary of changes:
libguile/frames.h | 34 ++--
libguile/vm-engine.c | 588 +++++++++++++++++++++++-------------------------
libguile/vm-i-system.c | 4 +-
libguile/vm.c | 34 +++-
libguile/weak-set.c | 2 +-
5 files changed, 330 insertions(+), 332 deletions(-)
diff --git a/libguile/frames.h b/libguile/frames.h
index 3ba5fd3..9105311 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -104,30 +104,30 @@ struct scm_vm_frame
*/
/* The frame format for the new RTL programs is almost like that for the
- stack-vm programs. They only differ in they mvra slot. The RTL
- programs use that slot to indicate where to return the value(s), and
- how many values are expected. Until we complete the RTL transition,
- here we abuse the above defines to shoehorn the return loc into
- normal VM frames.
+ stack-vm programs. They differ in their handling of MV returns,
+ however. For RTL, every call is an MV call: every call has an MVRA.
+ Unlike the stack-vm programs, the MVRA for RTL programs is computable
+ from the RA -- it's always one word (4 bytes) before the RA.
+
+ Until we completely migrate to the RTL VM, we will also write the
+ MVRA to the stack.
+
+ When an RTL program returns multiple values, it will shuffle them
+ down to start contiguously from slot 0, as for a tail call. This
+ means that when the caller goes to access them, there are 2 or 3
+ empty words between the top of the caller stack and the bottom of the
+ values, corresponding to the frame that was just popped.
*/
-#define SCM_FRAME_RETURN_LOC(fp) \
- ((scm_t_uint32) (scm_t_bits) SCM_FRAME_MV_RETURN_ADDRESS (fp))
-#define SCM_FRAME_SET_RETURN_LOC(fp, loc) \
- SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, (scm_t_uint8 *) (scm_t_bits) (loc))
-
#define SCM_FRAME_RTL_RETURN_ADDRESS(fp) \
((scm_t_uint32 *) SCM_FRAME_RETURN_ADDRESS (fp))
#define SCM_FRAME_SET_RTL_RETURN_ADDRESS(fp, ip) \
SCM_FRAME_SET_RETURN_ADDRESS (fp, (scm_t_uint8 *) (ip))
-#define UNUSED_RETURN_LOC 0
-/* return_loc:24 nreq:7 rest:1 */
-#define SCM_PACK_MV_RETURN_LOC(reg, nreq, has_rest) (((reg) << 8) | (nreq <<
1) | has_rest)
-/* Interestingly, a truncating MV return loc with 0 required args and no
- rest arg is the same as ignoring the return value: the bottom 8 bits
- are 0. */
-#define SCM_PACK_RETURN_LOC(reg) SCM_PACK_MV_RETURN_LOC (reg, 1, 0)
+#define SCM_FRAME_RTL_MV_RETURN_ADDRESS(fp) \
+ ((scm_t_uint32 *) SCM_FRAME_MV_RETURN_ADDRESS (fp))
+#define SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS(fp, ip) \
+ SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, (scm_t_uint8 *) (ip))
/*
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 02c1420..156b373 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -96,30 +96,31 @@ static SCM RTL_VM_NAME (SCM, SCM, SCM*, size_t);
#endif
#if VM_USE_HOOKS
-#define RUN_HOOK(h, args, n, rest_p) \
+#define RUN_HOOK(h, args, n) \
do { \
if (SCM_UNLIKELY (vp->trace_level > 0)) \
{ \
SYNC_REGISTER (); \
- vm_dispatch_hook (vm, h, args, n, rest_p); \
+ vm_dispatch_hook (vm, h, args, n); \
} \
} while (0)
#else
-#define RUN_HOOK(h, args, n, rest_p)
+#define RUN_HOOK(h, args, n)
#endif
+#define RUN_HOOK0(h) RUN_HOOK(h, NULL, 0)
#define APPLY_HOOK() \
- RUN_HOOK (SCM_VM_APPLY_HOOK, NULL, 0, 0)
+ RUN_HOOK0 (SCM_VM_APPLY_HOOK)
#define PUSH_CONTINUATION_HOOK() \
- RUN_HOOK (SCM_VM_PUSH_CONTINUATION_HOOK, NULL, 0, 0)
-#define POP_CONTINUATION_HOOK(vals, n, rest_p) \
- RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n, rest_p)
+ RUN_HOOK0 (SCM_VM_PUSH_CONTINUATION_HOOK)
+#define POP_CONTINUATION_HOOK(vals, n) \
+ RUN_HOOK (SCM_VM_POP_CONTINUATION_HOOK, vals, n)
#define NEXT_HOOK() \
- RUN_HOOK (SCM_VM_NEXT_HOOK, NULL, 0, 0)
-#define ABORT_CONTINUATION_HOOK(vals, n, rest_p) \
- RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n, rest_p)
+ RUN_HOOK0 (SCM_VM_NEXT_HOOK)
+#define ABORT_CONTINUATION_HOOK(vals, n) \
+ RUN_HOOK (SCM_VM_ABORT_CONTINUATION_HOOK, vals, n)
#define RESTORE_CONTINUATION_HOOK() \
- RUN_HOOK (SCM_VM_RESTORE_CONTINUATION_HOOK, NULL, 0, 0)
+ RUN_HOOK0 (SCM_VM_RESTORE_CONTINUATION_HOOK)
#define VM_HANDLE_INTERRUPTS \
SCM_ASYNC_TICK_WITH_CODE (current_thread, SYNC_REGISTER ())
@@ -370,7 +371,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
CACHE_PROGRAM ();
/* The stack contains the values returned to this continuation,
along with a number-of-values marker -- like an MV return. */
- ABORT_CONTINUATION_HOOK (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp), 0);
+ ABORT_CONTINUATION_HOOK (sp - SCM_I_INUM (*sp), SCM_I_INUM (*sp));
NEXT;
}
@@ -583,9 +584,6 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
/* Restore registers after returning from a frame. */
#define RESTORE_FRAME() \
do { \
- ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \
- vp->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; \
- fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
} while (0)
@@ -628,6 +626,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
} \
while (0)
# define VM_DEFINE_OP(opcode, tag, name, meta) \
+ op_##tag: \
case opcode:
#endif
@@ -641,65 +640,30 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
#define RETURN_ONE_VALUE(ret) \
do { \
- scm_t_uint32 ret_loc = SCM_FRAME_RETURN_LOC (fp) ; \
+ SCM val = ret; \
+ SCM *sp = SCM_FRAME_LOWER_ADDRESS (fp); \
VM_HANDLE_INTERRUPTS; \
- if (ret_loc) \
- { \
- SCM *new_fp = SCM_FRAME_DYNAMIC_LINK (fp); \
- scm_t_uint32 idx = ret_loc >> 8; \
- scm_t_uint8 nreq = (ret_loc & 0xff) >> 1; \
- scm_t_uint8 has_rest = ret_loc & 0x1; \
- if (SCM_LIKELY (nreq == 1)) \
- { \
- new_fp[idx] = ret; \
- if (has_rest) \
- new_fp[idx + 1] = SCM_EOL; \
- POP_CONTINUATION_HOOK (&new_fp[idx], 1, 0); \
- } \
- else if (SCM_UNLIKELY (nreq == 0 && has_rest)) \
- { \
- SYNC_BEFORE_GC (); \
- new_fp[idx] = scm_cons (ret, SCM_EOL); \
- POP_CONTINUATION_HOOK (&new_fp[idx], 0, 1); \
- } \
- else \
- { \
- SYNC_REGISTER (); \
- vm_error_not_enough_values (); \
- } \
- } \
- /* Restore registers */ \
- RESTORE_FRAME (); \
+ ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \
+ vp->sp = sp; \
+ fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
+ *sp = val; \
+ POP_CONTINUATION_HOOK (sp, 1); \
NEXT (0); \
} while (0)
-#define RETURN_VALUE_LIST(tail_) \
+/* 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 *new_fp = SCM_FRAME_DYNAMIC_LINK (fp); \
- scm_t_uint32 ret_loc = SCM_FRAME_RETURN_LOC (fp) ; \
- scm_t_uint32 idx = ret_loc >> 8; \
- scm_t_uint8 nreq = (ret_loc & 0xff) >> 1; \
- scm_t_uint8 has_rest = ret_loc & 0x1; \
+ SCM vals = vals_; \
VM_HANDLE_INTERRUPTS; \
- if (nreq) \
- { \
- SCM tail = tail_; \
- VM_ASSERT (scm_ilength (tail) >= nreq, \
- vm_error_not_enough_values ()); \
- while (nreq--) \
- { \
- new_fp[idx++] = SCM_CAR (tail); \
- tail = SCM_CDR (tail); \
- } \
- if (has_rest) \
- new_fp[idx] = tail; \
- } \
- else if (has_rest) \
- new_fp[idx] = tail_; \
- POP_CONTINUATION_HOOK (&new_fp[idx], nreq, has_rest); \
- /* Restore registers */ \
- RESTORE_FRAME (); \
- NEXT (0); \
+ fp[-1] = rtl_apply; \
+ fp[0] = rtl_values; \
+ fp[1] = vals; \
+ nargs = 2; \
+ RESET_FRAME (nargs); \
+ ip = (scm_t_uint32 *) rtl_apply_code; \
+ goto op_apply; \
} while (0)
#define BR_NARGS(rel) \
@@ -873,7 +837,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
to pull all our state back from the ip/fp/sp.
*/
CACHE_REGISTER ();
- ABORT_CONTINUATION_HOOK (fp, vp->sp + 1 - fp, 0);
+ ABORT_CONTINUATION_HOOK (fp, vp->sp + 1 - fp);
NEXT (0);
}
@@ -886,12 +850,12 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
{
SCM *base;
- /* Check that we have enough space: 5 words for the boot
+ /* Check that we have enough space: 4 words for the boot
continuation, 4 + nargs for the procedure application, and 4 for
setting up a new frame. */
base = vp->sp + 1;
nargs = nargs_;
- CHECK_OVERFLOW (vp->sp + 5 + 4 + nargs + 4);
+ CHECK_OVERFLOW (vp->sp + 4 + 4 + nargs + 4);
/* Since it's possible to receive the arguments on the stack itself,
and indeed the regular VM invokes us that way, shuffle up the
@@ -899,25 +863,26 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
{
int i;
for (i = nargs - 1; i >= 0; i--)
- base[9 + i] = argv[i];
+ base[8 + i] = argv[i];
}
/* Initial frame, saving previous fp and ip, with the boot
continuation. */
base[0] = SCM_PACK (fp); /* dynamic link */
- base[1] = SCM_PACK (UNUSED_RETURN_LOC); /* the boot continuation does not
return to scheme */
+ base[1] = SCM_PACK (0); /* the boot continuation does not return to scheme
*/
base[2] = SCM_PACK (ip); /* ra */
base[3] = rtl_boot_continuation;
- base[4] = SCM_UNDEFINED; /* space for the return value */
fp = &base[4];
- ip = SCM_RTL_PROGRAM_CODE (rtl_boot_continuation);
+ ip = rtl_boot_single_value_continuation_code;
+ if (ip - 1 != rtl_boot_multiple_value_continuation_code)
+ abort();
/* MV-call frame, function & arguments */
- base[5] = SCM_PACK (fp); /* dynamic link */
- base[6] = SCM_PACK (SCM_PACK_MV_RETURN_LOC (0, 0, 1)); /* collect all
return values into a list, store in local 0 */
- base[7] = SCM_PACK (ip); /* ra */
- base[8] = program;
- fp = vp->fp = &base[9];
+ base[4] = SCM_PACK (fp); /* dynamic link */
+ base[5] = SCM_PACK (ip - 1); /* in RTL programs, MVRA precedes RA by one */
+ base[6] = SCM_PACK (ip); /* ra */
+ base[7] = program;
+ fp = vp->fp = &base[8];
RESET_FRAME (nargs);
}
@@ -974,78 +939,114 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Call and return
*/
- /* halt src:24
+ /* halt _:24
*
- * Bring the VM to a halt, returning the single value from register
- * SRC.
+ * Bring the VM to a halt, returning the single value from r0.
*/
- VM_DEFINE_OP (0, halt, "halt", OP1 (U8_U24))
+ VM_DEFINE_OP (0, halt, "halt", OP1 (U8_X24))
{
- scm_t_uint32 src;
- SCM ret;
-
- SCM_UNPACK_RTL_24 (op, src);
+ SCM ret = LOCAL_REF (0);
- ret = LOCAL_REF (src);
-
- RESTORE_FRAME ();
- SYNC_ALL ();
+ vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
+ vp->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+ vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
return ret;
}
- /* halt/values src:24
+ /* halt/values _:24
*
- * Bring the VM to a halt, returning the values collected in the list in
- * SRC.
+ * Bring the VM to a halt, returning all the values on the stack.
*/
- VM_DEFINE_OP (1, halt_values, "halt/values", OP1 (U8_U24))
+ VM_DEFINE_OP (1, halt_values, "halt/values", OP1 (U8_X24))
{
- scm_t_uint32 src;
- SCM ret;
+ scm_t_ptrdiff n;
+ SCM *base;
+ SCM ret = SCM_EOL;
- SCM_UNPACK_RTL_24 (op, src);
+ SYNC_BEFORE_GC();
- ret = scm_values (LOCAL_REF (src));
+ base = fp + 4;
+ n = vp->sp + 1 - base;
+ while (n--)
+ ret = scm_cons (base[n], ret);
- RESTORE_FRAME ();
- SYNC_ALL ();
+ vp->ip = SCM_FRAME_RETURN_ADDRESS (fp);
+ vp->sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
+ vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
- return ret;
+ return scm_values (ret);
}
- /* call from:24 return-loc:32 _:8 proc:24 _:8 nargs:24 arg0:24 0:8 ...
+ /* call from:24 _:8 proc:24 _:8 nargs:24 arg0:24 0:8 ...
*
* Call a procedure. Push a call frame on at FROM, saving the return
- * address and the fp, and arranging for the result to be placed in
- * RETURN-LOC, which itself is an encoding of a destination register
- * and the expected number of returned values. Parse out NARGS, and
- * push the procedure and arguments. All arguments except for
- * RETURN-LOC are 24-bit values. FROM, PROC, and NARGS are in the
- * upper 24 bits of the words. The ARGN... are in the lower 24 bits,
- * with the upper 8 bits being 0.
+ * address and the fp. Parse out NARGS, and push the procedure and
+ * arguments. All arguments except for RETURN-LOC are 24-bit values.
+ * FROM, PROC, and NARGS are in the upper 24 bits of the words. The
+ * ARGN... are in the lower 24 bits, with the upper 8 bits being 0.
+ *
+ * The MVRA of the new frame is set to point to the next instruction
+ * after the end of the `call' instruction. The word following that
+ * is the RA.
*/
- VM_DEFINE_OP (2, call, "call", OP4 (U8_U24, U32, X8_U24, X8_R24))
+ VM_DEFINE_OP (2, call, "call", OP3 (U8_U24, X8_U24, X8_R24))
{
- scm_t_uint32 from, return_loc, proc, n;
+ scm_t_uint32 from, proc, n;
SCM *old_fp = fp;
SCM_UNPACK_RTL_24 (op, from);
- return_loc = ip[1];
- SCM_UNPACK_RTL_24 (ip[2], proc);
- SCM_UNPACK_RTL_24 (ip[3], nargs);
+ SCM_UNPACK_RTL_24 (ip[1], proc);
+ SCM_UNPACK_RTL_24 (ip[2], nargs);
VM_HANDLE_INTERRUPTS;
fp = vp->fp = old_fp + from + 4;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
- SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 5 + nargs);
- SCM_FRAME_SET_RETURN_LOC (fp, return_loc);
+ SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS (fp, ip + 3 + nargs);
+ SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 4 + nargs);
fp[-1] = old_fp[proc];
ALLOC_FRAME (nargs);
for (n = 0; n < nargs; n++)
- LOCAL_SET (n, old_fp[ip[4 + n]]);
+ LOCAL_SET (n, old_fp[ip[3 + n]]);
+
+ PUSH_CONTINUATION_HOOK ();
+ APPLY_HOOK ();
+
+ if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ goto apply;
+
+ ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ NEXT (0);
+ }
+
+ /* call/values from:24 _:8 proc:24
+ *
+ * Call a procedure, with the values already pushed above a call frame
+ * at FROM. The stack pointer is used to set the nargs. This
+ * instruction is used to handle MV returns in the case that we can't
+ * inline the handler.
+ *
+ * As with `call', the next instruction after the call/values will be
+ * the MVRA, and the word after that instruction is the RA.
+ */
+ VM_DEFINE_OP (3, call_values, "call/values", OP2 (U8_U24, X8_U24))
+ {
+ scm_t_uint32 from, proc;
+ SCM *old_fp = fp;
+
+ SCM_UNPACK_RTL_24 (op, from);
+ SCM_UNPACK_RTL_24 (ip[1], proc);
+
+ VM_HANDLE_INTERRUPTS;
+
+ fp = vp->fp = old_fp + from + 4;
+ SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
+ SCM_FRAME_SET_RTL_MV_RETURN_ADDRESS (fp, ip + 2 + nargs);
+ SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 3 + nargs);
+ fp[-1] = old_fp[proc];
+ nargs = vp->sp - fp;
PUSH_CONTINUATION_HOOK ();
APPLY_HOOK ();
@@ -1062,7 +1063,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Tail-call a procedure. Requires that all of the arguments have
* already been shuffled into position.
*/
- VM_DEFINE_OP (3, tail_call, "tail-call", OP2 (U8_U24, X8_U24))
+ VM_DEFINE_OP (4, tail_call, "tail-call", OP2 (U8_U24, X8_U24))
{
scm_t_uint32 proc;
@@ -1089,51 +1090,26 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Return a value.
*/
- VM_DEFINE_OP (4, return, "return", OP1 (U8_U24))
+ VM_DEFINE_OP (5, return, "return", OP1 (U8_U24))
{
scm_t_uint32 src;
SCM_UNPACK_RTL_24 (op, src);
RETURN_ONE_VALUE (LOCAL_REF (src));
}
- /* return-values nvalues:24 val0:24 0:8 val1:24 0:8 ...
+ /* return-values nvalues:24
*
- * Return a number of values from a call frame. This opcode corresponds
- * to an application of `values' in tail position. The values VAL0,
- * VAL1, etc are 24-bit values, in the lower 24 bits of their words.
- * The upper 8 bits are 0.
+ * Return a number of values from a call frame. This opcode
+ * corresponds to an application of `values' in tail position. As
+ * with tail calls, we expect that the NVALUES values have already
+ * been shuffled down to a contiguous array starting ast slot 0.
*/
- VM_DEFINE_OP (5, return_values, "return/values", OP1 (U8_R24))
+ VM_DEFINE_OP (6, return_values, "return/values", OP1 (U8_R24))
{
- scm_t_uint32 nvalues, n;
- SCM *new_fp = SCM_FRAME_DYNAMIC_LINK (fp);
- scm_t_uint32 ret_loc = SCM_FRAME_RETURN_LOC (fp) ;
- scm_t_uint32 idx = ret_loc >> 8;
- scm_t_uint8 nreq = (ret_loc & 0xff) >> 1;
- scm_t_uint8 has_rest = ret_loc & 0x1;
-
- SCM_UNPACK_RTL_24 (op, nvalues);
-
- VM_HANDLE_INTERRUPTS;
-
- VM_ASSERT (nvalues >= nreq, vm_error_not_enough_values ());
-
- for (n = 0; n < nreq; n++)
- new_fp[idx + n] = fp[ip[n+1]];
-
- if (has_rest)
- {
- SCM tail = SCM_EOL;
- for (n = nvalues; n > nreq; n--)
- tail = scm_cons (fp[ip[n]], tail);
- new_fp[idx + nreq] = tail;
- }
-
- POP_CONTINUATION_HOOK (new_fp, nreq, has_rest);
-
- RESTORE_FRAME ();
-
- NEXT (0);
+ SCM_UNPACK_RTL_24 (op, nargs);
+ RESET_FRAME(nargs);
+ fp[-1] = rtl_values;
+ goto op_values;
}
@@ -1151,7 +1127,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* is part of the trampolines created in gsubr.c, and is not generated
* by the compiler.
*/
- VM_DEFINE_OP (6, subr_call, "subr-call", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (7, subr_call, "subr-call", OP1 (U8_U12_U12))
{
scm_t_uint16 nargs, ptr_idx;
SCM pointer, ret;
@@ -1221,7 +1197,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* This instruction is part of the trampolines created by the FFI, and
* is not generated by the compiler.
*/
- VM_DEFINE_OP (7, foreign_call, "foreign-call", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (8, foreign_call, "foreign-call", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 cif_idx, ptr_idx;
SCM cif, pointer, ret;
@@ -1254,7 +1230,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* implementation of undelimited continuations, and is not generated by
* the compiler.
*/
- VM_DEFINE_OP (8, continuation_call, "continuation-call", OP2 (U8_U24,
X8_U24))
+ VM_DEFINE_OP (9, continuation_call, "continuation-call", OP2 (U8_U24,
X8_U24))
{
SCM contregs;
scm_t_uint32 contregs_idx;
@@ -1283,7 +1259,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* instruction is part of the implementation of partial continuations,
* and is not generated by the compiler.
*/
- VM_DEFINE_OP (9, partial_cont_call, "partial-cont-call", OP2 (U8_U24,
X8_U24))
+ VM_DEFINE_OP (10, partial_cont_call, "partial-cont-call", OP2 (U8_U24,
X8_U24))
{
SCM vmcont;
scm_t_uint32 cont_idx;
@@ -1308,7 +1284,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* arguments. This instruction is part of the implementation of
* `apply', and is not generated by the compiler.
*/
- VM_DEFINE_OP (10, apply, "apply", OP1 (U8_X24))
+ VM_DEFINE_OP (11, apply, "apply", OP1 (U8_X24))
{
int i, list_idx, list_len;
SCM list;
@@ -1351,7 +1327,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* local slot 0 to it. This instruction is part of the implementation
* of `call/cc', and is not generated by the compiler.
*/
- VM_DEFINE_OP (11, call_cc, "call/cc", OP1 (U8_X24))
+ VM_DEFINE_OP (12, call_cc, "call/cc", OP1 (U8_X24))
#if 0
{
SCM vm_cont, cont;
@@ -1393,34 +1369,24 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* This instruction is part of the implementation of
* `values', and is not generated by the compiler.
*/
- VM_DEFINE_OP (12, values, "values", OP1 (U8_X24))
+ VM_DEFINE_OP (13, values, "values", OP1 (U8_X24))
{
- scm_t_uint32 nvalues, n;
- SCM *new_fp = SCM_FRAME_DYNAMIC_LINK (fp);
- scm_t_uint32 ret_loc = SCM_FRAME_RETURN_LOC (fp) ;
- scm_t_uint32 idx = ret_loc >> 8;
- scm_t_uint8 nreq = (ret_loc & 0xff) >> 1;
- scm_t_uint8 has_rest = ret_loc & 0x1;
+ SCM *base = fp;
- VM_HANDLE_INTERRUPTS;
+ /* We don't do much; it's the caller that's responsible for
+ shuffling values and resetting the stack. */
- nvalues = nargs;
- VM_ASSERT (nvalues >= nreq, vm_error_not_enough_values ());
-
- for (n = 0; n < nreq; n++)
- new_fp[idx + n] = fp[n];
-
- if (has_rest)
- {
- SCM tail = SCM_EOL;
- for (n = nvalues; n > nreq; n--)
- tail = scm_cons (fp[n], tail);
- new_fp[idx + nreq] = tail;
- }
+ VM_HANDLE_INTERRUPTS;
+ ip = SCM_FRAME_RTL_MV_RETURN_ADDRESS (fp);
+ fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
- POP_CONTINUATION_HOOK (new_fp, nreq, has_rest);
+ /* Clear stack frame. */
+ base[-1] = SCM_BOOL_F;
+ base[-2] = SCM_BOOL_F;
+ base[-3] = SCM_BOOL_F;
+ base[-4] = SCM_BOOL_F;
- RESTORE_FRAME ();
+ POP_CONTINUATION_HOOK (base, nargs);
NEXT (0);
}
@@ -1440,15 +1406,15 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* than EXPECTED, respectively, add OFFSET, a signed 24-bit number, to
* the current instruction pointer.
*/
- VM_DEFINE_OP (13, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
+ VM_DEFINE_OP (14, br_if_nargs_ne, "br-if-nargs-ne", OP2 (U8_U24, X8_L24))
{
BR_NARGS (!=);
}
- VM_DEFINE_OP (14, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
+ VM_DEFINE_OP (15, br_if_nargs_lt, "br-if-nargs-lt", OP2 (U8_U24, X8_L24))
{
BR_NARGS (<);
}
- VM_DEFINE_OP (15, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
+ VM_DEFINE_OP (16, br_if_nargs_gt, "br-if-nargs-gt", OP2 (U8_U24, X8_L24))
{
BR_NARGS (>);
}
@@ -1459,14 +1425,14 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the number of actual arguments is not == or >= to EXPECTED,
* respectively, signal an error.
*/
- VM_DEFINE_OP (16, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
+ VM_DEFINE_OP (17, assert_nargs_ee, "assert-nargs-ee", OP1 (U8_U24))
{
scm_t_uint32 expected;
SCM_UNPACK_RTL_24 (op, expected);
VM_ASSERT (nargs == expected, vm_error_wrong_num_args (vm,
SCM_FRAME_PROGRAM (fp), nargs));
NEXT (1);
}
- VM_DEFINE_OP (17, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
+ VM_DEFINE_OP (18, assert_nargs_ge, "assert-nargs-ge", OP1 (U8_U24))
{
scm_t_uint32 expected;
SCM_UNPACK_RTL_24 (op, expected);
@@ -1480,7 +1446,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* setting them all to SCM_UNDEFINED, except those nargs values that
* were passed as arguments.
*/
- VM_DEFINE_OP (18, reserve_locals, "reserve-locals", OP1 (U8_U24))
+ VM_DEFINE_OP (19, reserve_locals, "reserve-locals", OP1 (U8_U24))
{
scm_t_uint32 nlocals;
SCM_UNPACK_RTL_24 (op, nlocals);
@@ -1497,7 +1463,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Equivalent to a sequence of assert-nargs-ee and reserve-locals. The
* number of locals reserved is EXPECTED + NLOCALS.
*/
- VM_DEFINE_OP (19, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1
(U8_U12_U12))
+ VM_DEFINE_OP (20, assert_nargs_ee_locals, "assert-nargs-ee/locals", OP1
(U8_U12_U12))
{
scm_t_uint16 expected, nlocals;
SCM_UNPACK_RTL_12_12 (op, expected, nlocals);
@@ -1522,7 +1488,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* A macro-mega-instruction.
*/
- VM_DEFINE_OP (20, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24,
N32))
+ VM_DEFINE_OP (21, bind_kwargs, "bind-kwargs", OP4 (U8_U24, U8_U24, X8_U24,
N32))
{
scm_t_uint32 nreq, nreq_and_opt, ntotal, npositional, nkw, n;
scm_t_int32 kw_offset;
@@ -1604,7 +1570,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Collect any arguments at or above DST into a list, and store that
* list at DST.
*/
- VM_DEFINE_OP (21, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
+ VM_DEFINE_OP (22, bind_rest, "bind-rest", OP1 (U8_U24) | OP_DST)
{
scm_t_uint32 dst;
SCM rest = SCM_EOL;
@@ -1624,6 +1590,22 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
NEXT (1);
}
+ /* drop-values nlocals:24
+ *
+ * Reset the stack pointer to only have space for NLOCALS values.
+ * Used after extracting values from an MV return.
+ */
+ VM_DEFINE_OP (23, drop_values, "drop-values", OP1 (U8_U24))
+ {
+ scm_t_bits nlocals;
+
+ SCM_UNPACK_RTL_24 (op, nlocals);
+
+ RESET_FRAME(nlocals);
+
+ NEXT (1);
+ }
+
@@ -1636,7 +1618,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Add OFFSET, a signed 24-bit number, to the current instruction
* pointer.
*/
- VM_DEFINE_OP (22, br, "br", OP1 (U8_L24))
+ VM_DEFINE_OP (24, br, "br", OP1 (U8_L24))
{
scm_t_int32 offset = op;
offset >>= 8; /* Sign-extending shift. */
@@ -1648,7 +1630,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST is true for the purposes of Scheme, add
* OFFSET, a signed 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (23, br_if_true, "br-if-true", OP2 (U8_U24, U1_X7_L24))
+ VM_DEFINE_OP (25, br_if_true, "br-if-true", OP2 (U8_U24, U1_X7_L24))
{
BR_UNARY (x, scm_is_true (x));
}
@@ -1658,7 +1640,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST is the end-of-list or Lisp nil, add OFFSET, a
* signed 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (24, br_if_null, "br-if-null", OP2 (U8_U24, U1_X7_L24))
+ VM_DEFINE_OP (26, br_if_null, "br-if-null", OP2 (U8_U24, U1_X7_L24))
{
BR_UNARY (x, scm_is_null (x));
}
@@ -1668,7 +1650,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST is false to Lisp, add OFFSET, a signed 24-bit
* number, to the current instruction pointer.
*/
- VM_DEFINE_OP (25, br_if_nil, "br-if-nil", OP2 (U8_U24, U1_X7_L24))
+ VM_DEFINE_OP (27, br_if_nil, "br-if-nil", OP2 (U8_U24, U1_X7_L24))
{
BR_UNARY (x, scm_is_lisp_false (x));
}
@@ -1678,7 +1660,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST is a pair, add OFFSET, a signed 24-bit number,
* to the current instruction pointer.
*/
- VM_DEFINE_OP (26, br_if_pair, "br-if-pair", OP2 (U8_U24, U1_X7_L24))
+ VM_DEFINE_OP (28, br_if_pair, "br-if-pair", OP2 (U8_U24, U1_X7_L24))
{
BR_UNARY (x, scm_is_pair (x));
}
@@ -1688,7 +1670,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST is a struct, add OFFSET, a signed 24-bit
* number, to the current instruction pointer.
*/
- VM_DEFINE_OP (27, br_if_struct, "br-if-struct", OP2 (U8_U24, U1_X7_L24))
+ VM_DEFINE_OP (29, br_if_struct, "br-if-struct", OP2 (U8_U24, U1_X7_L24))
{
BR_UNARY (x, SCM_STRUCTP (x));
}
@@ -1698,7 +1680,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST is a char, add OFFSET, a signed 24-bit number,
* to the current instruction pointer.
*/
- VM_DEFINE_OP (28, br_if_char, "br-if-char", OP2 (U8_U24, U1_X7_L24))
+ VM_DEFINE_OP (30, br_if_char, "br-if-char", OP2 (U8_U24, U1_X7_L24))
{
BR_UNARY (x, SCM_CHARP (x));
}
@@ -1708,7 +1690,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in TEST has the TC7 given in the second word, add
* OFFSET, a signed 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (29, br_if_tc7, "br-if-tc7", OP2 (U8_U24, U1_U7_L24))
+ VM_DEFINE_OP (31, br_if_tc7, "br-if-tc7", OP2 (U8_U24, U1_U7_L24))
{
BR_UNARY (x, SCM_HAS_TYP7 (x, (ip[1] >> 1) & 0x7f));
}
@@ -1718,7 +1700,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is eq? to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (30, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, U1_X7_L24))
+ VM_DEFINE_OP (32, br_if_eq, "br-if-eq", OP2 (U8_U12_U12, U1_X7_L24))
{
BR_BINARY (x, y, scm_is_eq (x, y));
}
@@ -1728,7 +1710,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is eqv? to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (31, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, U1_X7_L24))
+ VM_DEFINE_OP (33, br_if_eqv, "br-if-eqv", OP2 (U8_U12_U12, U1_X7_L24))
{
BR_BINARY (x, y,
scm_is_eq (x, y)
@@ -1742,7 +1724,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* 24-bit number, to the current instruction pointer.
*/
// FIXME: should sync_ip before calling out?
- VM_DEFINE_OP (32, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, U1_X7_L24))
+ VM_DEFINE_OP (34, br_if_equal, "br-if-equal", OP2 (U8_U12_U12, U1_X7_L24))
{
BR_BINARY (x, y,
scm_is_eq (x, y)
@@ -1755,7 +1737,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is = to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (33, br_if_ee, "br-if-=", OP2 (U8_U12_U12, X8_L24))
+ VM_DEFINE_OP (35, br_if_ee, "br-if-=", OP2 (U8_U12_U12, X8_L24))
{
BR_ARITHMETIC (==, scm_num_eq_p);
}
@@ -1765,7 +1747,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is < to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (34, br_if_lt, "br-if-<", OP2 (U8_U12_U12, X8_L24))
+ VM_DEFINE_OP (36, br_if_lt, "br-if-<", OP2 (U8_U12_U12, X8_L24))
{
BR_ARITHMETIC (<, scm_less_p);
}
@@ -1775,7 +1757,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is <= to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (35, br_if_le, "br-if-<=", OP2 (U8_U12_U12, X8_L24))
+ VM_DEFINE_OP (37, br_if_le, "br-if-<=", OP2 (U8_U12_U12, X8_L24))
{
BR_ARITHMETIC (<=, scm_leq_p);
}
@@ -1785,7 +1767,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is > to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (36, br_if_gt, "br-if->", OP2 (U8_U12_U12, X8_L24))
+ VM_DEFINE_OP (38, br_if_gt, "br-if->", OP2 (U8_U12_U12, X8_L24))
{
BR_ARITHMETIC (>, scm_gr_p);
}
@@ -1795,7 +1777,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* If the value in A is >= to the value in B, add OFFSET, a signed
* 24-bit number, to the current instruction pointer.
*/
- VM_DEFINE_OP (37, br_if_ge, "br-if->=", OP2 (U8_U12_U12, X8_L24))
+ VM_DEFINE_OP (39, br_if_ge, "br-if->=", OP2 (U8_U12_U12, X8_L24))
{
BR_ARITHMETIC (>=, scm_geq_p);
}
@@ -1811,7 +1793,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Copy a value from one local slot to another.
*/
- VM_DEFINE_OP (38, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (40, mov, "mov", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst;
scm_t_uint16 src;
@@ -1826,7 +1808,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Copy a value from one local slot to another.
*/
- VM_DEFINE_OP (39, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
+ VM_DEFINE_OP (41, long_mov, "long-mov", OP2 (U8_U24, X8_U24) | OP_DST)
{
scm_t_uint32 dst;
scm_t_uint32 src;
@@ -1842,7 +1824,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Create a new variable holding SRC, and place it in DST.
*/
- VM_DEFINE_OP (40, box, "box", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (42, box, "box", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
SCM_UNPACK_RTL_12_12 (op, dst, src);
@@ -1856,7 +1838,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* general implementation of `letrec', in those cases that fix-letrec
* fails to fix.
*/
- VM_DEFINE_OP (41, empty_box, "empty-box", OP1 (U8_U24) | OP_DST)
+ VM_DEFINE_OP (43, empty_box, "empty-box", OP1 (U8_U24) | OP_DST)
{
scm_t_uint32 dst;
SCM_UNPACK_RTL_24 (op, dst);
@@ -1869,7 +1851,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Unpack the variable at SRC into DST, asserting that the variable is
* actually bound.
*/
- VM_DEFINE_OP (42, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (44, box_ref, "box-ref", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
SCM var;
@@ -1892,7 +1874,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the contents of the variable at DST to SET.
*/
- VM_DEFINE_OP (43, box_set, "box-set!", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (45, box_set, "box-set!", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
SCM var;
@@ -1907,7 +1889,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Load free variable SRC into local slot DST.
*/
- VM_DEFINE_OP (44, free_ref, "free-ref", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (46, free_ref, "free-ref", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
SCM_UNPACK_RTL_12_12 (op, dst, src);
@@ -1923,7 +1905,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* signed 32-bit integer. The registers for the NFREE free variables
* follow.
*/
- VM_DEFINE_OP (45, make_closure, "make-closure", OP3 (U8_U24, L32, X8_R24) |
OP_DST)
+ VM_DEFINE_OP (47, make_closure, "make-closure", OP3 (U8_U24, L32, X8_R24) |
OP_DST)
{
scm_t_uint32 dst, nfree, n;
scm_t_int32 offset;
@@ -1950,7 +1932,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* free variables to point to each other. NFREE and the locals FREE0...
* are as in make-closure.
*/
- VM_DEFINE_OP (46, fix_closure, "fix-closure", OP2 (U8_U24, X8_R24))
+ VM_DEFINE_OP (48, fix_closure, "fix-closure", OP2 (U8_U24, X8_R24))
{
scm_t_uint32 dst, nfree, n;
SCM closure;
@@ -1975,7 +1957,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Make an immediate whose low bits are LOW-BITS, and whose top bits are
* 0.
*/
- VM_DEFINE_OP (47, make_short_immediate, "make-short-immediate", OP1
(U8_U8_I16) | OP_DST)
+ VM_DEFINE_OP (49, make_short_immediate, "make-short-immediate", OP1
(U8_U8_I16) | OP_DST)
{
scm_t_uint8 dst;
scm_t_bits val;
@@ -1990,7 +1972,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Make an immediate whose low bits are LOW-BITS, and whose top bits are
* 0.
*/
- VM_DEFINE_OP (48, make_long_immediate, "make-long-immediate", OP2 (U8_U24,
I32))
+ VM_DEFINE_OP (50, make_long_immediate, "make-long-immediate", OP2 (U8_U24,
I32))
{
scm_t_uint8 dst;
scm_t_bits val;
@@ -2005,7 +1987,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Make an immediate with HIGH-BITS and LOW-BITS.
*/
- VM_DEFINE_OP (49, make_long_long_immediate, "make-long-long-immediate", OP3
(U8_U24, A32, B32) | OP_DST)
+ VM_DEFINE_OP (51, make_long_long_immediate, "make-long-long-immediate", OP3
(U8_U24, A32, B32) | OP_DST)
{
scm_t_uint8 dst;
scm_t_bits val;
@@ -2036,7 +2018,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Whether the object is mutable or immutable depends on where it was
* allocated by the compiler, and loaded by the loader.
*/
- VM_DEFINE_OP (50, make_non_immediate, "make-non-immediate", OP2 (U8_U24,
N32) | OP_DST)
+ VM_DEFINE_OP (52, make_non_immediate, "make-non-immediate", OP2 (U8_U24,
N32) | OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 offset;
@@ -2065,7 +2047,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* that the compiler is unable to statically allocate, like symbols.
* These values would be initialized when the object file loads.
*/
- VM_DEFINE_OP (51, static_ref, "static-ref", OP2 (U8_U24, S32))
+ VM_DEFINE_OP (53, static_ref, "static-ref", OP2 (U8_U24, S32))
{
scm_t_uint32 dst;
scm_t_int32 offset;
@@ -2088,7 +2070,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Store a SCM value into memory, OFFSET 32-bit words away from the
* current instruction pointer. OFFSET is a signed value.
*/
- VM_DEFINE_OP (52, static_set, "static-set!", OP2 (U8_U24, LO32))
+ VM_DEFINE_OP (54, static_set, "static-set!", OP2 (U8_U24, LO32))
{
scm_t_uint32 src;
scm_t_int32 offset;
@@ -2110,7 +2092,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* words away from the current instruction pointer. OFFSET is a
* signed value.
*/
- VM_DEFINE_OP (53, link_procedure, "link-procedure!", OP2 (U8_U24, L32))
+ VM_DEFINE_OP (55, link_procedure, "link-procedure!", OP2 (U8_U24, L32))
{
scm_t_uint32 src;
scm_t_int32 offset;
@@ -2172,7 +2154,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Resolve SYM in MOD, and place the resulting variable in DST.
*/
- VM_DEFINE_OP (54, resolve, "resolve", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (56, resolve, "resolve", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, mod, sym;
@@ -2190,7 +2172,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* nonzero, resolve the public interface, otherwise use the private
* interface.
*/
- VM_DEFINE_OP (55, resolve_module, "resolve-module", OP1 (U8_U8_U8_U8) |
OP_DST)
+ VM_DEFINE_OP (57, resolve_module, "resolve-module", OP1 (U8_U8_U8_U8) |
OP_DST)
{
scm_t_uint8 dst, name, public;
SCM mod;
@@ -2211,7 +2193,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Look up a binding for SYM in the current module, creating it if
* necessary. Set its value to VAL.
*/
- VM_DEFINE_OP (56, define, "define", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (58, define, "define", OP1 (U8_U12_U12))
{
scm_t_uint16 sym, val;
SCM_UNPACK_RTL_12_12 (op, sym, val);
@@ -2239,7 +2221,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* an error if it is unbound, unbox it into DST, and cache the
* resolved variable so that we will hit the cache next time.
*/
- VM_DEFINE_OP (57, toplevel_ref, "toplevel-ref", OP4 (U8_U24, S32, S32, N32)
| OP_DST)
+ VM_DEFINE_OP (59, toplevel_ref, "toplevel-ref", OP4 (U8_U24, S32, S32, N32)
| OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 var_offset;
@@ -2286,7 +2268,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Like toplevel-ref, except MOD-OFFSET points at the name of a module
* instead of the module itself.
*/
- VM_DEFINE_OP (58, module_ref, "module-ref", OP4 (U8_U24, S32, N32, N32) |
OP_DST)
+ VM_DEFINE_OP (60, module_ref, "module-ref", OP4 (U8_U24, S32, N32, N32) |
OP_DST)
{
scm_t_uint32 dst;
scm_t_int32 var_offset;
@@ -2340,35 +2322,31 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* The dynamic environment
*/
- /* prompt tag:24 return-loc:32 flags:8 handler-offset:24
+ /* prompt tag:24 flags:8 handler-offset:24
*
* Push a new prompt on the dynamic stack, with a tag from TAG and a
* handler at HANDLER-OFFSET words from the current IP. The handler
- * will expect its arguments in RETURN-LOC, as in call and
- * return/values. If FLAGS is nonzero, mark the prompt as escape-only,
- * indicating that no continuation need be reified.
+ * will expect a multiple-value return.
*/
- VM_DEFINE_OP (59, prompt, "prompt", OP3 (U8_U24, U32, U8_L24))
+ VM_DEFINE_OP (61, prompt, "prompt", OP2 (U8_U24, U8_L24))
#if 0
{
- scm_t_uint32 tag, return_loc;
+ scm_t_uint32 tag;
scm_t_int32 offset;
scm_t_uint8 escape_only_p;
scm_t_dynstack_prompt_flags flags;
SCM_UNPACK_RTL_24 (op, tag);
- return_loc = ip[1];
- escape_only_p = ip[2] & 0xff;
- offset = ip[2];
+ escape_only_p = ip[1] & 0xff;
+ offset = ip[1];
offset >>= 8; /* Sign extension */
/* Push the prompt onto the dynamic stack. */
flags = escape_only_p ? SCM_F_DYNSTACK_PROMPT_ESCAPE_ONLY : 0;
- /* FIXME: return_loc */
scm_dynstack_push_prompt (¤t_thread->dynstack, flags,
LOCAL_REF (tag),
fp, vp->sp, ip + offset, ®isters);
- NEXT (3);
+ NEXT (2);
}
#else
abort();
@@ -2382,7 +2360,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* the compiler should have inserted checks that they wind and unwind
* procs are thunks, if it could not prove that to be the case.
*/
- VM_DEFINE_OP (60, wind, "wind", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (62, wind, "wind", OP1 (U8_U12_U12))
{
scm_t_uint16 winder, unwinder;
SCM_UNPACK_RTL_12_12 (op, winder, unwinder);
@@ -2397,7 +2375,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* VAL1, etc are 24-bit values, in the lower 24 bits of their words.
* The upper 8 bits are 0.
*/
- VM_DEFINE_OP (61, abort, "abort", OP2 (U8_U24, X8_R24))
+ VM_DEFINE_OP (63, abort, "abort", OP2 (U8_U24, X8_R24))
#if 0
{
scm_t_uint32 tag, nvalues;
@@ -2420,7 +2398,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* A normal exit from the dynamic extent of an expression. Pop the top
* entry off of the dynamic stack.
*/
- VM_DEFINE_OP (62, unwind, "unwind", OP1 (U8_X24))
+ VM_DEFINE_OP (64, unwind, "unwind", OP1 (U8_X24))
{
scm_dynstack_pop (¤t_thread->dynstack);
NEXT (1);
@@ -2432,7 +2410,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* allocated in a continguous range on the stack, starting from
* FLUID-BASE. The values do not have this restriction.
*/
- VM_DEFINE_OP (63, wind_fluids, "wind-fluids", OP2 (U8_U24, X8_R24))
+ VM_DEFINE_OP (65, wind_fluids, "wind-fluids", OP2 (U8_U24, X8_R24))
#if 0
{
scm_t_uint32 fluid_base, n;
@@ -2454,7 +2432,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Leave the dynamic extent of a with-fluids expression, restoring the
* fluids to their previous values.
*/
- VM_DEFINE_OP (64, unwind_fluids, "unwind-fluids", OP1 (U8_X24))
+ VM_DEFINE_OP (66, unwind_fluids, "unwind-fluids", OP1 (U8_X24))
{
/* This function must not allocate. */
scm_dynstack_unwind_fluids (¤t_thread->dynstack,
@@ -2466,7 +2444,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Reference the fluid in SRC, and place the value in DST.
*/
- VM_DEFINE_OP (65, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (67, fluid_ref, "fluid-ref", OP1 (U8_U12_U12) | OP_DST)
{
scm_t_uint16 dst, src;
size_t num;
@@ -2499,7 +2477,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the value of the fluid in DST to the value in SRC.
*/
- VM_DEFINE_OP (66, fluid_set, "fluid-set", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (68, fluid_set, "fluid-set", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
size_t num;
@@ -2532,7 +2510,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the length of the string in SRC in DST.
*/
- VM_DEFINE_OP (67, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (69, string_length, "string-length", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (str);
if (SCM_LIKELY (scm_is_string (str)))
@@ -2549,7 +2527,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fetch the character at position IDX in the string in SRC, and store
* it in DST.
*/
- VM_DEFINE_OP (68, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (70, string_ref, "string-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_signed_bits i = 0;
ARGS2 (str, idx);
@@ -2571,7 +2549,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Parse a string in SRC to a number, and store in DST.
*/
- VM_DEFINE_OP (69, string_to_number, "string->number", OP1 (U8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (71, string_to_number, "string->number", OP1 (U8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, src;
@@ -2587,7 +2565,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Parse a string in SRC to a symbol, and store in DST.
*/
- VM_DEFINE_OP (70, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (72, string_to_symbol, "string->symbol", OP1 (U8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, src;
@@ -2601,7 +2579,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Make a keyword from the symbol in SRC, and store it in DST.
*/
- VM_DEFINE_OP (71, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (73, symbol_to_keyword, "symbol->keyword", OP1 (U8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, src;
SCM_UNPACK_RTL_12_12 (op, dst, src);
@@ -2620,7 +2598,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Cons CAR and CDR, and store the result in DST.
*/
- VM_DEFINE_OP (72, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (74, cons, "cons", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
RETURN (scm_cons (x, y));
@@ -2630,7 +2608,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the car of SRC in DST.
*/
- VM_DEFINE_OP (73, car, "car", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (75, car, "car", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
VM_VALIDATE_PAIR (x, "car");
@@ -2641,7 +2619,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the cdr of SRC in DST.
*/
- VM_DEFINE_OP (74, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (76, cdr, "cdr", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
VM_VALIDATE_PAIR (x, "cdr");
@@ -2652,7 +2630,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the car of DST to SRC.
*/
- VM_DEFINE_OP (75, set_car, "set-car!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (77, set_car, "set-car!", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
SCM x, y;
@@ -2668,7 +2646,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Set the cdr of DST to SRC.
*/
- VM_DEFINE_OP (76, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
+ VM_DEFINE_OP (78, set_cdr, "set-cdr!", OP1 (U8_U12_U12))
{
scm_t_uint16 a, b;
SCM x, y;
@@ -2691,7 +2669,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Add A to B, and place the result in DST.
*/
- VM_DEFINE_OP (77, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (79, add, "add", OP1 (U8_U8_U8_U8) | OP_DST)
{
BINARY_INTEGER_OP (+, scm_sum);
}
@@ -2700,7 +2678,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Add 1 to the value in SRC, and place the result in DST.
*/
- VM_DEFINE_OP (78, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (80, add1, "add1", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
@@ -2726,7 +2704,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Subtract B from A, and place the result in DST.
*/
- VM_DEFINE_OP (79, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (81, sub, "sub", OP1 (U8_U8_U8_U8) | OP_DST)
{
BINARY_INTEGER_OP (-, scm_difference);
}
@@ -2735,7 +2713,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Subtract 1 from SRC, and place the result in DST.
*/
- VM_DEFINE_OP (80, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (82, sub1, "sub1", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (x);
@@ -2761,7 +2739,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Multiply A and B, and place the result in DST.
*/
- VM_DEFINE_OP (81, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (83, mul, "mul", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2772,7 +2750,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Divide A by B, and place the result in DST.
*/
- VM_DEFINE_OP (82, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (84, div, "div", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2783,7 +2761,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Divide A by B, and place the quotient in DST.
*/
- VM_DEFINE_OP (83, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (85, quo, "quo", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2794,7 +2772,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Divide A by B, and place the remainder in DST.
*/
- VM_DEFINE_OP (84, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (86, rem, "rem", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2805,7 +2783,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the modulo of A by B in DST.
*/
- VM_DEFINE_OP (85, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (87, mod, "mod", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
SYNC_IP ();
@@ -2816,7 +2794,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Shift A arithmetically by B bits, and place the result in DST.
*/
- VM_DEFINE_OP (86, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (88, ash, "ash", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2849,7 +2827,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the bitwise AND of A and B into DST.
*/
- VM_DEFINE_OP (87, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (89, logand, "logand", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2862,7 +2840,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the bitwise inclusive OR of A with B in DST.
*/
- VM_DEFINE_OP (88, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (90, logior, "logior", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2875,7 +2853,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Place the bitwise exclusive OR of A with B in DST.
*/
- VM_DEFINE_OP (89, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (91, logxor, "logxor", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (x, y);
if (SCM_I_INUMP (x) && SCM_I_INUMP (y))
@@ -2888,7 +2866,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the length of the vector in SRC in DST.
*/
- VM_DEFINE_OP (90, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (92, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (vect);
if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)))
@@ -2905,7 +2883,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fetch the item at position IDX in the vector in SRC, and store it
* in DST.
*/
- VM_DEFINE_OP (91, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (93, vector_ref, "vector-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_signed_bits i = 0;
ARGS2 (vect, idx);
@@ -2926,7 +2904,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fill DST with the item IDX elements into the vector at SRC. Useful
* for building data types using vectors.
*/
- VM_DEFINE_OP (92, constant_vector_ref, "constant-vector-ref", OP1
(U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (94, constant_vector_ref, "constant-vector-ref", OP1
(U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
SCM v;
@@ -2945,7 +2923,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store SRC into the vector DST at index IDX.
*/
- VM_DEFINE_OP (93, vector_set, "vector-set", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (95, vector_set, "vector-set", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx_var, src;
SCM vect, idx, val;
@@ -2980,7 +2958,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (94, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (96, struct_vtable, "struct-vtable", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
VM_VALIDATE_STRUCT (obj, "struct_vtable");
@@ -2994,7 +2972,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* the locals given by INIT0.... The format of INIT0... is as in the
* "call" opcode: unsigned 24-bit values, with 0 in the high byte.
*/
- VM_DEFINE_OP (95, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24))
+ VM_DEFINE_OP (97, make_struct, "make-struct", OP2 (U8_U12_U12, X8_R24))
#if 0
{
scm_t_uint16 dst, vtable_r;
@@ -3037,7 +3015,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Fetch the item at slot IDX in the struct in SRC, and store it
* in DST.
*/
- VM_DEFINE_OP (96, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (98, struct_ref, "struct-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
ARGS2 (obj, pos);
@@ -3071,7 +3049,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store SRC into the struct DST at slot IDX.
*/
- VM_DEFINE_OP (97, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (99, struct_set, "struct-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
SCM obj, pos, val;
@@ -3112,7 +3090,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Store the vtable of SRC into DST.
*/
- VM_DEFINE_OP (98, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
+ VM_DEFINE_OP (100, class_of, "class-of", OP1 (U8_U12_U12) | OP_DST)
{
ARGS1 (obj);
if (SCM_INSTANCEP (obj))
@@ -3127,7 +3105,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* DST. Unlike struct-ref, IDX is an 8-bit immediate value, not an
* index into the stack.
*/
- VM_DEFINE_OP (99, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (101, slot_ref, "slot-ref", OP1 (U8_U8_U8_U8) | OP_DST)
{
scm_t_uint8 dst, src, idx;
SCM_UNPACK_RTL_8_8_8 (op, dst, src, idx);
@@ -3141,7 +3119,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* Store SRC into slot IDX of the struct in DST. Unlike struct-set!,
* IDX is an 8-bit immediate value, not an index into the stack.
*/
- VM_DEFINE_OP (100, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (102, slot_set, "slot-set!", OP1 (U8_U8_U8_U8))
{
scm_t_uint8 dst, idx, src;
SCM_UNPACK_RTL_8_8_8 (op, dst, idx, src);
@@ -3162,7 +3140,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
* from the instruction pointer, and store into DST. LEN is a byte
* length. OFFSET is signed.
*/
- VM_DEFINE_OP (101, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8,
N32, U32) | OP_DST)
+ VM_DEFINE_OP (103, load_typed_array, "load-typed-array", OP3 (U8_U8_U8_U8,
N32, U32) | OP_DST)
{
scm_t_uint8 dst, type, shape;
scm_t_int32 offset;
@@ -3182,7 +3160,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
*
* Make a new array SRC into the vector DST at index IDX.
*/
- VM_DEFINE_OP (102, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) |
OP_DST)
+ VM_DEFINE_OP (104, make_array, "make-array", OP2 (U8_U12_U12, X8_U12_U12) |
OP_DST)
{
scm_t_uint16 dst, type, fill, bounds;
SCM_UNPACK_RTL_12_12 (op, dst, type);
@@ -3280,42 +3258,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx)); \
} while (0)
- VM_DEFINE_OP (103, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (105, bv_u8_ref, "bv-u8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u8, u8, uint8, 1);
- VM_DEFINE_OP (104, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (106, bv_s8_ref, "bv-s8-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s8, s8, int8, 1);
- VM_DEFINE_OP (105, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (107, bv_u16_ref, "bv-u16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (u16, u16_native, uint16, 2);
- VM_DEFINE_OP (106, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (108, bv_s16_ref, "bv-s16-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FIXABLE_INT_REF (s16, s16_native, int16, 2);
- VM_DEFINE_OP (107, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (109, bv_u32_ref, "bv-u32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (u32, u32_native, uint32, 4);
#else
BV_INT_REF (u32, uint32, 4);
#endif
- VM_DEFINE_OP (108, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (110, bv_s32_ref, "bv-s32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_REF (s32, s32_native, int32, 4);
#else
BV_INT_REF (s32, int32, 4);
#endif
- VM_DEFINE_OP (109, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (111, bv_u64_ref, "bv-u64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (u64, uint64, 8);
- VM_DEFINE_OP (110, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (112, bv_s64_ref, "bv-s64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_INT_REF (s64, int64, 8);
- VM_DEFINE_OP (111, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (113, bv_f32_ref, "bv-f32-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f32, ieee_single, float, 4);
- VM_DEFINE_OP (112, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
+ VM_DEFINE_OP (114, bv_f64_ref, "bv-f64-ref", OP1 (U8_U8_U8_U8) | OP_DST)
BV_FLOAT_REF (f64, ieee_double, double, 8);
/* bv-u8-set! dst:8 idx:8 src:8
@@ -3419,42 +3397,42 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
NEXT (1); \
} while (0)
- VM_DEFINE_OP (113, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (115, bv_u8_set, "bv-u8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u8, u8, uint8, 0, SCM_T_UINT8_MAX, 1);
- VM_DEFINE_OP (114, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (116, bv_s8_set, "bv-s8-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s8, s8, int8, SCM_T_INT8_MIN, SCM_T_INT8_MAX, 1);
- VM_DEFINE_OP (115, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (117, bv_u16_set, "bv-u16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (u16, u16_native, uint16, 0, SCM_T_UINT16_MAX, 2);
- VM_DEFINE_OP (116, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (118, bv_s16_set, "bv-s16-set!", OP1 (U8_U8_U8_U8))
BV_FIXABLE_INT_SET (s16, s16_native, int16, SCM_T_INT16_MIN,
SCM_T_INT16_MAX, 2);
- VM_DEFINE_OP (117, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (119, bv_u32_set, "bv-u32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (u32, u32_native, uint32, 0, SCM_T_UINT32_MAX, 4);
#else
BV_INT_SET (u32, uint32, 4);
#endif
- VM_DEFINE_OP (118, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (120, bv_s32_set, "bv-s32-set!", OP1 (U8_U8_U8_U8))
#if SIZEOF_VOID_P > 4
BV_FIXABLE_INT_SET (s32, s32_native, int32, SCM_T_INT32_MIN,
SCM_T_INT32_MAX, 4);
#else
BV_INT_SET (s32, int32, 4);
#endif
- VM_DEFINE_OP (119, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (121, bv_u64_set, "bv-u64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (u64, uint64, 8);
- VM_DEFINE_OP (120, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (122, bv_s64_set, "bv-s64-set!", OP1 (U8_U8_U8_U8))
BV_INT_SET (s64, int64, 8);
- VM_DEFINE_OP (121, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (123, bv_f32_set, "bv-f32-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f32, ieee_single, float, 4);
- VM_DEFINE_OP (122, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
+ VM_DEFINE_OP (124, bv_f64_set, "bv-f64-set!", OP1 (U8_U8_U8_U8))
BV_FLOAT_SET (f64, ieee_double, double, 8);
END_DISPATCH_SWITCH;
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index bbc29e9..053ad40 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -1151,7 +1151,7 @@ VM_DEFINE_INSTRUCTION (68, tail_call_cc, "tail-call/cc",
0, 1, 1)
VM_DEFINE_INSTRUCTION (69, return, "return", 0, 1, 1)
{
vm_return:
- POP_CONTINUATION_HOOK (sp, 1, 0);
+ POP_CONTINUATION_HOOK (sp, 1);
VM_HANDLE_INTERRUPTS;
@@ -1190,7 +1190,7 @@ VM_DEFINE_INSTRUCTION (70, return_values,
"return/values", 1, -1, -1)
that perhaps it might be used without declaration. Fooey to that, I say.
*/
nvalues = FETCH ();
vm_return_values:
- POP_CONTINUATION_HOOK (sp + 1 - nvalues, nvalues, 0);
+ POP_CONTINUATION_HOOK (sp + 1 - nvalues, nvalues);
VM_HANDLE_INTERRUPTS;
diff --git a/libguile/vm.c b/libguile/vm.c
index 5ccd5f7..c99431f 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -201,10 +201,10 @@ scm_i_capture_current_stack (void)
}
static void vm_dispatch_hook (SCM vm, int hook_num,
- SCM *argv, int n, int rest_p) SCM_NOINLINE;
+ SCM *argv, int n) SCM_NOINLINE;
static void
-vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n, int rest_p)
+vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n)
{
struct scm_vm *vp;
SCM hook;
@@ -250,7 +250,7 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n,
int rest_p)
args[0] = SCM_PACK_POINTER (frame);
scm_c_run_hookn (hook, args, 1);
}
- else if (n == 1 && !rest_p)
+ else if (n == 1)
{
SCM args[2];
@@ -260,7 +260,7 @@ vm_dispatch_hook (SCM vm, int hook_num, SCM *argv, int n,
int rest_p)
}
else
{
- SCM args = rest_p ? argv[n] : SCM_EOL;
+ SCM args = SCM_EOL;
while (n--)
args = scm_cons (argv[n], args);
@@ -626,11 +626,29 @@ vm_error_free_variable ()
static SCM boot_continuation;
-const scm_t_uint32 rtl_boot_continuation_code[] = {
- SCM_PACK_RTL_24 (scm_rtl_op_halt_values, 0) /* results from r0 */
+static SCM rtl_boot_continuation;
+static SCM rtl_apply;
+static SCM rtl_values;
+
+static const scm_t_uint32 rtl_boot_continuation_code[] = {
+ SCM_PACK_RTL_24 (scm_rtl_op_halt_values, 0), /* empty stack frame in r0-r2,
results from r3 */
+ SCM_PACK_RTL_24 (scm_rtl_op_halt, 0) /* result in r0 */
+};
+
+static scm_t_uint32* rtl_boot_multiple_value_continuation_code =
+ (scm_t_uint32 *) rtl_boot_continuation_code;
+
+static scm_t_uint32* rtl_boot_single_value_continuation_code =
+ (scm_t_uint32 *) rtl_boot_continuation_code + 1;
+
+static const scm_t_uint32 rtl_apply_code[] = {
+ SCM_PACK_RTL_24 (scm_rtl_op_apply, 0) /* proc in r0, args from r1, nargs set
*/
+};
+
+static const scm_t_uint32 rtl_values_code[] = {
+ SCM_PACK_RTL_24 (scm_rtl_op_values, 0) /* vals from r0 */
};
-static SCM rtl_boot_continuation;
/*
@@ -1142,6 +1160,8 @@ scm_init_vm (void)
#endif
rtl_boot_continuation = scm_i_make_rtl_program (rtl_boot_continuation_code);
+ rtl_apply = scm_i_make_rtl_program (rtl_apply_code);
+ rtl_values = scm_i_make_rtl_program (rtl_values_code);
}
/*
diff --git a/libguile/weak-set.c b/libguile/weak-set.c
index d648dbd..62029c5 100644
--- a/libguile/weak-set.c
+++ b/libguile/weak-set.c
@@ -178,7 +178,7 @@ move_weak_entry (scm_t_weak_entry *from, scm_t_weak_entry
*to)
#else
GC_unregister_disappearing_link ((void **) &from->key);
SCM_I_REGISTER_DISAPPEARING_LINK ((void **) &to->key,
- to->key);
+ SCM_PACK (to->key));
#endif
}
}
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, wip-rtl, updated. v2.1.0-397-ga36c013,
Andy Wingo <=