## machine-int.pkg
#
# How to evaluate constants for various widths.
#
# Internally, we represent machine_int as a signed integer.
# So when we do bit or unsigned operations we have to convert to
# the unsigned representation first.
# Compiled by:
# src/lib/compiler/back/low/lib/lowhalf.lib### "What we need are notions, not notations."
###
### -- Carl Friedrich Gauss
stipulate
package ntr = multiword_int; # multiword_int is from src/lib/std/multiword-int.pkg package str = string; # string is from src/lib/std/string.pkg package ns = number_string; # number_string is from src/lib/std/src/number-string.pkg package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg #
max_size = 65;
herein
package machine_int
: (weak) Machine_Int # Machine_Int is from src/lib/compiler/back/low/treecode/machine-int.api {
Machine_Int = ntr::Int;
Sz = Int;
Div_Rounding_Mode
= DIV_TO_ZERO
| DIV_TO_NEGINF
;
itow = unt::from_int;
# Parse hex or binary, but not octal: # XXX BUGGO FIXME
hex_to_int = ns::scan_string (ntr::scan ns::HEX);
bin_to_int = ns::scan_string (ntr::scan ns::BINARY);
# Precompute some tables for faster arithmetic
#
stipulate
pow2table = rwv::from_fn
(
max_size,
\\ n = ntr::(<<) (1, itow n) # 2^n
);
masktable = rwv::from_fn
(
max_size,
\\ n = ntr::(-) (ntr::(<<) (1, itow n), 1) # 2^n-1
);
maxtable = rwv::from_fn
(
max_size+1,
\\ 0 => 0;
n => ntr::(-) (ntr::(<<) (1, itow (n - 1)), 1); # 2^{ n-1 }-1
end
);
mintable = rwv::from_fn
(
max_size+1,
\\ 0 => 0;
n => ntr::neg (ntr::(<<) (1, itow (n - 1))); # -2^{ n-1 }
end
);
herein
fun pow2 i = if (i < max_size) rwv::get (pow2table, i);
else ntr::(<<) (1, itow i);
fi;
fun mask_of size = if (size < max_size) rwv::get (masktable, size);
else ntr::(-) (ntr::(<<) (1, itow size), 1);
fi;
fun max_of_size size = if (size < max_size) rwv::get (maxtable, size);
else ntr::(-) (ntr::(<<) (1, itow (size - 1)), 1);
fi;
fun min_of_size size = if (size < max_size) rwv::get (mintable, size);
else ntr::neg (ntr::(<<) (1, itow (size - 1)));
fi;
end;
# Queries:
#
fun is_neg i = ntr::sign i < 0;
fun is_pos i = ntr::sign i > 0;
fun is_zero i = ntr::sign i == 0;
fun is_non_neg i = ntr::sign i >= 0;
fun is_non_pos i = ntr::sign i <= 0;
#
fun is_even i = is_zero (ntr::rem (i, 2));
fun is_odd i = not (is_even i);
# To unsigned representation:
#
fun unsigned (size, i)
=
if (is_neg i) ntr::(+) (i, pow2 size);
else i;
fi;
# To signed representation:
#
fun signed (size, i)
=
if (ntr::(>) (i, max_of_size size)) ntr::(-) (i, pow2 size);
else i;
fi;
# Narrow to the representation
# of a given type:
#
fun narrow (size, i)
=
signed (size, ntr::bitwise_and (i, mask_of size));
# Recognize 0x and 0b prefix
# and do the right thing:
#
fun from_string (size, s)
=
{ n = str::length_in_bytes s;
#
fun conv (i, negate)
=
if (n >= 2+i
and
str::get_byte_as_char (s, i) == '0'
)
case (str::get_byte_as_char (s, i+1))
#
'x' => (hex_to_int (str::substring (s, 2+i, n - 2-i)), negate);
'b' => (bin_to_int (str::substring (s, 2+i, n - 2-i)), negate);
_ => (ntr::from_string s, FALSE);
esac;
else
(ntr::from_string s, FALSE);
fi;
my (result, negate)
=
if (s == "") (NULL, FALSE);
elif (str::get_byte_as_char (s, 0) == '-') conv (1, TRUE );
else conv (0, FALSE);
fi;
case (result, negate)
#
(THE n, TRUE ) => THE (narrow (size, ntr::neg n));
(THE n, FALSE) => THE (narrow (size, n));
(NULL, _ ) => NULL;
esac;
};
# Convert types into 'integer'
# without losing precision:
#
package convert {
#
package w = unt; # unt is from src/lib/std/unt.pkg package w32= one_word_unt; # one_word_unt is from src/lib/std/one-word-unt.pkg wtoi = w::to_int_x;
w32toi = w32::to_int_x;
from_int = ntr::from_int;
from_int1 = one_word_int::to_multiword_int;
fun from_unt w = ntr::from_multiword_int (unt::to_multiword_int w);
fun from_unt1 w = ntr::(+) (ntr::(<<) (ntr::from_int (w32toi((w32::(>>))(w, 0u16))), 0u16),
ntr::from_int (w32toi (w32::bitwise_and (w, 0uxffff))));
};
# machine_int <-> other types
#
fun from_int (size, i) = narrow (size, convert::from_int i);
fun from_int1 (size, i) = narrow (size, convert::from_int1 i);
fun from_unt (size, w) = narrow (size, convert::from_unt w);
fun from_unt1 (size, w) = narrow (size, convert::from_unt1 w);
#
fun to_string (size, i) = ntr::to_string i;
to_hex = ntr::format ns::HEX;
to_bin = ntr::format ns::BINARY;
fun to_hex_string (size, i) = "0x" + to_hex (unsigned (size, i));
fun to_bin_string (size, i) = "0b" + to_bin (unsigned (size, i));
fun to_int (size, i) = ntr::to_int (narrow (size, i));
fun to_unt (size, i) = unt::from_multiword_int (ntr::to_multiword_int (unsigned (size, i)));
fun to_unt1 (size, i)
=
{ i = unsigned (size, i);
lo = ntr::bitwise_and (i, 0xffff);
hi = ntr::(>>>) (i, 0u16);
fun tow32 i
=
one_word_unt::from_multiword_int (ntr::to_multiword_int i);
tow32 lo + (one_word_unt::(<<))(tow32 hi, 0u16);
};
fun to_int1 (size, i)
=
one_word_int::from_multiword_int (narrow (size, i));
fun hash i
=
unt::from_int (ntr::to_int (ntr::bitwise_and (i, 0x1fffffff)));
fun is_in_range (size, i)
=
ntr::(<=) (min_of_size size, i) and ntr::(<=) (i, max_of_size size);
fun signed_bin_op f (size, i, j)
=
narrow (size, f (i, j));
fun signed_unary_op f (size, i)
=
narrow (size, f i);
fun unsigned_bin_op f (size, i, j)
=
narrow (size, f (unsigned (size, i), unsigned (size, j)));
fun trapping_unary_op f (size, i)
=
{ x = f i;
if (is_in_range (size, x) ) x;
else raise exception OVERFLOW;fi;
};
fun trapping_bin_op f (size, i, j)
=
{ x = f (i, j);
if (is_in_range (size, x) ) x;
else raise exception OVERFLOW;fi;
};
# two's complement operators
neg = signed_unary_op ntr::neg ;
abs = signed_unary_op ntr::abs ;
add = signed_bin_op ntr::(+) ;
sub = signed_bin_op ntr::(-) ;
muls = signed_bin_op ntr::(*) ;
fun divs (DIV_TO_ZERO, type, x, y) => signed_bin_op ntr::quot (type, x, y);
divs (DIV_TO_NEGINF, type, x, y) => signed_bin_op ntr::(/) (type, x, y);
end;
fun rems (DIV_TO_ZERO, type, x, y) => signed_bin_op ntr::rem (type, x, y);
rems (DIV_TO_NEGINF, type, x, y) => signed_bin_op ntr::(%) (type, x, y);
end;
mulu = unsigned_bin_op ntr::(*) ;
divu = unsigned_bin_op ntr::(/) ;
/*
quotu = unsignedBinOp ntr::quot ;
*/
remu = unsigned_bin_op ntr::rem ;
negt = trapping_unary_op ntr::neg ;
abst = trapping_unary_op ntr::abs ;
addt = trapping_bin_op ntr::(+) ;
subt = trapping_bin_op ntr::(-) ;
mult = trapping_bin_op ntr::(*) ;
fun divt (DIV_TO_ZERO, type, x, y) => trapping_bin_op ntr::quot (type, x, y);
divt (DIV_TO_NEGINF, type, x, y) => trapping_bin_op ntr::(/) (type, x, y);
end;
fun bitwise_not (size, x) = narrow (size, ntr::bitwise_not x);
fun eqvb (size, x, y) = narrow (size, ntr::bitwise_xor (ntr::bitwise_not x, y));
fun bitwise_and (size, x, y) = narrow (size, ntr::bitwise_and (x, y));
fun bitwise_or (size, x, y) = narrow (size, ntr::bitwise_or (x, y));
fun bitwise_xor (size, x, y) = narrow (size, ntr::bitwise_xor (x, y));
fun sll (size, x, y) = narrow (size, ntr::(<<) (x, y));
fun srl (size, x, y) = narrow (size, ntr::(>>>) (unsigned (size, x), y));
fun sra (size, x, y) = narrow (size, ntr::(>>>) (x, y));
fun sll_x (size, x, y) = sll (size, x, to_unt (size, y));
fun srl_x (size, x, y) = srl (size, x, to_unt (size, y));
fun sra_x (size, x, y) = sra (size, x, to_unt (size, y));
fun bitslice (size, sl, x)
=
{ fun slice ([], n) => n;
slice ((from, to) ! sl, n)
=>
slice (sl, bitwise_or (size, narrow (to-from+1,
srl (size, x, unt::from_int from)), n));
end;
slice (sl, 0);
};
fun bit_of (size, i, b)
=
to_unt (1, narrow (1, srl (size, i, unt::from_int b)));
fun byte_of (size, i, b)
=
to_unt (8, narrow (8, srl (size, i, unt::from_int (b*8))));
fun half_of (size, i, h)
=
to_unt (16, narrow (16, srl (size, i, unt::from_int (h*16))));
fun word_of (size, i, w)
=
to_unt1 (32, narrow (32, srl (size, i, unt::from_int (w*32))));
# type promotion
#
fun sx (to_size, from_size, i) = narrow (to_size, narrow (from_size, i));
fun zx (to_size, from_size, i) = narrow (to_size, unsigned (from_size, narrow (from_size, i)));
# Comparisions
#
fun eq (size, i: ntr::Int, j) = i == j;
fun ne (size, i: ntr::Int, j) = i != j;
fun gt (size, i: ntr::Int, j) = i > j;
fun ge (size, i: ntr::Int, j) = i >= j;
fun lt (size, i: ntr::Int, j) = i < j;
fun le (size, i: ntr::Int, j) = i <= j;
fun ltu (size, i, j) = unsigned (size, i) < unsigned (size, j);
fun gtu (size, i, j) = unsigned (size, i) > unsigned (size, j);
fun leu (size, i, j) = unsigned (size, i) <= unsigned (size, j);
fun geu (size, i, j) = unsigned (size, i) >= unsigned (size, j);
# Split an integer "i" of size "size" into words of size "word_size"
#
fun split { size, word_size, i }
=
loop (size, unsigned (size, i), [])
where
fun loop (size, i, ws)
=
if (size <= 0)
#
reverse ws;
else
w = narrow (word_size, i);
i = multiword_int::(>>>) (i, unt::from_int word_size);
loop (size - word_size, i, w ! ws);
fi;
end;
}; # package machine_int
end; # stipulate