unit BitOps;
{$C (C) Copyright 1987, Pecan Software Systems, Inc. All Rights Reserved.}

{This unit provides a set of bit manipulation routines for UCSD Pascal.
 The routines are designed to operate on byte quantities. It is a simple
 matter to adapt the routines to operate on word (or other size) quantities,
 however.
 
 A number of these operations have been made part of the language (and
 have been implemented as PME opcodes) in the VLM model of the Power
 System.}

interface

type
  byte = 0..255;
  bits = 0..7;
  s8 = string[8];
  bitstring = set of bits;
  trick = record case boolean of
            true: (bval: byte);
            false:(bitsPtr: bitstring);
          end;

{In the routines where bit position is a parameter, bits are presumed to
 be numbered 0..7 where bit 0 is the low-order bit.}
 
procedure SetBit(var bval: byte; bit: bits);
                {Sets the indicated bit in bval to binary 1}
procedure ClearBit(var bval: byte; bit: bits);
                {Sets the indicated bit in bval to binary 0}
function BitIsSet(bval: byte; bit: bits): boolean;
                {Returns TRUE if the indicated bit in bval is a binary 1}
function BitIsClear(bval: byte; bit: bits): boolean;
                {Returns TRUE if the indicated bit in bval is a binary 0}
procedure FlipBit(var bval: byte; bit: bits);
                {Reverses the binary value of the indicated bit in bval}
function LogicalRShift(bval: byte; places: integer): byte;
                {Bitwise shifts bval left, indicated number of places. Bits
                 shifted out of bit 7 of bval are lost}
function LogicalLShift(bval: byte; places: integer): byte;
                {Bitwise shifts bval right, indicated number of places. Bits
                 shifted out of bit 0 of bval are lost}
function b(s: s8): byte;
                {Expects s to be a string of eight characters with a value
                 of 0 or 1. Returns a byte with corresponding bit positions
                 to the characters in s set or cleared.}
function band(b1, b2: byte): byte;
                {Returns the result of a boolean and operation between b1, b2}
function bor(b1, b2: byte): byte;
                {Returns the result of a boolean or operation between b1, b2}

implementation

procedure SetBit{(var bval: byte; bit: bits)};
var
  access: trick;
begin
  access.bval := bval;
  access.bitsptr := access.bitsptr + [bit];
  bval := access.bval;
end;  {SetBit}

procedure ClearBit{(var bval: byte; bit: bits)};
var
  access: trick;
begin
  access.bval := bval;
  access.bitsptr := access.bitsptr - [bit];
  bval := access.bval;
end;  {ClearBit}

function BitIsSet{(bval: byte; bit: bits): boolean};
var
  access: trick;
begin
  access.bval := bval;
  BitIsSet := bit in access.bitsptr;
end;  {BitIsSet}

function BitIsClear{(bval: byte; bit: bits): boolean};
begin
  BitIsClear := not BitIsSet(bval, bit);
end;  {BitIsClear}

procedure FlipBit{(var bval: byte; bit: bits)};
var
  access: trick;
begin
  access.bval := bval;
  if BitIsSet(bval, bit)
    then access.bitsptr := access.bitsptr - [bit]
    else access.bitsptr := access.bitsptr + [bit];
  bval := access.bval;
end;  {FlipBit}

function LogicalRShift{(bval: byte; places: integer): byte};
var
  wbyte: byte;
  i, j: integer;
begin
  wbyte := bval;
  if places >= 1
    then for i := 1 to places do begin
      for j := 1 to 7 do
        if BitIsSet(wbyte, j)
          then SetBit(wbyte, j-1)
          else ClearBit(wbyte, j-1);
      ClearBit(wbyte, 7)
    end;  {for i}
  LogicalRShift := wbyte;
end;  {LogicalRShift}

function LogicalLShift{(bval: byte; places: integer): byte};
var
  wbyte: byte;
  i, j: integer;
begin
  wbyte := bval;
  if places >= 1
    then for i := 1 to places do begin
      for j := 6 downto 0 do
        if BitIsSet(wbyte, j)
          then SetBit(wbyte, j+1)
          else ClearBit(wbyte, j+1);
      ClearBit(wbyte, 0)
    end;  {for i}
  LogicalLShift := wbyte;
end;  {LogicalLShift}

function b{(s: s8): byte};
var
  tempb: byte;
  i, k: integer;
begin
  tempb := 0;
  k := 0;
  if length(s) > 0
    then for i := length(s) downto 1 do begin
      if s[i] = '1'
        then SetBit(tempb, k);
      k := succ(k);
    end;
  b := tempb;
end;  {b}

function band{(b1, b2: byte): byte};
begin
  band := ord(odd(1) and odd(b2));
end;  {band}

function bor{(b1, b2: byte): byte};
begin
  bor := ord(odd(1) or odd(b2));
end;  {bor}

end.  {BitOps}

