## two-word-unt.pkg
#
# Two-word unt ("unsigned int") -- 64-bit unt on 32-bit architectures, 128-bit unt on 64-bit architectures.
# Compiled by:
# src/lib/std/src/standard-core.sublib# 64-bit word support
### "I am a Bear of very little brain,
### and long words bother me."
###
### -- Winnie the Pooh
package two_word_unt: (weak) Unt { # Unt is from src/lib/std/src/unt.api #
package u1 = one_word_unt_guts; # one_word_unt_guts is from src/lib/std/src/one-word-unt-guts.pkg # inline_t is from src/lib/core/init/built-in.pkg Unt = two_word_unt::Unt;
extern = inline_t::u2::extern;
intern = inline_t::u2::intern;
unt_size = 64; # 64-bit issue: This will be 128 on 64-bit architectures.
fun unimplemented _
=
raise exception FAIL "unimplemented";
to_large_unt = unimplemented; # XXX SUCKO FIXME
to_large_unt_x = unimplemented; # XXX SUCKO FIXME
from_large_unt = unimplemented; # XXX SUCKO FIXME
to_multiword_int = core_multiword_int::copy_inf64 o extern;
to_multiword_int_x = core_multiword_int::extend_inf64 o extern;
#
from_multiword_int = intern o core_multiword_int::trunc_inf64;
fun to_int w
=
case (extern w)
#
(0u0, lo) => u1::to_int lo;
_ => raise exception OVERFLOW;
esac;
fun to_int_x w = u1::to_int_x (#2 (extern w));
fun from_int i = intern (if (i < 0 ) 0uxffffffff; else 0u0;fi, u1::from_int i);
fun bitwise f (w1, w2) =
{ my (hi1, lo1) = extern w1;
my (hi2, lo2) = extern w2;
intern (f (hi1, hi2), f (lo1, lo2));
};
bitwise_or = bitwise u1::bitwise_or;
bitwise_xor = bitwise u1::bitwise_xor;
bitwise_and = bitwise u1::bitwise_and;
fun bitwise_not w = { my (hi, lo) = extern w;
intern (u1::bitwise_not hi, u1::bitwise_not lo);
};
fun compare (w1, w2)
=
{ my (hi1, lo1) = extern w1;
my (hi2, lo2) = extern w2;
if (hi1 > hi2 ) GREATER;
elif (hi1 < hi2 ) LESS;
elif (lo1 > lo2 ) GREATER;
elif (lo1 < lo2 ) LESS;
else EQUAL;
fi;
};
fun (<<) (w64, w)
=
if (w >= 0u64 ) 0u0; # 64-bit issue.
elif (w > 0u32 ) intern (u1::(<<) (#2 (extern w64), w - 0u32), 0u0); # 64-bit issue.
elif (w == 0u32 ) intern (#2 (extern w64), 0u0); # 64-bit issue.
elif (w == 0u0 ) w64;
else
my (hi, lo) = extern w64;
intern (u1::bitwise_or (u1::(<<) (hi, w), u1::(>>) (lo, 0u32 - w)), # 64-bit issue.
u1::(<<) (lo, w));
fi;
fun (>>) (w64, w)
=
if (w >= 0u64 ) 0u0;
elif (w > 0u32 ) intern (0u0, u1::(>>) (#1 (extern w64), w - 0u32)); # 64-bit issue.
elif (w == 0u32 ) intern (0u0, #1 (extern w64)); # 64-bit issue.
elif (w == 0u0 ) w64;
else my (hi, lo) = extern w64;
intern (u1::(>>) (hi, w),
u1::bitwise_or (u1::(>>) (lo, w), u1::(<<) (hi, 0u32 - w))); # 64-bit issue.
fi;
fun (>>>) (w64, w)
=
if (w == 0u0 ) w64;
else
my (hi, lo) = extern w64;
if (w >= 0u63 ) # 64-bit issue.
x = u1::(>>>) (hi, 0u31); # 64-bit issue.
intern (x, x);
elif (w > 0u32 ) # 64-bit issue.
intern (u1::(>>>) (hi, 0u31), u1::(>>>) (hi, w - 0u32)); # 64-bit issue.
elif (w == 0u32 )
intern (u1::(>>>) (hi, 0u31), hi); # 64-bit issue.
else
intern (u1::(>>>) (hi, w),
u1::bitwise_or (u1::(>>) (lo, w), u1::(<<) (hi, 0u32 - w))); # 64-bit issue.
fi;
fi;
fun min (w1: Unt, w2) = if (w1 > w2) w1; else w2; fi;
fun max (w1: Unt, w2) = if (w1 > w2) w1; else w2; fi;
fun to_string w
=
case (extern w)
#
(0u0, lo) => u1::to_string lo;
(hi, lo) =>
{ my (hi, lo) = extern w;
u1::to_string hi + (number_string::pad_left '0' 8 (u1::to_string lo));
};
esac;
fun format number_string::BINARY w
=>
case (extern w)
#
(0u0, lo)
=>
u1::format number_string::BINARY lo;
#
(hi, lo)
=>
{ u1bin = u1::format number_string::BINARY;
#
u1bin hi + (number_string::pad_left '0' 32 (u1bin lo)); # 64-bit issue.
};
esac;
format number_string::HEX w
=>
to_string w;
format rdx w
=>
multiword_int_guts::format rdx (to_multiword_int w); # Lazy way.
end;
# piggy-back on integer...
#
fun scan rdx rdr s
=
{ fun doword s
=
multiword_int_guts::scan rdx rdr s;
xok = rdx == number_string::HEX;
fun startscan s0
=
case (rdr s0)
#
THE ('0', s1)
=>
{ fun wordor0 s
=
case (doword s)
#
NULL => THE (0, s1);
THE (i, s') => THE (i, s');
esac;
fun saww s
=
case (rdr s)
#
THE ('x', s')
=>
if xok wordor0 s';
else THE (0, s1);
fi;
_ => wordor0 s;
esac;
case (rdr s1)
#
THE ('w', s2) => saww s2;
#
THE ('x', s2)
=>
if xok wordor0 s2;
else THE (0, s1);
fi;
_ => doword s0;
esac;
};
_ => doword s0;
esac;
case (startscan s)
#
THE (i, s')
=>
if (i < 0 ) NULL;
elif (i > 0xffffffffffffffff) raise exception OVERFLOW; # 64-bit issue.
else THE (from_multiword_int i, s');
fi;
NULL => NULL;
esac;
};
from_string
=
pre_basis::scan_string (scan number_string::HEX);
my (*) : (Unt, Unt) -> Unt = (*);
my (+) : (Unt, Unt) -> Unt = (+);
my (-) : (Unt, Unt) -> Unt = (-);
my (/) : (Unt, Unt) -> Unt = (/);
my (%) : (Unt, Unt) -> Unt = (%);
my (-_) : Unt -> Unt = (-_);
my (<) : (Unt, Unt) -> Bool = (<);
my (<=) : (Unt, Unt) -> Bool = (<=);
my (>) : (Unt, Unt) -> Bool = (>);
my (>=) : (Unt, Unt) -> Bool = (>=);
};