-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1995-2001, 2006, 2008-2011, 2013
+ * Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#include "libguile/gsubr.h"
#include "libguile/foreign.h"
#include "libguile/instructions.h"
-#include "libguile/objcodes.h"
#include "libguile/srfi-4.h"
#include "libguile/programs.h"
\f
/* OK here goes nothing: we're going to define VM assembly trampolines for
- invoking subrs, along with their meta-information, and then wrap them into
- statically allocated objcode values. Ready? Right!
-*/
+ invoking subrs. Ready? Right! */
/* There's a maximum of 10 args, so the number of possible combinations is:
(REQ-OPT-REST)
/* A: req; B: opt; C: rest */
#define A(nreq) \
- SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ee, nreq + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \
+ SCM_PACK_OP_24 (assert_nargs_ee, nreq + 1), \
+ SCM_PACK_OP_24 (subr_call, 0), \
0, \
0
#define B(nopt) \
- SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_le, nopt + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_alloc_frame, nopt + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \
+ SCM_PACK_OP_24 (assert_nargs_le, nopt + 1), \
+ SCM_PACK_OP_24 (alloc_frame, nopt + 1), \
+ SCM_PACK_OP_24 (subr_call, 0), \
0
#define C() \
- SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \
+ SCM_PACK_OP_24 (bind_rest, 1), \
+ SCM_PACK_OP_24 (subr_call, 0), \
0, \
0
#define AB(nreq, nopt) \
- SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, nreq + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_le, nreq + nopt + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_alloc_frame, nreq + nopt + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0)
+ 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)
#define AC(nreq) \
- SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, nreq + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, nreq + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \
+ SCM_PACK_OP_24 (assert_nargs_ge, nreq + 1), \
+ SCM_PACK_OP_24 (bind_rest, nreq + 1), \
+ SCM_PACK_OP_24 (subr_call, 0), \
0
#define BC(nopt) \
- SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, nopt + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \
+ SCM_PACK_OP_24 (bind_rest, nopt + 1), \
+ SCM_PACK_OP_24 (subr_call, 0), \
0, \
0
#define ABC(nreq, nopt) \
- SCM_PACK_RTL_24 (scm_rtl_op_assert_nargs_ge, nreq + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_bind_rest, nreq + nopt + 1), \
- SCM_PACK_RTL_24 (scm_rtl_op_subr_call, 0), \
+ 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), \
0
sname = scm_from_utf8_symbol (name);
- ret = scm_words (scm_tc7_rtl_program | (nfree << 16), nfree + 2);
flags = SCM_F_PROGRAM_IS_PRIMITIVE;
flags |= generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0;
- SCM_SET_CELL_WORD_0 (ret, SCM_CELL_WORD_0 (ret) | flags);
+
+ ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, get_subr_stub_code (nreq, nopt, rest));
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL));
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname);
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL));
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname);
if (generic_loc)
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 2,
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 2,
scm_from_pointer (generic_loc, NULL));
if (define)
return ret;
}
-/* Given an RTL primitive, determine its minimum arity. This is
- possible because each RTL primitive is 4 32-bit words long, and they
- are laid out contiguously in an ordered pattern. */
+/* Given a program that is a primitive, determine its minimum arity.
+ This is possible because each primitive's code is 4 32-bit words
+ long, and they are laid out contiguously in an ordered pattern. */
int
scm_i_primitive_arity (SCM prim, int *req, int *opt, int *rest)
{
- const scm_t_uint32 *code = SCM_RTL_PROGRAM_CODE (prim);
+ const scm_t_uint32 *code = SCM_PROGRAM_CODE (prim);
unsigned idx, nargs, base, next;
if (code < subr_stub_code)
return 1;
}
-int
+scm_t_uintptr
scm_i_primitive_call_ip (SCM subr)
{
- const scm_t_uint32 *code = SCM_RTL_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
instruction, in either the fourth, third, or second word. Return a
byte offset from the entry. */
- return code[3] ? 12 : code[2] ? 8 : 4;
+ return (scm_t_uintptr)(code + (code[3] ? 3 : code[2] ? 2 : 1));
}
SCM
HCoop / bpt / guile.git / blobdiff