---------------------------------------------------------------------- -- Title : BitsAKD -- Version : 1.0 -- Copyright : (C) 1994 David Wallace Croft. All rights reserved. -- Author : David Wallace Croft, CompuServe [76600,102] -- Compiler : Meridian OpenAda for DOS -- Description : Bit manipulation ---------------------------------------------------------------------- with Bit_Ops; package BitsAKD is ---------------------------------------------------------------------- ---------------------------------------------------------------------- Copyright : constant string := "BitsAKD (C) 1994 David Wallace Croft. All rights reserved."; Description : constant string := "Bit manipulation."; ---------------------------------------------------------------------- subtype Word_Type is integer; -- -32_768..32_767 = 16#FFFF#..16#7FFF#; subtype Byte_Type is byte_integer; subtype Double_Word_Type is long_integer; subtype Num_Bits_Type is integer range 0..32; -- Int32'size/Word_Type'size? ---------------------------------------------------------------------- Bit0_Byte : constant Byte_Type := 2#00000001#; Bit1_Byte : constant Byte_Type := 2#00000010#; Bit2_Byte : constant Byte_Type := 2#00000100#; Bit3_Byte : constant Byte_Type := 2#00001000#; Bit4_Byte : constant Byte_Type := 2#00010000#; Bit5_Byte : constant Byte_Type := 2#00100000#; Bit6_Byte : constant Byte_Type := 2#01000000#; Bit7_Byte : constant Byte_Type := -128; -- 2#10000000#; ---------------------------------------------------------------------- Bit0_Word : constant Word_Type := 2#00000000_00000001#; Bit1_Word : constant Word_Type := 2#00000000_00000010#; Bit2_Word : constant Word_Type := 2#00000000_00000100#; Bit3_Word : constant Word_Type := 2#00000000_00001000#; Bit4_Word : constant Word_Type := 2#00000000_00010000#; Bit5_Word : constant Word_Type := 2#00000000_00100000#; Bit6_Word : constant Word_Type := 2#00000000_01000000#; Bit7_Word : constant Word_Type := 2#00000000_10000000#; Bit8_Word : constant Word_Type := 2#00000001_00000000#; Bit9_Word : constant Word_Type := 2#00000010_00000000#; Bit10_Word : constant Word_Type := 2#00000100_00000000#; Bit11_Word : constant Word_Type := 2#00001000_00000000#; Bit12_Word : constant Word_Type := 2#00010000_00000000#; Bit13_Word : constant Word_Type := 2#00100000_00000000#; Bit14_Word : constant Word_Type := 2#01000000_00000000#; Bit15_Word : constant Word_Type := -32_768; -- 2#10000000_00000000# ---------------------------------------------------------------------- -- Bit_Ops renamed for Byte_Type ---------------------------------------------------------------------- function "And" ( Left, Right: in Byte_Type ) return Byte_Type renames Bit_Ops."And"; function "Or" ( Left, Right: in Byte_Type ) return Byte_Type renames Bit_Ops."Or"; function "XOr" ( Left, Right: in Byte_Type ) return Byte_Type renames Bit_Ops."XOr"; function "Not" ( Byte : in Byte_Type ) return Byte_Type renames Bit_Ops."Not"; function ShL ( Byte : Byte_Type; Num_Bits : Num_Bits_Type ) return Byte_Type renames Bit_Ops.ShL; function ShR ( Byte : Byte_Type; Num_Bits : Num_Bits_Type ) return Byte_Type renames Bit_Ops.ShR; --------------------------------------------------------------------------- -- Bit_Ops renamed for Word_Type ---------------------------------------------------------------------- function "And" ( Left, Right: in Word_Type ) return Word_Type renames Bit_Ops."And"; function "Or" ( Left, Right: in Word_Type ) return Word_Type renames Bit_Ops."Or"; function "XOr" ( Left, Right: in Word_Type ) return Word_Type renames Bit_Ops."XOr"; function "Not" ( Word : Word_Type ) return Word_Type renames Bit_Ops."Not"; function ShL ( Word : Word_Type; Num_Bits : Num_Bits_Type ) return Word_Type renames Bit_Ops.ShL; function ShR ( Word : in Word_Type; Num_Bits : Num_Bits_Type ) return Word_Type renames Bit_Ops.ShR; ---------------------------------------------------------------------- -- Bit_Ops renamed for Double_Word_Type ---------------------------------------------------------------------- function "And" ( Left, Right: in Double_Word_Type ) return Double_Word_Type renames Bit_Ops."And"; function "Or" ( Left, Right: in Double_Word_Type ) return Double_Word_Type renames Bit_Ops."Or"; function "XOr" ( Left, Right: in Double_Word_Type ) return Double_Word_Type renames Bit_Ops."XOr"; function "Not" ( Double_Word: in Double_Word_Type ) return Double_Word_Type renames Bit_Ops."Not"; function ShL ( Double_Word : Double_Word_Type; Num_Bits : Num_Bits_Type ) return Double_Word_Type renames Bit_Ops.ShL; function ShR ( Double_Word : Double_Word_Type; Num_Bits : Num_Bits_Type ) return Double_Word_Type renames Bit_Ops.ShR; --------------------------------------------------------------------------- -- unique ---------------------------------------------------------------------- function Bits_Are_Set ( Byte : Byte_Type; Bit_Mask : Byte_Type ) return boolean; function Bits_Are_Set ( Word : Word_Type; Bit_Mask : Word_Type ) return boolean; function Clear_Bits ( Byte : Byte_Type; Bit_Mask : Byte_Type ) return Byte_Type; function Clear_Bits ( Word : Word_Type; Bit_Mask : Word_Type ) return Word_Type; procedure Demo; function Get_Byte ( Word : Word_Type; Low_Byte : boolean := true ) return Byte_Type; function Set_Bits ( Byte : Byte_Type; Bit_Mask : Byte_Type ) return Byte_Type; function Set_Bits ( Word : Word_Type; Bit_Mask : Word_Type ) return Word_Type; function Set_Byte ( Word : Word_Type; New_Byte : Byte_Type; Low_Byte : boolean := true ) return Word_Type; function Shift_Bits ( Word : Word_Type; Num_Bits : Num_Bits_Type := 1; Left : boolean := true ) return Word_Type; function Shift_Bits ( Double_Word : Double_Word_Type; Num_Bits : Num_Bits_Type := 1; Left : boolean := true ) return Double_Word_Type; --------------------------------------------------------------------------- end BitsAKD;