1{
2    $Id: posix.pp,v 1.1.2.2 2002/05/01 14:10:36 carl Exp $
3    This file is part of the Free Pascal run time library.
4    Copyright (c) 2001 by Carl Eric Codere
5    development team
6
7    POSIX Compliant interface unit
8
9    See the file COPYING.FPC, included in this distribution,
10    for details about the copyright.
11
12    This program is distributed in the hope that it will be useful,
13    but WITHOUT ANY WARRANTY; without even the implied warranty of
14    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
16 **********************************************************************}
17unit posix;
18
19interface
20
21{***********************************************************************}
22{                       POSIX PUBLIC INTERFACE                          }
23{***********************************************************************}
24
25
26{$i errno.inc}
27{$i osposixh.inc}
28
29    function sys_fork : pid_t;
30    function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
31    function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
32    procedure sys_exit(status : cint); cdecl; external name '_exit';
33    function sys_uname(var name: utsname): cint;
34    function sys_opendir(const dirname : pchar): pdir;
35    function sys_readdir(dirp : pdir) : pdirent;
36    function sys_closedir(dirp : pdir): cint;
37    function sys_chdir(const path : pchar): cint;
38    function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
39    function sys_mkdir(const path : pchar; mode: mode_t):cint;
40    function sys_unlink(const path: pchar): cint;
41    function sys_rmdir(const path : pchar): cint;
42    function sys_rename(const old : pchar; const newpath: pchar): cint;
43    function sys_access(const pathname : pchar; amode : cint): cint;
44    function sys_close(fd : cint): cint;
45    function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
46    function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
47    function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
48    function sys_time(var tloc:time_t): time_t;
49    function sys_ftruncate(fd : cint; flength : off_t): cint;
50    function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
51    function sys_fstat(fd : cint; var sb : stat): cint;
52    function sys_stat(const path: pchar; var buf : stat): cint;
53
54
55    function S_ISDIR(m : mode_t): boolean;
56    function S_ISCHR(m : mode_t): boolean;
57    function S_ISBLK(m : mode_t): boolean;
58    function S_ISREG(m : mode_t): boolean;
59    function S_ISFIFO(m : mode_t): boolean;
60
61    function wifexited(status : cint): cint;
62    function wexitstatus(status : cint): cint;
63    function wstopsig(status : cint): cint;
64    function wifsignaled(status : cint): cint;
65
66
67
68implementation
69
70    function int_fork : pid_t; cdecl; external name 'fork';
71    function int_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint; cdecl; external name 'execve';
72    function int_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t; cdecl; external name 'waitpid';
73    function int_uname(var name: utsname): cint; cdecl; external name 'uname';
74    function int_opendir(const dirname : pchar): pdir; cdecl; external name 'opendir';
75    function int_readdir(dirp : pdir) : pdirent;cdecl; external name 'readdir';
76    function int_closedir(dirp : pdir): cint; cdecl; external name 'closedir';
77    function int_chdir(const path : pchar): cint; cdecl; external name 'chdir';
78    function int_open(const path: pchar; flags : cint; mode: mode_t):cint; cdecl; external name 'open';
79    function int_mkdir(const path : pchar; mode: mode_t):cint; cdecl; external name 'mkdir';
80    function int_unlink(const path: pchar): cint; cdecl; external name 'unlink';
81    function int_rmdir(const path : pchar): cint; cdecl; external name 'rmdir';
82    function int_rename(const old : pchar; const newpath: pchar): cint; cdecl;external name 'rename';
83    function int_access(const pathname : pchar; amode : cint): cint; cdecl; external name 'access';
84    function int_close(fd : cint): cint; cdecl; external name 'close';
85    function int_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t; cdecl; external name 'read';
86    function int_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t; cdecl; external name 'write';
87    function int_lseek(fd : cint; offset : off_t; whence : cint): off_t; cdecl; external name 'lseek';
88    function int_time(var tloc:time_t): time_t; cdecl; external name 'time';
89    function int_ftruncate(fd : cint; flength : off_t): cint; cdecl; external name 'ftruncate';
90    function int_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint; cdecl; external name 'sigaction';
91    function int_fstat(fd : cint; var sb : stat): cint; cdecl; external name 'fstat';
92    function int_stat(const path: pchar; var buf : stat): cint; cdecl; external name 'stat';
93
94
95    function sys_fork : pid_t;
96     begin
97       sys_fork := int_fork;
98       if sys_fork <> - 1 then
99         begin
100           errno := 0;         { reset errno when the call succeeds, contrary to libc }
101         end;
102     end;
103
104
105    function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
106    begin
107       sys_execve := int_execve(path, argv, envp);
108       if sys_execve <> - 1 then
109         begin
110           errno := 0;         { reset errno when the call succeeds, contrary to libc }
111         end;
112    end;
113
114    function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
115    begin
116       sys_waitpid := int_waitpid(pid, stat_loc, options);
117       if sys_waitpid <> - 1 then
118         begin
119           errno := 0;         { reset errno when the call succeeds, contrary to libc }
120         end;
121    end;
122
123
124    function sys_uname(var name: utsname): cint;
125     begin
126       sys_uname := int_uname(name);
127       if sys_uname <> - 1 then
128         begin
129           errno := 0;         { reset errno when the call succeeds, contrary to libc }
130         end;
131     end;
132
133    function sys_opendir(const dirname : pchar): pdir;
134    begin
135       sys_opendir := int_opendir(dirname);
136       if sys_opendir <> nil then
137         begin
138           errno := 0;         { reset errno when the call succeeds, contrary to libc }
139         end;
140    end;
141
142
143    function sys_readdir(dirp : pdir) : pdirent;
144    begin
145       sys_readdir := int_readdir(dirp);
146       if sys_readdir <> nil then
147         begin
148           errno := 0;         { reset errno when the call succeeds, contrary to libc }
149         end;
150    end;
151
152
153    function sys_closedir(dirp : pdir): cint;
154    begin
155       sys_closedir := int_closedir(dirp);
156       if sys_closedir <> -1 then
157         begin
158           errno := 0;         { reset errno when the call succeeds, contrary to libc }
159         end;
160    end;
161
162    function sys_chdir(const path : pchar): cint;
163    begin
164       sys_chdir := int_chdir(path);
165       if sys_chdir <> -1 then
166         begin
167           errno := 0;         { reset errno when the call succeeds, contrary to libc }
168         end;
169    end;
170
171
172    function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
173    begin
174       sys_open:= int_open(path, flags, mode);
175       if sys_open <> -1 then
176         begin
177           errno := 0;         { reset errno when the call succeeds, contrary to libc }
178         end;
179    end;
180
181
182    function sys_mkdir(const path : pchar; mode: mode_t):cint;
183    begin
184       sys_mkdir:= int_mkdir(path, mode);
185       if sys_mkdir <> -1 then
186         begin
187           errno := 0;         { reset errno when the call succeeds, contrary to libc }
188         end;
189    end;
190
191    function sys_unlink(const path: pchar): cint;
192    begin
193       sys_unlink := int_unlink(path);
194       if sys_unlink <> -1 then
195         begin
196           errno := 0;         { reset errno when the call succeeds, contrary to libc }
197         end;
198    end;
199
200
201    function sys_rmdir(const path : pchar): cint;
202    begin
203       sys_rmdir := int_rmdir(path);
204       if sys_rmdir <> -1 then
205         begin
206           errno := 0;         { reset errno when the call succeeds, contrary to libc }
207         end;
208    end;
209
210    function sys_rename(const old : pchar; const newpath: pchar): cint;
211    begin
212       sys_rename := int_rename(old, newpath);
213       if sys_rename <> -1 then
214         begin
215           errno := 0;         { reset errno when the call succeeds, contrary to libc }
216         end;
217    end;
218
219    function sys_access(const pathname : pchar; amode : cint): cint;
220    begin
221       sys_access := int_access(pathname, amode);
222       if sys_access <> -1 then
223         begin
224           errno := 0;         { reset errno when the call succeeds, contrary to libc }
225         end;
226    end;
227
228
229    function sys_close(fd : cint): cint;
230    begin
231       sys_close := int_close(fd);
232       if sys_close <> -1 then
233         begin
234           errno := 0;         { reset errno when the call succeeds, contrary to libc }
235         end;
236    end;
237
238    function sys_read(fd: cint; buf: pchar; nbytes : size_t): ssize_t;
239    begin
240       sys_read := int_read(fd, buf, nbytes);
241       if sys_read <> -1 then
242         begin
243           errno := 0;         { reset errno when the call succeeds, contrary to libc }
244         end;
245    end;
246
247
248    function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
249    begin
250       sys_write := int_write(fd, buf, nbytes);
251       if sys_write <> -1 then
252         begin
253           errno := 0;         { reset errno when the call succeeds, contrary to libc }
254         end;
255    end;
256
257
258    function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
259    begin
260       sys_lseek := int_lseek(fd, offset, whence);
261       if sys_lseek <> -1 then
262         begin
263           errno := 0;         { reset errno when the call succeeds, contrary to libc }
264         end;
265    end;
266
267    function sys_time(var tloc:time_t): time_t;
268    begin
269      sys_time := int_time(tloc);
270      if sys_time <> -1 then
271        begin
272          errno := 0;         { reset errno when the call succeeds, contrary to libc }
273        end;
274    end;
275
276    function sys_ftruncate(fd : cint; flength : off_t): cint;
277    begin
278       sys_ftruncate := int_ftruncate(fd, flength);
279       if sys_ftruncate <> -1 then
280         begin
281           errno := 0;         { reset errno when the call succeeds, contrary to libc }
282         end;
283    end;
284
285    function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
286    begin
287       sys_sigaction := int_sigaction(sig, act, oact);
288       if sys_sigaction <> -1 then
289         begin
290           errno := 0;         { reset errno when the call succeeds, contrary to libc }
291         end;
292    end;
293
294
295    function sys_fstat(fd : cint; var sb : stat): cint;
296      begin
297        sys_fstat := int_fstat(fd, sb);
298        if sys_fstat <> -1 then
299         begin
300           errno := 0;         { reset errno when the call succeeds, contrary to libc }
301         end;
302      end;
303
304    function sys_stat(const path: pchar; var buf : stat): cint;
305      begin
306        sys_stat := int_stat(path, buf);
307        if sys_stat <> -1 then
308         begin
309           errno := 0;         { reset errno when the call succeeds, contrary to libc }
310         end;
311      end;
312
313const
314   _S_IFMT      = $F000;             (*  Type of file                    *)
315   _S_IFIFO     = $1000;             (*  FIFO                            *)
316   _S_IFCHR     = $2000;             (*  Character special               *)
317   _S_IFDIR     = $4000;             (*  Directory                       *)
318   _S_IFNAM     = $5000;             (*  Special named file              *)
319   _S_IFBLK     = $6000;             (*  Block special                   *)
320   _S_IFREG     = $8000;             (*  Regular                         *)
321   _S_IFLNK     = $A000;             (*  Symbolic link                   *)
322   _S_IFSOCK    = $C000;             (*  Socket                          *)
323
324
325    function S_ISDIR(m : mode_t): boolean;
326      begin
327        if (m and _S_IFMT) = _S_IFDIR then
328          S_ISDIR := true
329        else
330          S_ISDIR := false;
331      end;
332
333    function S_ISCHR(m : mode_t): boolean;
334      begin
335        if (m and _S_IFMT) = _S_IFCHR then
336          S_ISCHR := true
337        else
338          S_ISCHR := false;
339      end;
340
341    function S_ISBLK(m : mode_t): boolean;
342      begin
343        if (m and _S_IFMT) = _S_IFBLK then
344          S_ISBLK := true
345        else
346          S_ISBLK := false;
347      end;
348
349    function S_ISREG(m : mode_t): boolean;
350      begin
351        if (m and _S_IFMT) = _S_IFREG then
352          S_ISREG := true
353        else
354          S_ISREG := false;
355      end;
356
357    function S_ISFIFO(m : mode_t): boolean;
358      begin
359        if (m and _S_IFMT) = _S_IFIFO then
360          S_ISFIFO := true
361        else
362          S_ISFIFO := false;
363      end;
364
365    function wifexited(status : cint): cint;
366      begin
367          wifexited := longint((status and $FF) = 0);
368      end;
369
370    function wexitstatus(status : cint): cint;
371     begin
372       wexitstatus := (((status) shr 8) and $FF);
373     end;
374
375    function wstopsig(status : cint): cint;
376     begin
377       wstopsig := (((status) shr 8) and $FF);
378     end;
379
380    function wifsignaled(status : cint): cint;
381     begin
382       if ((status and $FF) <> 0) and ((status and $FF00)=0) then
383         wifsignaled := 1
384       else
385         wifsignaled := 0;
386     end;
387
388end.
389
390{
391  $Log: posix.pp,v $
392  Revision 1.1.2.2  2002/05/01 14:10:36  carl
393  * Correct structures for stat and dirent
394  * correct some compilation problems
395  * change types according to 80x86 version
396
397  Revision 1.1.2.1  2001/12/20 02:55:01  carl
398  + QNX versions (still untested)
399
400  Revision 1.1.2.1  2001/12/09 03:25:17  carl
401  + reinstated
402
403}