diff options
Diffstat (limited to 'src/vm_scheme.c')
-rw-r--r-- | src/vm_scheme.c | 113 |
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: +*/ |