/* These three procedures implement the equivalents nof the Fortran */ /* functions BTEST, IBSET, and IBCLR. */ /* There are companion procedures that require the macro processor that */ /* do it more efficiently. */ /* Copyright (c) 2001 by R. A. Vowels. Date written 10/11/2001. */ %declare precision character; %precision = 31; /* In the following procedures, the bit position

is measured from the */ /* least-significant end of the integer; bits number from 0 through . */ /* Test bit (p) of . The result is BIT(1). */ btest: procedure (a, p) returns (bit(1)); declare a fixed binary (precision), p fixed binary (7); return ( iand (a, isll (1, p)) ^= 0 ); end btest; /* Set bit

of . The result is FIXED BINARY. */ ibset: procedure (a, p) returns (fixed binary (precision)); declare a fixed binary (precision), p fixed binary (precision); return ( ior (a, isll (1, p)) ); end ibset; /* Clear bit

of . The result is FIXED BINARY. */ ibclr: procedure (a, p) returns (fixed binary (precision)); declare a fixed binary (precision), p fixed binary (7); return ( iand (a, inot(isll (1, p))) ); end ibclr; /* Extract 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;