opcodes for bit twiddling (ash, logand, logior, logxor)

* module/language/tree-il/compile-glil.scm:
* module/language/tree-il/primitives.scm:
* libguile/vm-i-scheme.c (ash, logand, logior, logxor): New opcodes.

diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 73c4296..b95a45a 100644 (file)
--- 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));
+}
+
 \f
 /*
  * GOOPS support

diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index c708fe6..1781c46 100644 (file)
--- 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 db49490..531a14a 100644 (file)
--- 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*