lazarus/components/aggpas/expat-pas/expat_basics.pas

//----------------------------------------------------------------------------
// Copyright (c) 1998, 1999, 2000 Thai Open Source Software Center Ltd
//                                and Clark Cooper
// Copyright (c) 2001, 2002, 2003, 2004, 2005, 2006 Expat maintainers.
//
// Expat - Version 2.0.0 Release Milano 0.83 (PasExpat 2.0.0 RM0.83)
// Pascal Port By: Milan Marusinec alias Milano
//                 milan@marusinec.sk
//                 http://www.pasports.org/pasexpat
// Copyright (c) 2006
//
// Permission is hereby granted, free of charge, to any person obtaining
// a copy of this software and associated documentation files (the
// "Software"), to deal in the Software without restriction, including
// without limitation the rights to use, copy, modify, merge, publish,
// distribute, sublicense, and/or sell copies of the Software, and to
// permit persons to whom the Software is furnished to do so, subject to
// the following conditions:
//
// The above copyright notice and this permission notice shall be included
// in all copies or substantial portions of the Software.
//
// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
// IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
// CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
// TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
// SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
//
// [Pascal Port History] -----------------------------------------------------
//
// 10.05.2006-Milano: Unit port establishment
//
{ expat_basics.pas }
unit
 expat_basics ;

INTERFACE

{$I expat_mode.inc }

{ GLOBAL PROCEDURES }
 function  expat_getmem (var ptr : pointer; sz : integer ) : boolean;
 function  expat_realloc(var ptr : pointer; old ,sz : integer ) : boolean;
 function  expat_freemem(var ptr : pointer; sz : integer ) : boolean;
 
 procedure NoP;

// SHR for signed integers is differently implemented in pascal compilers
// than in c++ compilers. On the assembler level, c++ is using the SAR and
// pascal is using SHR. That gives completely different result, when the
// number is negative. We have to be compatible with c++ implementation,
// thus instead of directly using SHR we emulate c++ solution.
 function  shr_int8 (i ,shift : shortint ) : shortint;
 function  shr_int16(i ,shift : smallint ) : smallint;
 function  shr_int32(i ,shift : longint ) : longint;


IMPLEMENTATION
{ LOCAL VARIABLES & CONSTANTS }
{ UNIT IMPLEMENTATION }
{ EXPAT_GETMEM }
function expat_getmem;
begin
 result:=false;

 try
  getmem(ptr ,sz );
  {$IFDEF EXPAT_CLEARMEM}
  FillByte(ptr^,sz,0);
  {$ENDIF}

  result:=true;

 except
  ptr:=NIL;

 end;

end;

{ EXPAT_REALLOC }
function expat_realloc;
var
 nb  : pointer;
 max : integer;

begin
 if expat_getmem(nb ,sz ) then
  begin
   max:=old;

   if max > sz then
    max:=sz;

   move(ptr^ ,nb^ ,max );

   expat_freemem(ptr ,old );

   ptr   :=nb;
   result:=true;

  end
 else
  result:=false;

end;

{ EXPAT_FREEMEM }
function expat_freemem;
begin
 if ptr = NIL then
  result:=true

 else
  try
   freemem(ptr ,sz );

   ptr   :=NIL;
   result:=true;

  except
   result:=false;

  end;

end;

{ NOP }
procedure NoP;
begin
end;

{ SHR_INT8 }
function shr_int8;
begin
{$IFDEF EXPAT_CPU_386 }
 asm
  mov al ,byte ptr [i ]
  mov cl ,byte ptr [shift ]
  sar al ,cl
  mov byte ptr [result ] ,al

 end;

{$ENDIF }

{$IFDEF EXPAT_CPU_PPC }
 asm
  lbz   r2,i
  extsb r2,r2
  lbz   r3,shift
  extsb r3,r3
  sraw  r2,r2,r3
  extsb r2,r2
  stb   r2,result

 end;

{$ENDIF }

end;

{ SHR_INT16 }
function shr_int16;
begin
{$IFDEF EXPAT_CPU_386 }
 asm
  mov ax ,word ptr [i ]
  mov cx ,word ptr [shift ]
  sar ax ,cl
  mov word ptr [result ] ,ax

 end;

{$ENDIF }

{$IFDEF EXPAT_CPU_PPC }
 asm
  lha   r2,i
  lha   r3,shift
  sraw  r2,r2,r3
  extsh r2,r2
  sth   r2,result

 end;

{$ENDIF }

end;

{ SHR_INT32 }
function shr_int32;
begin
{$IFDEF EXPAT_CPU_386 }
 asm
  mov eax ,dword ptr [i ]
  mov ecx ,dword ptr [shift ]
  sar eax ,cl
  mov dword ptr [result ] ,eax

 end;

{$ENDIF }

{$IFDEF EXPAT_CPU_PPC }
 asm
  lwz  r3,i
  lwz  r2,shift
  sraw r3,r3,r2
  stw  r3,result

 end;

{$ENDIF }

end;

END.