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}