mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-28 10:03:50 +02:00

and also have full double support (exp() only has support for values in the single range in genmath, for example). Used in FPC_USE_LIBC is defined * several fixes to allow compilation with -dHASINLINE, but internalerrors because of missing support for inlining assembler code
173 lines
5.1 KiB
PHP
173 lines
5.1 KiB
PHP
{
|
|
$Id$
|
|
This file is part of the Free Pascal run time library.
|
|
Copyright (c) 1999-2000 by the Free Pascal development team.
|
|
|
|
Processor independent implementation for the system unit
|
|
(based on libc)
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program 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.
|
|
|
|
**********************************************************************}
|
|
|
|
|
|
{****************************************************************************
|
|
Primitives
|
|
****************************************************************************}
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_MOVE}
|
|
{$define FPC_SYSTEM_HAS_MOVE}
|
|
procedure bcopy(const source;var dest;count:cardinal); cdecl; external 'c' name 'bcopy';
|
|
|
|
{ we need this separate move declaration because we can't add a "public, alias" to the above }
|
|
procedure Move(const source;var dest;count:longint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
if count <= 0 then
|
|
exit;
|
|
bcopy(source,dest,count);
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_MOVE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
|
|
{$define FPC_SYSTEM_HAS_FILLCHAR}
|
|
procedure memset(var x; value: byte; count: cardinal); cdecl; external 'c';
|
|
|
|
Procedure FillChar(var x;count: longint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
if count <= 0 then
|
|
exit;
|
|
memset(x,value,count);
|
|
end;
|
|
{$endif FPC_SYSTEM_HAS_FILLCHAR}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_FILLBYTE}
|
|
{$define FPC_SYSTEM_HAS_FILLBYTE}
|
|
procedure FillByte (var x;count : longint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
if count <= 0 then
|
|
exit;
|
|
FillChar (X,Count,value);
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_FILLBYTE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
|
|
{$define FPC_SYSTEM_HAS_INDEXCHAR}
|
|
|
|
function memchr(const buf; b: longint; len: cardinal): pointer; cdecl; external 'c';
|
|
|
|
function IndexChar(Const buf;len:longint;b:char):longint;
|
|
var
|
|
res: pointer;
|
|
begin
|
|
if len = 0 then
|
|
exit(-1);
|
|
{ simulate assembler implementations behaviour, which is expected }
|
|
{ fpc_pchar_to_ansistr in astrings.inc (interpret values < 0 as }
|
|
{ unsigned) }
|
|
res := memchr(buf,longint(b),cardinal(len));
|
|
if (res <> nil) then
|
|
IndexChar := longint(res-@buf)
|
|
else
|
|
IndexChar := -1;
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_INDEXCHAR}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
|
|
{$define FPC_SYSTEM_HAS_INDEXBYTE}
|
|
function IndexByte(Const buf;len:longint;b:byte):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
IndexByte:=IndexChar(buf,len,char(b));
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
|
|
{$define FPC_SYSTEM_HAS_COMPARECHAR}
|
|
function memcmp_comparechar(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'memcmp';
|
|
|
|
function CompareChar(Const buf1,buf2;len:longint):longint;
|
|
var
|
|
res: longint;
|
|
begin
|
|
if len <= 0 then
|
|
exit(0);
|
|
res := memcmp_comparechar(buf1,buf2,len);
|
|
if res < 0 then
|
|
CompareChar := -1
|
|
else if res > 0 then
|
|
CompareChar := 1
|
|
else
|
|
CompareChar := 0;
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_COMPARECHAR}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
|
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
|
|
function CompareByte(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
CompareByte := CompareChar(buf1,buf2,len);
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
|
|
{$define FPC_SYSTEM_HAS_COMPARECHAR0}
|
|
function strncmp_comparechar0(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'strncmp';
|
|
|
|
function CompareChar0(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
if len <= 0 then
|
|
exit(0);
|
|
strncmp_comparechar0(buf1,buf2,len);
|
|
end;
|
|
|
|
{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
|
|
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
|
|
{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
|
|
|
|
function libc_pchar_length(p:pchar):cardinal; cdecl; external 'c' name 'strlen';
|
|
|
|
function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
|
|
begin
|
|
fpc_pchar_length:=libc_pchar_length(p);
|
|
end;
|
|
|
|
{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
|
|
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.3 2004-10-09 21:00:46 jonas
|
|
+ cgenmath with libc math functions. Faster than the routines in genmath
|
|
and also have full double support (exp() only has support for values in
|
|
the single range in genmath, for example). Used in FPC_USE_LIBC is
|
|
defined
|
|
* several fixes to allow compilation with -dHASINLINE, but internalerrors
|
|
because of missing support for inlining assembler code
|
|
|
|
Revision 1.2 2004/05/01 15:26:33 jonas
|
|
* use some more string routines from libc if FPC_USE_LIBC is used
|
|
|
|
Revision 1.1 2004/01/11 11:10:07 jonas
|
|
+ cgeneric.inc: implementations of rtl routines based on libc
|
|
* system.inc: include cgeneric.inc before powerpc.inc/i386.inc/... if
|
|
FPC_USE_LIBC is defined
|
|
* powerpc.inc, i386.inc: check whether the routines they implement aren't
|
|
implemented yet in another include file (cgeneric.inc)
|
|
|
|
|
|
}
|