cgeneric.inc 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 1999-2000 by the Free Pascal development team.
  4. Processor independent implementation for the system unit
  5. (based on libc)
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. {****************************************************************************
  13. Primitives
  14. ****************************************************************************}
  15. {$ifndef FPC_SYSTEM_HAS_MOVE}
  16. {$define FPC_SYSTEM_HAS_MOVE}
  17. procedure bcopy(const source;var dest;count:size_t); cdecl; external clib name 'bcopy';
  18. { we need this separate move declaration because we can't add a "public, alias" to the above }
  19. procedure Move(const source;var dest;count:sizeint); [public, alias: 'FPC_MOVE'];{$ifdef SYSTEMINLINE}inline;{$endif}
  20. begin
  21. if count <= 0 then
  22. exit;
  23. bcopy(source,dest,size_t(count));
  24. end;
  25. {$endif not FPC_SYSTEM_HAS_MOVE}
  26. {$ifndef FPC_SYSTEM_HAS_FILLCHAR}
  27. {$define FPC_SYSTEM_HAS_FILLCHAR}
  28. procedure memset(var x; value: byte; count: size_t); cdecl; external clib;
  29. Procedure FillChar(var x;count: sizeint;value:byte);{$ifdef SYSTEMINLINE}inline;{$endif}
  30. begin
  31. { don't exit if count is <= 0, this makes the compiler think x is uninitialized,
  32. as FillChar is probably rarely called with count <= 0, the performance hit is
  33. probably neglible }
  34. if count < 0 then
  35. count := 0;
  36. memset(x,value,size_t(count));
  37. end;
  38. {$endif FPC_SYSTEM_HAS_FILLCHAR}
  39. {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
  40. {$define FPC_SYSTEM_HAS_INDEXBYTE}
  41. {$ifdef LINUX}
  42. {$define BUGGYMEMCHR}
  43. {$endif}
  44. function memchr(const buf; b: cint; len: size_t): pointer; cdecl; external clib;
  45. {$ifdef BUGGYMEMCHR}
  46. function rawmemchr(const buf; b: cint): pointer; cdecl; external clib;
  47. {$endif BUGGYMEMCHR}
  48. function IndexByte(Const buf;len:sizeint;b:byte):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
  49. var
  50. res: pointer;
  51. begin
  52. if len = 0 then
  53. exit(-1);
  54. { simulate assembler implementations behaviour, which is expected }
  55. { fpc_pchar_to_ansistr in astrings.inc (interpret values < 0 as }
  56. { unsigned) }
  57. {$ifdef BUGGYMEMCHR}
  58. if len = -1 then
  59. res := rawmemchr(buf,cint(b))
  60. else
  61. {$endif BUGGYMEMCHR}
  62. res := memchr(buf,cint(b),size_t(sizeuint(len)));
  63. if (res <> nil) then
  64. IndexByte := SizeInt(res-@buf)
  65. else
  66. IndexByte := -1;
  67. end;
  68. {$endif not FPC_SYSTEM_HAS_INDEXBYTE}
  69. {$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
  70. {$define FPC_SYSTEM_HAS_COMPAREBYTE}
  71. function memcmp_comparechar(Const buf1,buf2;len:size_t):cint; cdecl; external clib name 'memcmp';
  72. function CompareByte(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
  73. var
  74. res: longint;
  75. begin
  76. if len <= 0 then
  77. exit(0);
  78. res := memcmp_comparechar(buf1,buf2,len);
  79. if res < 0 then
  80. CompareByte := -1
  81. else if res > 0 then
  82. CompareByte := 1
  83. else
  84. CompareByte := 0;
  85. end;
  86. {$endif not FPC_SYSTEM_HAS_COMPAREBYTE}
  87. {$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
  88. {$define FPC_SYSTEM_HAS_COMPARECHAR0}
  89. function strncmp_comparechar0(Const buf1,buf2;len:size_t):longint; cdecl; external clib name 'strncmp';
  90. function CompareChar0(Const buf1,buf2;len:sizeint):sizeint;{$ifdef SYSTEMINLINE}inline;{$endif}
  91. begin
  92. if len <= 0 then
  93. exit(0);
  94. CompareChar0:=strncmp_comparechar0(buf1,buf2,len);
  95. end;
  96. {$endif not FPC_SYSTEM_HAS_COMPARECHAR0}
  97. {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  98. {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
  99. function libc_pchar_length(p:PAnsiChar):size_t; cdecl; external clib name 'strlen';
  100. function fpc_pchar_length(p:PAnsiChar):sizeint;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
  101. begin
  102. if assigned(p) then
  103. fpc_pchar_length:=libc_pchar_length(p)
  104. else
  105. fpc_pchar_length:=0;
  106. end;
  107. {$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}