-------- SIMTEL20 Ada Software Repository Prologue ------------ -- -* -- Unit name : package LOGICAL -- Version : 1.0 -- Author : Joseph M. Orost -- : Concurrent Computer Corporation -- : 106 Apple St. -- : Tinton Falls, NJ 07724 -- DDN Address : vax135!petsd!joe@BERKELEY -- Copyright : ** not copyright ** -- Date created : June 1, 1986 -- Release date : June 13, 1986 -- Last update : -- Machine/System Compiled/Run on : CCUR_3200MPS, C3-Ada R00-00 -- -* --------------------------------------------------------------- -- -* -- Keywords : LOGICAL OPERATIONS -- -- Abstract : This package provides logical operations ----------------: such as AND, OR, XOR, NOT, SHIFT, ROTATE, ----------------: on operands of type INTEGER. It is portable ----------------: to any two's complement machine. For ----------------: increased efficiency, the body can be ----------------: re-implemented via PRAGMA interface(assembler. -- -* ------------------ Revision history --------------------------- -- -* -- DATE VERSION AUTHOR HISTORY -- 06/13/86 1.0 Orost Initial Release -- -* ------------------ Distribution and Copyright ----------------- -- -* -- This software is released to the Ada community. -- This software is released to the Public Domain (note: -- software released to the Public Domain is not subject -- to copyright protection). -- Restrictions on use or distribution: NONE -- -* ------------------ Disclaimer --------------------------------- -- -* -- This software and its documentation are provided "AS IS" and -- without any expressed or implied warranties whatsoever. -- No warranties as to performance, merchantability, or fitness -- for a particular purpose exist. -- -- Because of the diversity of conditions and hardware under -- which this software may be used, no warranty of fitness for -- a particular purpose is offered. The user is advised to -- test the software thoroughly before relying on it. The user -- must assume the entire risk and liability of using this -- software. -- -- In no event shall any person or organization of people be -- held responsible for any direct, indirect, consequential -- or inconsequential damages or lost profits. -- -* -------------------END-PROLOGUE-------------------------------- package logical is -- return arg rotated count bits. -- If count < 0, rotate is to the right, -- else, rotate is to the left. function rotate(arg, count : integer) return integer; -- return arg logically shifted count bits. -- bits shifted out either end are lost -- If count < 0, shift is to the right, -- else, shift is to the left function shift(arg, count : integer) return integer; -- return left XOR right function "xor"(left, right : integer) return integer; --return left AND right function "and"(left, right : integer) return integer; --return left OR right function "or" (left, right : integer) return integer; --return NOT right function "not"(right : integer) return integer; end logical; --- package body logical is -- These functions work on all two's complement machines -- where -integer'last-1 = integer'first two_to_the_i : array(integer(0)..integer(integer'size-1)) of integer; --Utility function to rotate left function rotate(arg, count : integer) return integer is result : integer := arg; big : CONSTANT integer := integer'last/2+1; c : integer := count; begin if c < 0 then c := integer'size + c; end if; for i in 1..(c MOD integer'size) loop if result < 0 then -- -16#80000000#..-1 result := result + big; if result >= 0 then result := result * 2 - integer'last; else result := (result + big) * 2 + 1; end if; elsif result < big then -- 0 .. 16#3FFFFFFF# result := result * 2; else -- 16#40000000#..16#7FFFFFFF# result := (result - big) * 2 - integer'last; result := result - 1; end if; end loop; return result; end rotate; -- --Utility function to logical shift function shift(arg, count : integer) return integer is result : integer := arg; big : CONSTANT integer := integer'last/2+1; c : integer; begin -- shift if count < 0 then --shift to the right c := -count; if c >= integer'size then return 0; end if; if result >= 0 then result := result / two_to_the_i(c); else result := result + integer'last; result := (result + 1) / two_to_the_i(c) + big / two_to_the_i(c - 1); end if; elsif count > 0 then --shift to the left if count >= integer'size then return 0; end if; for i in 1..count loop if result < 0 then --top bit gets shifted out result := result + integer'last; result := result + 1; end if; if result >= big then result := ((result - big) * 2 - integer'last); result := result - 1; else result := result * 2; end if; end loop; end if; return result; end shift; -- --Utility function to logical shift right 1 function shift_right_1(arg : integer) return integer is result : integer := arg; big : CONSTANT integer := integer'last/2+1; begin -- shift_right_1 if result >= 0 then result := result / 2; else result := result + integer'last; result := (result + 1) / 2 + big; end if; return result; end shift_right_1; -- --Utility function to exclusive or function "xor"(left, right : integer) return integer is result : integer := 0; a1 : integer := left; a2 : integer := right; begin -- "xor" for i in integer(0)..integer'size-1 loop result := shift_right_1(result); if a1 MOD 2 /= a2 MOD 2 then result := result - integer'last; result := result - 1; end if; a1 := shift_right_1(a1); a2 := shift_right_1(a2); end loop; return result; end "xor"; -- --Utility function to and function "and"(left, right : integer) return integer is result : integer := 0; a1 : integer := left; a2 : integer := right; begin -- "and" for i in integer(0)..integer'size-1 loop result := shift_right_1(result); if (a1 MOD 2) + (a2 MOD 2) = 2 then result := result - integer'last; result := result - 1; end if; a1 := shift_right_1(a1); a2 := shift_right_1(a2); end loop; return result; end "and"; -- --Utility function to or function "or"(left, right : integer) return integer is result : integer := 0; a1 : integer := left; a2 : integer := right; begin -- "or" for i in integer(0)..integer'size-1 loop result := shift_right_1(result); if (a1 MOD 2) + (a2 MOD 2) /= 0 then result := result - integer'last; result := result - 1; end if; a1 := shift_right_1(a1); a2 := shift_right_1(a2); end loop; return result; end "or"; -- function "not"(right : integer) return integer is begin if right /= integer'first and then right /= integer'first + 1 then return (-1)-right; else return -(right + 1); end if; end "not"; -- begin for i in two_to_the_i'first..two_to_the_i'last-1 loop two_to_the_i(i) := 2**i; end loop; two_to_the_i(two_to_the_i'last) := (-2)**two_to_the_i'last; end logical;