123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 2000 by Marco van de Voort
- member of the Free Pascal development team.
- 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.
- **********************************************************************}
- {$ifndef HAS_LIBC_PIPING}
- Function PClose(Var F:file) : cint;
- var
- pl : ^cint;
- res : cint;
- pid: cint;
- begin
- fpclose(filerec(F).Handle);
- { closed our side, Now wait for the other - this appears to be needed ?? }
- pl:=@(filerec(f).userdata[2]);
- { avoid alignment error on sparc }
- move(pl^,pid,sizeof(pid));
- fpwaitpid(pid,@res,0);
- pclose:=res shr 8;
- end;
- Function PClose(Var F:text) :cint;
- var
- pl : ^cint;
- res : cint;
- pid: cint;
- begin
- fpclose(Textrec(F).Handle);
- { closed our side, Now wait for the other - this appears to be needed ?? }
- pl:=@(textrec(f).userdata[2]);
- { avoid alignment error on sparc }
- move(pl^,pid,sizeof(pid));
- fpwaitpid(pid,@res,0);
- pclose:=res shr 8;
- end;
- {$ENDIF}
- Function AssignPipe(var pipe_in,pipe_out:cint):cint; [public, alias : 'FPC_SYSC_ASSIGNPIPE'];
- {
- Sets up a pair of file variables, which act as a pipe. The first one can
- be read from, the second one can be written to.
- If the operation was unsuccesful, linuxerror is set.
- }
- var
- ret : longint;
- errn : cint;
- {$ifdef FPC_USE_LIBC}
- fdis : array[0..1] of cint;
- {$endif}
- begin
- {$ifndef FPC_USE_LIBC}
- ret:=intAssignPipe(pipe_in,pipe_out,errn);
- if ret=-1 Then
- fpseterrno(errn);
- {$ELSE}
- fdis[0]:=pipe_in;
- fdis[1]:=pipe_out;
- ret:=pipe(fdis);
- pipe_in:=fdis[0];
- pipe_out:=fdis[1];
- {$ENDIF}
- AssignPipe:=ret;
- end;
- Function fpFlock (fd,mode : longint) : cint;
- {
- var
- fl : flock;
- cmd : cint;
- }
- begin
- {
- { initialize the flock struct to set lock on entire file }
- fillchar(fl,sizeof(fl),0);
- { In non-blocking lock, use F_SETLK for cmd, F_SETLKW otherwise }
- if (operation and LOCK_NB)<>0 then
- begin
- cmd:=F_SETLK;
- { turn off this bit }
- operation:=operation and not(LOCK_NB);
- end
- else
- cmd:=F_SETLKW;
-
- case operation of
- LOCK_UN:
- fl.l_type:=fl.l_type or F_UNLCK;
- LOCK_SH:
- fl.l_type:=fl.l_type or F_RDLCK;
- LOCK_EX:
- fl.l_type:=fl.l_type or F_WRLCK;
- else
- begin
- errno:=EINVAL;
- result:=-1
- exit;
- end;
- end;
-
- result:=fpFcntl(fd,cmd,@fl);
-
- if (result=-1) and (errno=EACCES)
- errno:=EWOULDBLOCK;
- }
- end;
|