summaryrefslogtreecommitdiff
path: root/src/vm_scheme.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/vm_scheme.c')
-rw-r--r--src/vm_scheme.c113
1 files changed, 73 insertions, 40 deletions
diff --git a/src/vm_scheme.c b/src/vm_scheme.c
index 3b3c6e5ab..99e9e3093 100644
--- a/src/vm_scheme.c
+++ b/src/vm_scheme.c
@@ -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 ();
+ ARGS1 (a1);
+ RETURN (SCM_BOOL (SCM_FALSEP (a1)));
+}
+
+VM_DEFINE_FUNCTION (not_not, "not-not", 1)
+{
+ ARGS1 (a1);
+ RETURN (SCM_BOOL (!SCM_FALSEP (a1)));
+}
+
+VM_DEFINE_FUNCTION (eq, "eq?", 2)
+{
+ ARGS2 (a1, a2);
+ RETURN (SCM_BOOL (SCM_EQ_P (a1, a2)));
+}
+
+VM_DEFINE_FUNCTION (not_eq, "not-eq?", 2)
+{
+ ARGS2 (a1, a2);
+ RETURN (SCM_BOOL (!SCM_EQ_P (a1, a2)));
+}
+
+VM_DEFINE_FUNCTION (nullp, "null?", 1)
+{
+ ARGS1 (a1);
RETURN (SCM_BOOL (SCM_NULLP (a1)));
}
-SCM_DEFINE_VM_FUNCTION (cons, "cons", "cons", 2, 0)
+VM_DEFINE_FUNCTION (not_nullp, "not-null?", 1)
{
- VM_SETUP_ARGS2 ();
- CONS (ac, a1, a2);
- NEXT;
+ ARGS1 (a1);
+ RETURN (SCM_BOOL (!SCM_NULLP (a1)));
}
-SCM_DEFINE_VM_FUNCTION (list, "list", "list", 0, 1)
+VM_DEFINE_FUNCTION (pairp, "pair?", 1)
{
- VM_SETUP_ARGSN ();
- ac = SCM_EOL;
- POP_LIST (nargs, ac);
- NEXT;
+ ARGS1 (a1);
+ RETURN (SCM_BOOL (SCM_CONSP (a1)));
}
-SCM_DEFINE_VM_FUNCTION (car, "car", "car", 1, 0)
+VM_DEFINE_FUNCTION (listp, "list?", 1)
{
- VM_SETUP_ARGS1 ();
- SCM_VALIDATE_CONS (0, a1);
- RETURN (SCM_CAR (a1));
+ ARGS1 (a1);
+ RETURN (SCM_BOOL (scm_ilength (a1) >= 0));
}
-SCM_DEFINE_VM_FUNCTION (cdr, "cdr", "cdr", 1, 0)
+VM_DEFINE_FUNCTION (cons, "cons", 2)
{
- VM_SETUP_ARGS1 ();
- SCM_VALIDATE_CONS (0, a1);
- RETURN (SCM_CDR (a1));
+ ARGS2 (a1, a2);
+ CONS (a1, a1, a2);
+ RETURN (a1);
}
-SCM_DEFINE_VM_FUNCTION (not, "not", "not", 1, 0)
+VM_DEFINE_FUNCTION (car, "car", 1)
{
- VM_SETUP_ARGS1 ();
- RETURN (SCM_BOOL (SCM_FALSEP (a1)));
+ ARGS1 (a1);
+ SCM_VALIDATE_CONS (1, a1);
+ RETURN (SCM_CAR (a1));
}
-SCM_DEFINE_VM_FUNCTION (append, "append", "append", 0, 1)
+VM_DEFINE_FUNCTION (cdr, "cdr", 1)
{
- VM_SETUP_ARGSN ();
- ac = SCM_EOL;
- POP_LIST (nargs, ac);
- RETURN (scm_append (ac));
+ ARGS1 (a1);
+ SCM_VALIDATE_CONS (1, a1);
+ RETURN (SCM_CDR (a1));
}
-SCM_DEFINE_VM_FUNCTION (append_x, "append!", "append!", 0, 1)
+VM_DEFINE_FUNCTION (set_car, "set-car!", 2)
{
- VM_SETUP_ARGSN ();
- ac = SCM_EOL;
- POP_LIST (nargs, ac);
- RETURN (scm_append_x (ac));
+ ARGS2 (a1, a2);
+ SCM_VALIDATE_CONS (1, a1);
+ SCM_SETCAR (a1, a2);
+ RETURN (SCM_UNSPECIFIED);
}
-SCM_DEFINE_VM_FUNCTION (catch, "catch", "catch", 3, 0)
+VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2)
{
- VM_SETUP_ARGS3 ();
- dynwinds = SCM_EOL;
+ ARGS2 (a1, a2);
+ SCM_VALIDATE_CONS (1, a1);
+ SCM_SETCDR (a1, a2);
+ RETURN (SCM_UNSPECIFIED);
}
-SCM_DEFINE_VM_FUNCTION (call_cc, "call-with-current-continuation", "call/cc", 1, 0)
+VM_DEFINE_FUNCTION (list, "list", -1)
{
- SYNC (); /* must sync all registers */
- PUSH (SCM_VM_CAPTURE_CONT (vmp)); /* argument 1 */
- nargs = 1; /* the number of arguments */
- goto vm_call;
+ 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:
+*/