-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : Bit_Functions
-- Version      : 1.0
-- Author       : Freeman L. Moore
--              : P.O. Box 801 M/S 8006
--              : Texas Instruments, Inc.
--              : McKinney, Texas   75069
-- DDN Address  : FMOORE%TI-EG@CSNET-RELAY
-- Copyright    : (c) 1985
-- Date created : February 1985
-- Release date : June 1985
-- Last update  : June 1985
-- Machine/System Compiled/Run on :
--                DG MV/1000, Rolm/ADE version 2.20          -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     : bit functions, shifting, masks
----------------:
--
-- Abstract     : This package represents a collection of
----------------: routines which allow the Ada programmer
--              : the ability of perform bit operations on
--              : objects of type INTEGER.  The functions
--              : include the ability to extract/insert bit
--              : fields, shift objects left or right,
--              : and/or objects and create bit masks.
--              :
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION AUTHOR                  HISTORY
-- Feb 85        1.0    Freeman Moore           original
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- 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 BIT_FUNCTIONS is
-- 
--   This package allows the Ada programmer to manipulate the bits
--   within an object of type INTEGER.  The bits are numbers from
--   the right to the left, starting with number zero.
-- 
--           +------------------------+
--           +  15 14 13 ...  3 2 1 0 !
--           +------------------------+
-- 
--      In each routine, the number of bits being manipulated
--      is NBITS.  START_AT identifies the right most bit of NBITS field.
-- 
--      e.g.
--           ...  6 5 4 3 2 1 0
--                    X X X         nbits = 3
--                                  start_at = 2
-- 
-- 
    function BIT_EXTRACT (ITEM, START_AT, NBITS : INTEGER) return INTEGER;
--      Return the bit field extracted from ITEM, as a signed integer;
-- 
    function UBIT_EXTRACT (ITEM, START_AT, NBITS : INTEGER) return INTEGER;
--      return the bit field extracted from ITEM, unsigned integer;
-- 
    function BIT_INSERT (THIS_ITEM, NBITS, INTO_ITEM, START_AT : INTEGER)
                          return INTEGER;
--      insert NBITS from THIS_ITEM into the object INTO_ITEM,
--      with the rightmost bit identified by START_AT.
-- 
    function BIT_REMOVE (ITEM, START_AT, NBITS : INTEGER) return INTEGER;
--      BIT_REMOVE will zero out NBITS of ITEM at position START_AT
-- 
    function SHIFT_LEFT (ITEM, NBITS : INTEGER) return INTEGER;
--      return ITEM shifted left by NBITS
-- 
    function SHIFT_RIGHT (ITEM, NBITS : INTEGER) return INTEGER;
--      return ITEM shifted right by NBITS
-- 
    function BIT_AND (WORD1, WORD2 : INTEGER) return INTEGER;
--      return the AND of the two objects
-- 
    function BIT_OR (WORD1, WORD2 : INTEGER) return INTEGER;
--      return the OR of the two objects
-- 
    function BIT_MASK (NBITS : INTEGER) return INTEGER;
--      return an object with NBITS of one bits, right justified
-- 
end BIT_FUNCTIONS;


