mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-03 11:37:14 +01:00
U compiler/symdef.pas A tests/webtbs/tw27320.pp A tests/webtbs/uw27320.defaults.pp --- Recording mergeinfo for merge of r29537 into '.': U . --- Merging r29579 into '.': A tests/webtbs/tw27348.pp G compiler/symdef.pas --- Recording mergeinfo for merge of r29579 into '.': G . --- Merging r29743 into '.': U compiler/rautils.pas G compiler/symdef.pas --- Recording mergeinfo for merge of r29743 into '.': G . --- Merging r29685 into '.': A tests/webtbs/tw27424.pp U compiler/pgenutil.pas --- Recording mergeinfo for merge of r29685 into '.': G . --- Merging r30160 into '.': U rtl/inc/cgeneric.inc --- Recording mergeinfo for merge of r30160 into '.': G . --- Merging r31028 into '.': U rtl/objpas/classes/classes.inc A tests/webtbs/tw28271.pp --- Recording mergeinfo for merge of r31028 into '.': G . # revisions: 29537,29579,29743,29685,30160,31028 git-svn-id: branches/fixes_3_0@31065 -
136 lines
3.8 KiB
PHP
136 lines
3.8 KiB
PHP
{
|
|
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:size_t); 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:sizeint); [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: size_t); cdecl; external 'c';
|
|
|
|
Procedure FillChar(var x;count: sizeint;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_INDEXBYTE}
|
|
{$define FPC_SYSTEM_HAS_INDEXBYTE}
|
|
|
|
{$ifdef LINUX}
|
|
{$define BUGGYMEMCHR}
|
|
{$endif}
|
|
|
|
function memchr(const buf; b: cint; len: size_t): pointer; cdecl; external 'c';
|
|
{$ifdef BUGGYMEMCHR}
|
|
function rawmemchr(const buf; b: cint): pointer; cdecl; external 'c';
|
|
{$endif BUGGYMEMCHR}
|
|
|
|
function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
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) }
|
|
{$ifdef BUGGYMEMCHR}
|
|
if len = -1 then
|
|
res := rawmemchr(buf,cint(b))
|
|
else
|
|
{$endif BUGGYMEMCHR}
|
|
res := memchr(buf,cint(b),size_t(sizeuint(len)));
|
|
if (res <> nil) then
|
|
IndexByte := SizeInt(res-@buf)
|
|
else
|
|
IndexByte := -1;
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_INDEXBYTE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
|
|
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
|
|
function memcmp_comparechar(Const buf1,buf2;len:size_t):cint; cdecl; external 'c' name 'memcmp';
|
|
|
|
function CompareByte(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
var
|
|
res: longint;
|
|
begin
|
|
if len <= 0 then
|
|
exit(0);
|
|
res := memcmp_comparechar(buf1,buf2,len);
|
|
if res < 0 then
|
|
CompareByte := -1
|
|
else if res > 0 then
|
|
CompareByte := 1
|
|
else
|
|
CompareByte := 0;
|
|
end;
|
|
{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
|
|
|
|
|
|
{$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
|
|
{$define FPC_SYSTEM_HAS_COMPARECHAR0}
|
|
function strncmp_comparechar0(Const buf1,buf2;len:size_t):longint; cdecl; external 'c' name 'strncmp';
|
|
|
|
function CompareChar0(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
|
|
begin
|
|
if len <= 0 then
|
|
exit(0);
|
|
CompareChar0:=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):size_t; cdecl; external 'c' name 'strlen';
|
|
|
|
function fpc_pchar_length(p:pchar):sizeint;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
|
|
begin
|
|
if assigned(p) then
|
|
fpc_pchar_length:=libc_pchar_length(p)
|
|
else
|
|
fpc_pchar_length:=0;
|
|
end;
|
|
|
|
{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
|
|
|
|
|