sysos.inc 3.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2001 by Free Pascal development team
  4. This file implements all the base types and limits required
  5. for a minimal POSIX compliant subset required to port the compiler
  6. to a new OS.
  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. {$ifdef FPC_USE_LIBC}
  14. const clib = 'c';
  15. type libcint=longint;
  16. plibcint=^libcint;
  17. function geterrnolocation: Plibcint; cdecl;external clib name'__errno_location';
  18. function geterrno:libcint; [public, alias: 'FPC_SYS_GETERRNO'];
  19. begin
  20. geterrno:=geterrnolocation^;
  21. end;
  22. procedure seterrno(err:libcint); [public, alias: 'FPC_SYS_SETERRNO']; register;
  23. begin
  24. geterrnolocation^:=err;
  25. end;
  26. {$else}
  27. ThreadVar
  28. Errno : longint;
  29. function geterrno:longint; [public, alias: 'FPC_SYS_GETERRNO'];
  30. begin
  31. GetErrno:=Errno;
  32. end;
  33. procedure seterrno(err:longint); [public, alias: 'FPC_SYS_SETERRNO'];
  34. begin
  35. Errno:=err;
  36. end;
  37. {$endif}
  38. { OS dependant parts }
  39. {$I errno.inc} // error numbers
  40. {$I ostypes.inc} // c-types, unix base types, unix base structures
  41. {$ifdef FPC_USE_LIBC}
  42. {$Linklib c}
  43. {$i oscdeclh.inc}
  44. {$i oscdecl.inc}
  45. {$else}
  46. {$I syscallh.inc}
  47. {$I syscall.inc}
  48. {$I sysnr.inc}
  49. {$I ossysc.inc}
  50. {$I syscgen.inc}
  51. {$endif}
  52. {$I osmacro.inc}
  53. {*****************************************************************************
  54. Error conversion
  55. *****************************************************************************}
  56. {
  57. The lowlevel file functions should take care of setting the InOutRes to the
  58. correct value if an error has occurred, else leave it untouched
  59. }
  60. function PosixToRunError (PosixErrno : longint):word;
  61. {
  62. Convert ErrNo error to the correct Inoutres value
  63. }
  64. var r:word; {Inoutres is declared as word.}
  65. begin
  66. (*
  67. if PosixErrNo=0 then {Else it will go through all the cases}
  68. exit(0);
  69. Statement commented out. It will not go through all the cases. (DM)
  70. *)
  71. case PosixErrNo of
  72. ESysENFILE,
  73. ESysEMFILE: r:=4;
  74. ESysENOENT: r:=2;
  75. ESysEBADF: r:=6;
  76. ESysENOMEM,
  77. ESysEFAULT: r:=217;
  78. ESysEINVAL: r:=218;
  79. ESysEPIPE,
  80. ESysEINTR,
  81. ESysEIO,
  82. ESysEAGAIN,
  83. ESysENOSPC: r:=101;
  84. ESysENAMETOOLONG: r:=3;
  85. ESysEROFS,
  86. ESysEEXIST,
  87. ESysENOTEMPTY,
  88. ESysEACCES: r:=5;
  89. ESysEBusy,
  90. ESysENOTDIR, // busy, enotdir, mantis #25931
  91. ESysEISDIR: r:=5;
  92. else
  93. r:=PosixErrno;
  94. end;
  95. inoutres:=r;
  96. PosixToRunError:=r;
  97. end;
  98. function Errno2InoutRes : word;
  99. begin
  100. Errno2InoutRes:=PosixToRunError(getErrno);
  101. InoutRes:=Errno2InoutRes;
  102. end;
  103. {*****************************************************************************
  104. Low Level File Routines
  105. *****************************************************************************}
  106. Function Do_IsDevice(Handle:THandle):boolean;
  107. var
  108. StatRec: Stat;
  109. begin
  110. fpFStat (Handle, StatRec);
  111. case StatRec.st_Mode and S_IFMT of
  112. S_IFCHR, S_IFIFO, S_IFSOCK: Do_IsDevice := true
  113. else
  114. Do_IsDevice := false;
  115. end;
  116. end;