adtutils.pas.mcp

(* This file is a part of the PascalAdt library, which provides commonly
   used algorithms and data structures for the fpc and Delphi compilers.

   Copyright (C) 2004-2006 by Lukasz Czajka

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public License
   as published by the Free Software Foundation; either version 2.1 of
   the License, or (at your option) any later version.

   This library is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
   02110-1301 USA *)

unit adtutils;

{ This unit presents a few basic, simple utilities like Min, Max,
  Exchange, ...  }

interface

&# this must always be generated - needed by adtdarray
&define MCP_POINTER
&undefine MCP_NO_INTEGER

&include adtdefs.inc

&_mcp_generic_include(adtutils.i)

{ returns the smaller of two integers }
function Min(v1, v2 : Integer) : Integer;
{$ifdef OVERLOAD_DIRECTIVE }
overload;
{$endif }
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif }

{ returns the smallest of three integers. If your compiler does not
  support overloading use the second routine. @include-declarations 2 }
{$ifdef OVERLOAD_DIRECTIVE }
function Min(v1, v2, v3 : Integer) : Integer; overload;
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif }
{$endif OVERLOAD_DIRECTIVE }

function Min3(v1, v2, v3 : Integer) : Integer;


{ returns the larger of two integers }
function Max(v1, v2 : Integer) : Integer;
{$ifdef OVERLOAD_DIRECTIVE }
overload;
{$endif OVERLOAD_DIRECTIVE }
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif INLINE_DIRECTIVE }

{ Returns the largest of three integers. @include-declarations 2 }
{$ifdef OVERLOAD_DIRECTIVE }
function Max(v1, v2, v3 : Integer) : Integer; overload;
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif }
{$endif OVERLOAD_DIRECTIVE }

function Max3(v1, v2, v3 : Integer) : Integer;


{ exchanges the values of two pointers }
procedure ExchangePtr(var p1, p2);
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif }

{ exchanges two one-byte values }
procedure ExchangeByte(var b1, b2);
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif }

{ exchanges the values of two variables, each <size> bytes long }
procedure ExchangeData(var v1, v2; size : SizeType);

{ returns true if the index is valid assuming it points into a
  zero-based container of size size }
function IsValidIndex(index : IndexType; size : SizeType) : Boolean;
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif }

{ returns true if the index is valid assuming it points into a
  low-based container of size size }
function IsValidIndexLow(index, low : IndexType; size : SizeType) : Boolean;
{$ifdef INLINE_DIRECTIVE }
inline;
{$endif INLINE_DIRECTIVE }

{ returns the largest number smaller than the base 2 logarithm of n;
  if n is 0 EInvalidArgument is raised }
function FloorLog2(n : SizeType) : SizeType;
{ returns the smallest number larger than the base 2 logarithm of n;
  if n is 0 EInvalidArgument is raised }
function CeilLog2(n : SizeType) : SizeType;




implementation

uses
   adtexcept, SysUtils;

&_mcp_generic_include(adtutils_impl.i)

function Min(v1, v2 : Integer) : Integer;
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
begin
   if v2 < v1 then
      Result := v2
   else
      Result := v1;
end;

function Min3(v1, v2, v3 : Integer) : Integer;
begin
   if v2 < v1 then
   begin
      if v3 < v2 then
         Result := v3
      else
         Result := v2;
   end else
   begin
      if v3 < v1 then
         Result := v3
      else
         Result := v1;
   end;
end;

function Min(v1, v2, v3 : Integer) : Integer;
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
begin
   Result := Min3(v1, v2, v3);
end;

function Max(v1, v2 : Integer) : Integer;
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
begin
   if v2 > v1 then
      Result := v2
   else
      Result := v1;
end;

function Max3(v1, v2, v3 : Integer) : Integer;
begin
   if v2 > v1 then
   begin
      if v3 > v2 then
         Result := v3
      else
         Result := v2;
   end else
   begin
      if v3 > v1 then
         Result := v3
      else
         Result := v1;
   end;
end;

{$ifdef OVERLOAD_DIRECTIVE }
function Max(v1, v2, v3 : Integer) : Integer;
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
begin
   Result := Max3(v1, v2, v3);
end;
{$endif OVERLOAD_DIRECTIVE }

procedure ExchangePtr(var p1, p2);
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
var
   temp : Pointer;
begin
   temp := Pointer(p1);
   Pointer(p1) := Pointer(p2);
   Pointer(p2) := temp;
end;

procedure ExchangeByte(var b1, b2);
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
var
   tmp : Byte;
begin
   tmp := Byte(b1);
   Byte(b1) := Byte(b2);
   Byte(b2) := tmp;
end;

procedure ExchangeData(var v1, v2; size : SizeType);
type
   PByte = ^Byte;
var
   i : PointerValueType;
begin
   i := 0;
   while i + SizeOf(Pointer) <= PointerValueType(size) do
   begin
      ExchangePtr(PPointer(POinterValueType(@v1) + i)^,
                  PPointer(PointerValueType(@v2) + i)^);
      Inc(i, SizeOf(pointer));
   end;

   while i < PointerValueType(size) do
   begin
      ExchangeByte(PByte(PointerValueType(@v1) + i)^,
                   PByte(PointerValueType(@v2) + i)^);
      Inc(i);
   end;
end;

function IsValidIndex(index : IndexType; size : SizeType) : Boolean;
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
begin
   Result := (index >= 0) and (SizeType(index) < size);
end;

function IsValidIndexLow(index, low : IndexType; size : SizeType) : Boolean;
{$ifdef INLINE_DIRECTIVE_REPEAT }
inline;
{$endif }
begin
   Result := (index >= low) and (SizeType(index + low) < size);
end;

function FloorLog2(n : SizeType) : SizeType;
const
   MSIGN_BIT = SizeOf(SizeType)*adtBitsInByte - 1;
var
   mask : SizeType;
begin
   if n = 0 then
      raise EInvalidArgument.Create('FloorLog2');

   mask := $0FF;
   mask := mask shl (MSIGN_BIT - 7);
   Result := MSIGN_BIT;

   while (n and mask) = 0 do
   begin
      mask := mask shr 8;
      Dec(Result, 8);
   end;

   mask := 1 shl Result;
   while (n and mask) = 0 do
   begin
      mask := mask shr 1;
      Dec(Result);
   end;
end;

function CeilLog2(n : SizeType) : SizeType;
var
   mask : SizeType;
begin
   Result := FloorLog2(n);
   if Result <> 0 then
   begin
      mask := 1 shl (Result - 1);

      while ((n and mask) = 0) and (mask <> 0) do
         mask := mask shr 1;

      if mask <> 0 then
         Inc(Result);
   end;
end;

end.