diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c index 73c4296a5..b95a45a59 100644 --- a/libguile/vm-i-scheme.c +++ b/libguile/vm-i-scheme.c @@ -281,6 +281,49 @@ VM_DEFINE_FUNCTION (126, mod, "mod", 2) RETURN (scm_modulo (x, y)); } +VM_DEFINE_FUNCTION (170, ash, "ash", 2) +{ + ARGS2 (x, y); + if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) + { + if (SCM_I_INUM (y) < 0) + RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) >> -SCM_I_INUM (y))); + else if ((SCM_I_INUM (x) << SCM_I_INUM (y)) >> SCM_I_INUM (y) + == SCM_I_INUM (x)) + RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) << SCM_I_INUM (y))); + /* fall through */ + } + SYNC_REGISTER (); + RETURN (scm_ash (x, y)); +} + +VM_DEFINE_FUNCTION (171, logand, "logand", 2) +{ + ARGS2 (x, y); + if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) + RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) & SCM_I_INUM (y))); + SYNC_REGISTER (); + RETURN (scm_logand (x, y)); +} + +VM_DEFINE_FUNCTION (172, logior, "logior", 2) +{ + ARGS2 (x, y); + if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) + RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) | SCM_I_INUM (y))); + SYNC_REGISTER (); + RETURN (scm_logior (x, y)); +} + +VM_DEFINE_FUNCTION (173, logxor, "logxor", 2) +{ + ARGS2 (x, y); + if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) + RETURN (SCM_I_MAKINUM (SCM_I_INUM (x) ^ SCM_I_INUM (y))); + SYNC_REGISTER (); + RETURN (scm_logxor (x, y)); +} + /* * GOOPS support diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm index c708fe65d..1781c4629 100644 --- a/module/language/tree-il/compile-glil.scm +++ b/module/language/tree-il/compile-glil.scm @@ -92,6 +92,10 @@ ((quotient . 2) . quo) ((remainder . 2) . rem) ((modulo . 2) . mod) + ((ash . 2) . ash) + ((logand . 2) . logand) + ((logior . 2) . logior) + ((logxor . 2) . logxor) ((not . 1) . not) ((pair? . 1) . pair?) ((cons . 2) . cons) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index db49490ed..531a14a4b 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -36,6 +36,7 @@ eq? eqv? equal? = < > <= >= zero? + * - / 1- 1+ quotient remainder modulo + ash logand logior logxor not pair? null? list? acons cons cons*