cgeneric.inc 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by the Free Pascal development team.
  5. Processor independent implementation for the system unit
  6. (based on libc)
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. {****************************************************************************
  14. Primitives
  15. ****************************************************************************}
  16. {$ifndef FPC_SYSTEM_HAS_MOVE}
  17. {$define FPC_SYSTEM_HAS_MOVE}
  18. procedure bcopy(const source;var dest;count:cardinal); cdecl; external 'c' name 'bcopy';
  19. { we need this separate move declaration because we can't add a "public, alias" to the above }
  20. procedure Move(const source;var dest;count:longint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif}
  21. begin
  22. if count <= 0 then
  23. exit;
  24. bcopy(source,dest,count);
  25. end;
  26. {$endif not FPC_SYSTEM_HAS_MOVE}
  27. {$ifndef FPC_SYSTEM_HAS_FILLCHAR}
  28. {$define FPC_SYSTEM_HAS_FILLCHAR}
  29. procedure memset(var x; value: byte; count: cardinal); cdecl; external 'c';
  30. Procedure FillChar(var x;count: longint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif}
  31. begin
  32. if count <= 0 then
  33. exit;
  34. memset(x,value,count);
  35. end;
  36. {$endif FPC_SYSTEM_HAS_FILLCHAR}
  37. {$ifndef FPC_SYSTEM_HAS_FILLBYTE}
  38. {$define FPC_SYSTEM_HAS_FILLBYTE}
  39. procedure FillByte (var x;count : longint;value : byte );{$ifdef SYSTEMINLINE}inline;{$endif}
  40. begin
  41. if count <= 0 then
  42. exit;
  43. FillChar (X,Count,value);
  44. end;
  45. {$endif not FPC_SYSTEM_HAS_FILLBYTE}
  46. {$ifndef FPC_SYSTEM_HAS_INDEXCHAR}
  47. {$define FPC_SYSTEM_HAS_INDEXCHAR}
  48. function memchr(const buf; b: longint; len: cardinal): pointer; cdecl; external 'c';
  49. function IndexChar(Const buf;len:longint;b:char):longint;
  50. var
  51. res: pointer;
  52. begin
  53. if len = 0 then
  54. exit(-1);
  55. { simulate assembler implementations behaviour, which is expected }
  56. { fpc_pchar_to_ansistr in astrings.inc (interpret values < 0 as }
  57. { unsigned) }
  58. res := memchr(buf,longint(b),cardinal(len));
  59. if (res <> nil) then
  60. IndexChar := longint(res-@buf)
  61. else
  62. IndexChar := -1;
  63. end;
  64. {$endif not FPC_SYSTEM_HAS_INDEXCHAR}
  65. {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
  66. {$define FPC_SYSTEM_HAS_INDEXBYTE}
  67. function IndexByte(Const buf;len:longint;b:byte):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  68. begin
  69. IndexByte:=IndexChar(buf,len,char(b));
  70. end;
  71. {$endif not FPC_SYSTEM_HAS_INDEXBYTE}
  72. {$ifndef FPC_SYSTEM_HAS_COMPARECHAR}
  73. {$define FPC_SYSTEM_HAS_COMPARECHAR}
  74. function memcmp_comparechar(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'memcmp';
  75. function CompareChar(Const buf1,buf2;len:longint):longint;
  76. var
  77. res: longint;
  78. begin
  79. if len <= 0 then
  80. exit(0);
  81. res := memcmp_comparechar(buf1,buf2,len);
  82. if res < 0 then
  83. CompareChar := -1
  84. else if res > 0 then
  85. CompareChar := 1
  86. else
  87. CompareChar := 0;
  88. end;
  89. {$endif not FPC_SYSTEM_HAS_COMPARECHAR}
  90. {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
  91. {$define FPC_SYSTEM_HAS_COMPAREBYTE}
  92. function CompareByte(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  93. begin
  94. CompareByte := CompareChar(buf1,buf2,len);
  95. end;
  96. {$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
  97. {$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
  98. {$define FPC_SYSTEM_HAS_COMPARECHAR0}
  99. function strncmp_comparechar0(Const buf1,buf2;len:cardinal):longint; cdecl; external 'c' name 'strncmp';
  100. function CompareChar0(Const buf1,buf2;len:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
  101. begin
  102. if len <= 0 then
  103. exit(0);
  104. strncmp_comparechar0(buf1,buf2,len);
  105. end;
  106. {$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
  107. {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  108. {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  109. function libc_pchar_length(p:pchar):cardinal; cdecl; external 'c' name 'strlen';
  110. function fpc_pchar_length(p:pchar):longint;[public,alias:'FPC_PCHAR_LENGTH']; {$ifdef hascompilerproc} compilerproc; {$endif}
  111. begin
  112. fpc_pchar_length:=libc_pchar_length(p);
  113. end;
  114. {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  115. {
  116. $Log$
  117. Revision 1.3 2004-10-09 21:00:46 jonas
  118. + cgenmath with libc math functions. Faster than the routines in genmath
  119. and also have full double support (exp() only has support for values in
  120. the single range in genmath, for example). Used in FPC_USE_LIBC is
  121. defined
  122. * several fixes to allow compilation with -dHASINLINE, but internalerrors
  123. because of missing support for inlining assembler code
  124. Revision 1.2 2004/05/01 15:26:33 jonas
  125. * use some more string routines from libc if FPC_USE_LIBC is used
  126. Revision 1.1 2004/01/11 11:10:07 jonas
  127. + cgeneric.inc: implementations of rtl routines based on libc
  128. * system.inc: include cgeneric.inc before powerpc.inc/i386.inc/... if
  129. FPC_USE_LIBC is defined
  130. * powerpc.inc, i386.inc: check whether the routines they implement aren't
  131. implemented yet in another include file (cgeneric.inc)
  132. }