bits from a binary integer value, beginning at bit . */
/* Bits in positions
through positions
+ - 1 are taken. */
/* The extracted bits are then brought to the least significant end of the */
/* integer. */
(nofixedoverflow):
ibits:
procedure (a, p, len) returns (fixed binary (precision));
declare a fixed binary (precision), p fixed binary (7);
declare k fixed binary (precision);
k = isrl(a, p); /* remove p low-order bits. */
if len > precision then return (k);
if len > 0 then
return ( iand (isrl(a, p), isll (1, len)-1) );
else
return (a);
end ibits;
declare ishftc generic (
ishftc2 when (*, *),
ishftc3 when (*, *, *));
/* Perforns a circular shift to the left or to the right. */
/* If No_Positions > 0, the shift is to the left; */
/* otherwise the shift is to the right. */
/* Date written 16 November 2001. */
(nofixedoverflow):
ishftc2:
procedure (a, No_Positions) returns (fixed binary (precision));
declare a fixed binary (precision), No_positions fixed binary (7);
if No_Positions > 0 then
return ( ior (isll(a, No_Positions), isrl (a, precision+1-No_Positions)));
else
return ( ior (isrl(a, No_Positions), isll (a, precision+1-No_Positions)));
end ishftc2;
/* Performs a circular shift of the least-significant bits. */
/* If No_Positions > 0, the shift is to the left; */
/* otherwise the shift is to the right. */
/* Date written 16 November 2001. */
(nofixedoverflow):
ishftc3:
procedure (a, No_Positions, len) returns (fixed binary (precision));
declare a fixed binary (precision), No_positions fixed binary (7);
declare len fixed binary (precision);
declare (upper_bits, lower_bits, mask) fixed binary (precision);
if len > precision then return (ishftc(a, No_Positions));
mask = isrl(-1, precision+1-len);
lower_bits = iand(a, mask);
upper_bits = iand(a, inot(mask));
if No_Positions > 0 then
return ( ior (upper_bits,
iand(isll(lower_bits, No_Positions), mask),
isrl (lower_bits, len-No_Positions)));
else
return ( ior (upper_bits,
iand(isll(lower_bits, len+No_Positions), mask),
isrl (lower_bits, -No_Positions)));
end ishftc3;