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

Allow vm_engine caller to pass arguments on the stack.

Browse source 
* libguile/vm-engine.c (vm_engine): Allow the caller to pass arguments
  on the stack.
This commit is contained in:
Andy Wingo 2013-05-23 15:16:20 +02:00
parent 8dd6bfa7bb
commit 27319ffaa9
1 changed files with 13 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

17
libguile/vm-engine.c
View file

@ -356,8 +356,19 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
NEXT; NEXT;
} }
/* Initial frame */
CACHE_REGISTER (); CACHE_REGISTER ();
/* Since it's possible to receive the arguments on the stack itself,
and indeed the RTL VM invokes us that way, shuffle up the
arguments first. */
VM_ASSERT (sp + 8 + nargs < stack_limit, vm_error_too_many_args (nargs));
{
int i;
for (i = nargs - 1; i >= 0; i--)
sp[9 + i] = argv[i];
}
/* Initial frame */
PUSH (SCM_PACK (fp)); /* dynamic link */ PUSH (SCM_PACK (fp)); /* dynamic link */
PUSH (SCM_PACK (0)); /* mvra */ PUSH (SCM_PACK (0)); /* mvra */
PUSH (SCM_PACK (ip)); /* ra */ PUSH (SCM_PACK (ip)); /* ra */
@ -371,9 +382,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
PUSH (SCM_PACK (ip)); /* ra */ PUSH (SCM_PACK (ip)); /* ra */
PUSH (program); PUSH (program);
fp = sp + 1; fp = sp + 1;
VM_ASSERT (sp + nargs < stack_limit, vm_error_too_many_args (nargs)); sp += nargs;
while (nargs--)
PUSH (*argv++);
PUSH_CONTINUATION_HOOK (); PUSH_CONTINUATION_HOOK ();