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

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

Browse source 
* module/language/tree-il/compile-glil.scm:
* module/language/tree-il/primitives.scm:
* libguile/vm-i-scheme.c (ash, logand, logior, logxor): New opcodes.
This commit is contained in:
Andy Wingo 2009-11-06 13:13:39 +01:00
parent aec4a84ac8
commit b10d93309b
3 changed files with 48 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

43
libguile/vm-i-scheme.c
View file

@ -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

4
module/language/tree-il/compile-glil.scm
View file

@ -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)

1
module/language/tree-il/primitives.scm
View file

@ -36,6 +36,7 @@
eq? eqv? equal?
= < > <= >= zero?
+ * - / 1- 1+ quotient remainder modulo
ash logand logior logxor
not
pair? null? list? acons cons cons*