mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-14 23:50:19 +02:00
Code Activity

New VM.

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-01 05:03:41 +00:00
parent c092937bd5
commit 17e90c5e25
47 changed files with 5599 additions and 2159 deletions
Download patch file Download diff file Expand all files Collapse all files

143
src/vm_scheme.c
View file

@ -41,73 +41,106 @@
/* This file is included in vm_engine.c */
SCM_DEFINE_VM_FUNCTION (null_p, "null?", "null?", 1, 0)
VM_DEFINE_FUNCTION (not, "not", 1)
{
VM_SETUP_ARGS1 ();
RETURN (SCM_BOOL (SCM_NULLP (a1)));
}
SCM_DEFINE_VM_FUNCTION (cons, "cons", "cons", 2, 0)
{
VM_SETUP_ARGS2 ();
CONS (ac, a1, a2);
NEXT;
}
SCM_DEFINE_VM_FUNCTION (list, "list", "list", 0, 1)
{
VM_SETUP_ARGSN ();
ac = SCM_EOL;
POP_LIST (nargs, ac);
NEXT;
}
SCM_DEFINE_VM_FUNCTION (car, "car", "car", 1, 0)
{
VM_SETUP_ARGS1 ();
SCM_VALIDATE_CONS (0, a1);
RETURN (SCM_CAR (a1));
}
SCM_DEFINE_VM_FUNCTION (cdr, "cdr", "cdr", 1, 0)
{
VM_SETUP_ARGS1 ();
SCM_VALIDATE_CONS (0, a1);
RETURN (SCM_CDR (a1));
}
SCM_DEFINE_VM_FUNCTION (not, "not", "not", 1, 0)
{
VM_SETUP_ARGS1 ();
ARGS1 (a1);
RETURN (SCM_BOOL (SCM_FALSEP (a1)));
}
SCM_DEFINE_VM_FUNCTION (append, "append", "append", 0, 1)
VM_DEFINE_FUNCTION (not_not, "not-not", 1)
{
VM_SETUP_ARGSN ();
ac = SCM_EOL;
POP_LIST (nargs, ac);
RETURN (scm_append (ac));
ARGS1 (a1);
RETURN (SCM_BOOL (!SCM_FALSEP (a1)));
}
SCM_DEFINE_VM_FUNCTION (append_x, "append!", "append!", 0, 1)
VM_DEFINE_FUNCTION (eq, "eq?", 2)
{
VM_SETUP_ARGSN ();
ac = SCM_EOL;
POP_LIST (nargs, ac);
RETURN (scm_append_x (ac));
ARGS2 (a1, a2);
RETURN (SCM_BOOL (SCM_EQ_P (a1, a2)));
}
SCM_DEFINE_VM_FUNCTION (catch, "catch", "catch", 3, 0)
VM_DEFINE_FUNCTION (not_eq, "not-eq?", 2)
{
VM_SETUP_ARGS3 ();
dynwinds = SCM_EOL;
ARGS2 (a1, a2);
RETURN (SCM_BOOL (!SCM_EQ_P (a1, a2)));
}
SCM_DEFINE_VM_FUNCTION (call_cc, "call-with-current-continuation", "call/cc", 1, 0)
VM_DEFINE_FUNCTION (nullp, "null?", 1)
{
SYNC (); /* must sync all registers */
PUSH (SCM_VM_CAPTURE_CONT (vmp)); /* argument 1 */
nargs = 1; /* the number of arguments */
goto vm_call;
ARGS1 (a1);
RETURN (SCM_BOOL (SCM_NULLP (a1)));
}
VM_DEFINE_FUNCTION (not_nullp, "not-null?", 1)
{
ARGS1 (a1);
RETURN (SCM_BOOL (!SCM_NULLP (a1)));
}
VM_DEFINE_FUNCTION (pairp, "pair?", 1)
{
ARGS1 (a1);
RETURN (SCM_BOOL (SCM_CONSP (a1)));
}
VM_DEFINE_FUNCTION (listp, "list?", 1)
{
ARGS1 (a1);
RETURN (SCM_BOOL (scm_ilength (a1) >= 0));
}
VM_DEFINE_FUNCTION (cons, "cons", 2)
{
ARGS2 (a1, a2);
CONS (a1, a1, a2);
RETURN (a1);
}
VM_DEFINE_FUNCTION (car, "car", 1)
{
ARGS1 (a1);
SCM_VALIDATE_CONS (1, a1);
RETURN (SCM_CAR (a1));
}
VM_DEFINE_FUNCTION (cdr, "cdr", 1)
{
ARGS1 (a1);
SCM_VALIDATE_CONS (1, a1);
RETURN (SCM_CDR (a1));
}
VM_DEFINE_FUNCTION (set_car, "set-car!", 2)
{
ARGS2 (a1, a2);
SCM_VALIDATE_CONS (1, a1);
SCM_SETCAR (a1, a2);
RETURN (SCM_UNSPECIFIED);
}
VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2)
{
ARGS2 (a1, a2);
SCM_VALIDATE_CONS (1, a1);
SCM_SETCDR (a1, a2);
RETURN (SCM_UNSPECIFIED);
}
VM_DEFINE_FUNCTION (list, "list", -1)
{
POP_LIST_MARK ();
NEXT;
}
VM_DEFINE_FUNCTION (vector, "vector", -1)
{
POP_LIST_MARK ();
*sp = scm_vector (*sp);
NEXT;
}
/*
Local Variables:
c-file-style: "gnu"
End:
*/