package body BIT_FUNCTIONS is
--
--  Implementation notes:
--      this package uses integer arithmetic (mult by 2 and divide by 2)
--      to accomplish most of the work involved.
--
--  The ideal implementation would be similar to the following:
--
--      OBJECT : INTEGER;
--      type BIT_WORD is array (1..16) of BOOLEAN;
--      pragma PACK (BIT_WORD)
--      BIT_OBJECT : BIT_WORD;
--      for BIT_OBJECT use at OBJECT'ADDRESS;
--
--      This effectively defined BIT_OBJECT as a bit array, physically
--      located at the same memory location as OBJECT.  As a bit array,
--      slices and boolean operations can be used!  Unfortunately,
--      the DG/Rolm ADE software does not support the address rep spec.
--
--
    WORD_SIZE : constant := 16; -- ASSUME 16 BIT WORDS!

    function BIT_EXTRACT (ITEM, START_AT, NBITS : INTEGER) return INTEGER is
        TEMP      : INTEGER;
        BIT_VALUE : INTEGER;
        RESULT    : INTEGER;
    begin
        TEMP := SHIFT_RIGHT (ITEM, START_AT);
        BIT_VALUE := (TEMP mod 2 ** NBITS);

        if BIT_VALUE <= INTEGER'LAST then
            RESULT := BIT_VALUE;
        else
            RESULT := BIT_VALUE - INTEGER'LAST;
        end if;

        return RESULT;
    end BIT_EXTRACT;

    function UBIT_EXTRACT (ITEM, START_AT, NBITS : INTEGER) return INTEGER is
        TEMP : INTEGER;
    begin
        TEMP := SHIFT_RIGHT (ITEM, START_AT);
        return TEMP mod (2 ** NBITS);
    end UBIT_EXTRACT;

    function BIT_INSERT (THIS_ITEM, NBITS, INTO_ITEM, START_AT : INTEGER)
                          return INTEGER is
        ITEM : INTEGER;
    begin
        ITEM := THIS_ITEM mod (2 ** NBITS); -- restrict value to size
        return BIT_REMOVE (INTO_ITEM, START_AT, NBITS) +
               SHIFT_LEFT (ITEM, START_AT);
    end BIT_INSERT;

    function BIT_REMOVE (ITEM, START_AT, NBITS : INTEGER) return INTEGER is
        KEEP : INTEGER := 0;
        TEMP : INTEGER;
    begin
        if START_AT /= 0 then
            KEEP := ITEM mod (2 ** START_AT);
        end if;

        TEMP := SHIFT_RIGHT (ITEM, START_AT + NBITS);
        return SHIFT_LEFT (TEMP, START_AT + NBITS) + KEEP;
    end BIT_REMOVE;

    function SHIFT_LEFT (ITEM, NBITS : INTEGER) return INTEGER is
    begin
        return ITEM * (2 ** NBITS);
    end SHIFT_LEFT;

    function SHIFT_RIGHT (ITEM, NBITS : INTEGER) return INTEGER is
    begin
        return ITEM / (2 ** NBITS);
    end SHIFT_RIGHT;

    function BIT_AND (WORD1, WORD2 : INTEGER) return INTEGER is
        SPARE1              : INTEGER := WORD1;
        SPARE2              : INTEGER := WORD2;
        NEW_WORD            : INTEGER := 0;
        BIT1, BIT2, NEW_BIT : INTEGER;

    begin
--
--  the approach here to extract a single bit at a time from each
--  word, and then decide upon the logical property.  The loop
--  continues until all bits of the word have been considered,
--  or until the words become zero in the shifting process.
--

        for INDEX in 1 .. WORD_SIZE loop
            exit when SPARE1 = 0 and SPARE2 = 0;
            BIT1 := SPARE1 mod 2; -- get rightmost bit
            BIT2 := SPARE2 mod 2;

            if BIT1 = 1 and BIT2 = 1 then
                NEW_BIT := 1;     -- decide upon new bit value
            else
                NEW_BIT := 0;
            end if;

            NEW_WORD := NEW_WORD + SHIFT_LEFT (NEW_BIT, INDEX - 1);
            SPARE1 := SHIFT_RIGHT (SPARE1, 1);
            SPARE2 := SHIFT_RIGHT (SPARE2, 1);
        end loop;

        return NEW_WORD;
    end BIT_AND;

    function BIT_OR (WORD1, WORD2 : INTEGER) return INTEGER is
        SPARE1              : INTEGER := WORD1;
        SPARE2              : INTEGER := WORD2;
        NEW_WORD            : INTEGER := 0;
        BIT1, BIT2, NEW_BIT : INTEGER;

    begin
--  processing is identical to BIT_AND, except the logical test is changed
        for INDEX in 1 .. WORD_SIZE loop
            exit when SPARE1 = 0 and SPARE2 = 0;
            BIT1 := SPARE1 mod 2;
            BIT2 := SPARE2 mod 2;

            if BIT1 = 1 or BIT2 = 1 then
                NEW_BIT := 1;
            else
                NEW_BIT := 0;
            end if;

            NEW_WORD := BIT_INSERT (NEW_BIT, 1, NEW_WORD, INDEX - 1);
            SPARE1 := SHIFT_RIGHT (SPARE1, 1);
            SPARE2 := SHIFT_RIGHT (SPARE2, 1);
        end loop;

        return NEW_WORD;
    end BIT_OR;

    function BIT_MASK (NBITS : INTEGER) return INTEGER is
        RESULT : INTEGER := 0;
    begin
        for INDEX in 1 .. NBITS loop
            RESULT := RESULT * 2 + 1;
        end loop;

        return RESULT;
    end BIT_MASK;

end BIT_FUNCTIONS;