mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-09 23:40:29 +02:00
Playing with the procedure call mechanism.
* src/objcodes.c (do-pair): New experiment. * src/vm_engine.h (ALIGN_AS_NON_IMMEDIATE): New macro. (POP_LIST_ON_STACK): New experimental macro. * src/vm_engine.c (call): In the procedure call case, I tried using the above macro. git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-8
This commit is contained in:
parent
f41cb00ce2
commit
135b32ee84
3 changed files with 107 additions and 0 deletions
|
@ -124,6 +124,38 @@ objcode_free (SCM obj)
|
||||||
* Scheme interface
|
* Scheme interface
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
SCM_DEFINE (scm_do_pair, "do-pair", 2, 0, 0,
|
||||||
|
(SCM car, SCM cdr),
|
||||||
|
"This is a stupid test to see how cells work. (Ludo)")
|
||||||
|
{
|
||||||
|
static SCM room[512];
|
||||||
|
static SCM *where = &room[0];
|
||||||
|
SCM the_pair;
|
||||||
|
size_t incr;
|
||||||
|
|
||||||
|
if ((scm_t_bits)where & 6)
|
||||||
|
{
|
||||||
|
/* Align the cell pointer so that Guile considers it as a
|
||||||
|
non-immediate object (see tags.h). */
|
||||||
|
incr = (scm_t_bits)where & 6;
|
||||||
|
incr = (~incr) & 7;
|
||||||
|
where += incr;
|
||||||
|
}
|
||||||
|
|
||||||
|
printf ("do-pair: pool @ %p, pair @ %p\n", &room[0], where);
|
||||||
|
where[0] = car;
|
||||||
|
where[1] = cdr;
|
||||||
|
|
||||||
|
the_pair = PTR2SCM (where);
|
||||||
|
/* This doesn't work because SCM_SET_GC_MARK will look for some sort of a
|
||||||
|
"mark bitmap" at the end of a supposed cell segment which doesn't
|
||||||
|
exist. */
|
||||||
|
|
||||||
|
return (the_pair);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
SCM_DEFINE (scm_objcode_p, "objcode?", 1, 0, 0,
|
SCM_DEFINE (scm_objcode_p, "objcode?", 1, 0, 0,
|
||||||
(SCM obj),
|
(SCM obj),
|
||||||
"")
|
"")
|
||||||
|
|
|
@ -241,6 +241,76 @@ do \
|
||||||
PUSH (l); \
|
PUSH (l); \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
|
|
||||||
|
/* Below is a (slightly broken) experiment to avoid calling `scm_cell' and to
|
||||||
|
allocate cells on the stack. This is a significant improvement for
|
||||||
|
programs which call a lot of procedures, since the procedure call
|
||||||
|
mechanism uses POP_LIST which normally uses `scm_cons'.
|
||||||
|
|
||||||
|
What it does is that it creates a list whose cells are allocated on the
|
||||||
|
VM's stack instead of being allocated on the heap via `scm_cell'. This is
|
||||||
|
much faster. However, if the callee does something like:
|
||||||
|
|
||||||
|
(lambda (. args)
|
||||||
|
(set! the-args args))
|
||||||
|
|
||||||
|
then terrible things may happen since the list of arguments may be
|
||||||
|
overwritten later on. */
|
||||||
|
|
||||||
|
|
||||||
|
/* Awful hack that aligns PTR so that it can be considered as a non-immediate
|
||||||
|
value by Guile. */
|
||||||
|
#define ALIGN_AS_NON_IMMEDIATE(_ptr) \
|
||||||
|
{ \
|
||||||
|
if ((scm_t_bits)(_ptr) & 6) \
|
||||||
|
{ \
|
||||||
|
size_t _incr; \
|
||||||
|
\
|
||||||
|
_incr = (scm_t_bits)(_ptr) & 6; \
|
||||||
|
_incr = (~_incr) & 7; \
|
||||||
|
(_ptr) += _incr; \
|
||||||
|
} \
|
||||||
|
}
|
||||||
|
|
||||||
|
#define POP_LIST_ON_STACK(n) \
|
||||||
|
do \
|
||||||
|
{ \
|
||||||
|
int i; \
|
||||||
|
if (n == 0) \
|
||||||
|
{ \
|
||||||
|
sp -= n; \
|
||||||
|
PUSH (SCM_EOL); \
|
||||||
|
} \
|
||||||
|
else \
|
||||||
|
{ \
|
||||||
|
SCM *list_head, *list; \
|
||||||
|
\
|
||||||
|
list_head = sp + 1; \
|
||||||
|
ALIGN_AS_NON_IMMEDIATE (list_head); \
|
||||||
|
list = list_head; \
|
||||||
|
\
|
||||||
|
sp -= n; \
|
||||||
|
for (i = 1; i <= n; i++) \
|
||||||
|
{ \
|
||||||
|
/* The cell's car and cdr. */ \
|
||||||
|
*(list) = sp[i]; \
|
||||||
|
*(list + 1) = PTR2SCM (list + 2); \
|
||||||
|
list += 2; \
|
||||||
|
} \
|
||||||
|
\
|
||||||
|
/* The last pair's cdr is '(). */ \
|
||||||
|
list--; \
|
||||||
|
*list = SCM_EOL; \
|
||||||
|
/* Push the SCM object that points */ \
|
||||||
|
/* to the first cell. */ \
|
||||||
|
PUSH (PTR2SCM (list_head)); \
|
||||||
|
} \
|
||||||
|
} \
|
||||||
|
while (0)
|
||||||
|
|
||||||
|
/* end of the experiment */
|
||||||
|
|
||||||
|
|
||||||
#define POP_LIST_MARK() \
|
#define POP_LIST_MARK() \
|
||||||
do { \
|
do { \
|
||||||
SCM o; \
|
SCM o; \
|
||||||
|
|
|
@ -380,7 +380,12 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
|
||||||
arguments. */
|
arguments. */
|
||||||
SCM args;
|
SCM args;
|
||||||
|
|
||||||
|
#if 1
|
||||||
POP_LIST (nargs);
|
POP_LIST (nargs);
|
||||||
|
#else
|
||||||
|
/* Experimental: Build the arglist on the VM stack. XXX */
|
||||||
|
POP_LIST_ON_STACK (nargs);
|
||||||
|
#endif
|
||||||
POP (args);
|
POP (args);
|
||||||
*sp = scm_apply (x, args, SCM_EOL);
|
*sp = scm_apply (x, args, SCM_EOL);
|
||||||
NEXT;
|
NEXT;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue