unxfunc.inc 2.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102
  1. {
  2. This file is part of the Free Pascal run time library.
  3. Copyright (c) 2000 by Marco van de Voort
  4. member of the Free Pascal development team.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY;without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$ifndef HAS_LIBC_PIPING}
  12. Function PClose(Var F:file) : cint;
  13. var
  14. pl : ^cint;
  15. res : cint;
  16. begin
  17. fpclose(filerec(F).Handle);
  18. { closed our side, Now wait for the other - this appears to be needed ?? }
  19. pl:=@(filerec(f).userdata[2]);
  20. fpwaitpid(pl^,@res,0);
  21. pclose:=res shr 8;
  22. end;
  23. Function PClose(Var F:text) :cint;
  24. var
  25. pl : ^longint;
  26. res : longint;
  27. begin
  28. fpclose(Textrec(F).Handle);
  29. { closed our side, Now wait for the other - this appears to be needed ?? }
  30. pl:=@(textrec(f).userdata[2]);
  31. fpwaitpid(pl^,@res,0);
  32. pclose:=res shr 8;
  33. end;
  34. {$ENDIF}
  35. Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
  36. {
  37. Sets up a pair of file variables, which act as a pipe. The first one can
  38. be read from, the second one can be written to.
  39. If the operation was unsuccesful, errno is set.
  40. }
  41. var
  42. pip : tfildes;
  43. begin
  44. assignPipe:=fppipe(pip);
  45. pipe_in:=pip[0];
  46. pipe_out:=pip[1];
  47. end;
  48. { should probably be defined in ostypes.inc for all OSes }
  49. const
  50. F_RDLCK = 01; (* Read lock *)
  51. F_WRLCK = 02; (* Write lock *)
  52. F_UNLCK = 03; (* Remove lock(s) *)
  53. Function fpFlock (fd,mode : longint) : cint;
  54. var
  55. fl : flock;
  56. cmd : cint;
  57. begin
  58. { initialize the flock struct to set lock on entire file }
  59. fillchar(fl,sizeof(fl),0);
  60. { In non-blocking lock, use F_SETLK for cmd, F_SETLKW otherwise }
  61. if (mode and LOCK_NB)<>0 then
  62. begin
  63. cmd:=F_SETLK;
  64. { turn off this bit }
  65. mode:=mode and not(LOCK_NB);
  66. end
  67. else
  68. cmd:=F_SETLKW;
  69. case mode of
  70. LOCK_UN:
  71. fl.l_type:=fl.l_type or F_UNLCK;
  72. LOCK_SH:
  73. fl.l_type:=fl.l_type or F_RDLCK;
  74. LOCK_EX:
  75. fl.l_type:=fl.l_type or F_WRLCK;
  76. else
  77. begin
  78. errno:=ESysEINVAL;
  79. fpFlock:=-1;
  80. exit;
  81. end;
  82. end;
  83. fpFlock:=fpFcntl(fd,cmd,fl);
  84. if (fpFlock=-1) and (errno=ESysEACCES) then
  85. errno:=ESysEWOULDBLOCK;
  86. end;