mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-05-10 01:32:31 +02:00
464 lines
11 KiB
PHP
464 lines
11 KiB
PHP
{
|
|
Copyright (c) 2001 by Carl Eric Codere
|
|
|
|
Implements POSIX 1003.1 interface
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
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. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
|
|
|
|
const
|
|
syscall_nr_exit = $3F;
|
|
syscall_nr_chdir = $57;
|
|
syscall_nr_mkdir = $1E;
|
|
syscall_nr_unlink = $27;
|
|
syscall_nr_rmdir = $60;
|
|
syscall_nr_close = $01;
|
|
syscall_nr_read = $02;
|
|
syscall_nr_write = $03;
|
|
syscall_nr_stat = $30;
|
|
syscall_nr_fstat = $30;
|
|
syscall_nr_rename = $26;
|
|
syscall_nr_access = $58;
|
|
syscall_nr_opendir= $0C;
|
|
syscall_nr_closedir= $0F;
|
|
syscall_nr_sigaction= $70;
|
|
syscall_nr_time = $07;
|
|
syscall_nr_open = $00;
|
|
syscall_nr_readdir = $1C;
|
|
syscall_nr_lseek = $05;
|
|
syscall_nr_ftruncate = $4b;
|
|
|
|
S_IFDIR =$004000; { Directory. }
|
|
S_IFCHR =$002000; { Character device. }
|
|
S_IFBLK =$006000; { Block device. }
|
|
S_IFREG =$008000; { Regular file. }
|
|
S_IFIFO =$001000; { FIFO. }
|
|
S_IFLNK =$00A000; { Symbolic link. }
|
|
|
|
type
|
|
{ _kwstat_ kernel call structure }
|
|
pwstat = ^twstat;
|
|
twstat = packed record
|
|
{00} filler : array[1..3] of longint;
|
|
{12} newmode : mode_t; { chmod mode_t parameter }
|
|
{16} unknown1 : longint;
|
|
{20} newuser : uid_t; { chown uid_t parameter }
|
|
{24} newgroup : gid_t; { chown gid_t parameter }
|
|
{28} trunc_offset : off_t; { ftrucnate parameter }
|
|
{36} unknown2 : array[1..2] of longint;
|
|
{44} utime_param: int64;
|
|
{52} unknown3 : array[1..2] of longint;
|
|
end;
|
|
|
|
|
|
|
|
|
|
|
|
|
|
{ These routines are currently not required for BeOS }
|
|
function sys_fork : pid_t;
|
|
begin
|
|
end;
|
|
|
|
function sys_execve(const path : pchar; const argv : ppchar; const envp: ppchar): cint;
|
|
begin
|
|
end;
|
|
|
|
function sys_waitpid(pid : pid_t; var stat_loc : cint; options: cint): pid_t;
|
|
begin
|
|
end;
|
|
|
|
|
|
function sys_uname(var name: utsname): cint;
|
|
begin
|
|
FillChar(name, sizeof(utsname), #0);
|
|
name.machine := 'BePC'#0;
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function S_ISDIR(m : mode_t): boolean;
|
|
begin
|
|
if (m and S_IFDIR)= S_IFDIR then
|
|
S_ISDIR := true
|
|
else
|
|
S_ISDIR := false;
|
|
end;
|
|
|
|
function S_ISCHR(m : mode_t): boolean;
|
|
begin
|
|
if (m and S_IFCHR) = S_IFCHR then
|
|
S_ISCHR := true
|
|
else
|
|
S_ISCHR := false;
|
|
end;
|
|
|
|
function S_ISBLK(m : mode_t): boolean;
|
|
begin
|
|
if (m and S_IFBLK) = S_IFBLK then
|
|
S_ISBLK := true
|
|
else
|
|
S_ISBLK := false;
|
|
end;
|
|
|
|
function S_ISREG(m : mode_t): boolean;
|
|
begin
|
|
if (m and S_IFREG) = S_IFREG then
|
|
S_ISREG := true
|
|
else
|
|
S_ISREG := false;
|
|
end;
|
|
|
|
function S_ISFIFO(m : mode_t): boolean;
|
|
begin
|
|
if (m and S_IFIFO) = S_IFIFO then
|
|
S_ISFIFO := true
|
|
else
|
|
S_ISFIFO := false;
|
|
end;
|
|
|
|
function wifexited(status : cint): cint;
|
|
begin
|
|
wifexited := byte(boolean((status and not $FF) = 0));
|
|
end;
|
|
|
|
function wexitstatus(status : cint): cint;
|
|
begin
|
|
wexitstatus := status and $FF;
|
|
end;
|
|
|
|
function wstopsig(status : cint): cint;
|
|
begin
|
|
wstopsig:=(status shr 16) and $FF;
|
|
end;
|
|
|
|
function wifsignaled(status : cint): cint;
|
|
begin
|
|
if (((status) shr 8) and $ff) <> 0 then
|
|
wifsignaled := 1
|
|
else
|
|
wifsignaled := 0;
|
|
end;
|
|
|
|
|
|
{$i syscall.inc}
|
|
|
|
procedure sys_exit(status : cint); external name 'sys_exit';
|
|
(*
|
|
procedure sys_exit(status : cint);
|
|
var
|
|
args: SysCallArgs;
|
|
begin
|
|
args.param[1] := status;
|
|
SysCall(syscall_nr_exit,args);
|
|
end;
|
|
*)
|
|
|
|
function sys_close(fd : cint): cint;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
args.param[1] := fd;
|
|
sys_close:=SysCall(syscall_nr_close,args);
|
|
end;
|
|
|
|
|
|
function sys_time(var tloc:time_t): time_t;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
{ don't treat errno, since there is never any }
|
|
tloc := Do_Syscall(syscall_nr_time,args);
|
|
sys_time := tloc;
|
|
end;
|
|
|
|
|
|
|
|
function sys_sigaction(sig: cint; var act : sigactionrec; var oact : sigactionrec): cint;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
args.param[1] := sig;
|
|
args.param[2] := cint(@act);
|
|
args.param[3] := cint(@oact);
|
|
sys_sigaction := SysCall(syscall_nr_sigaction, args);
|
|
end;
|
|
|
|
|
|
function sys_closedir(dirp : pdir): cint;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
if assigned(dirp) then
|
|
begin
|
|
args.param[1] := dirp^.fd;
|
|
sys_closedir := SysCall(syscall_nr_closedir,args);
|
|
Dispose(dirp);
|
|
dirp := nil;
|
|
exit;
|
|
end;
|
|
Errno := Sys_EBADF;
|
|
sys_closedir := -1;
|
|
end;
|
|
|
|
|
|
function sys_opendir(const dirname : pchar): pdir;
|
|
var
|
|
args : SysCallArgs;
|
|
dirp: pdir;
|
|
fd : cint;
|
|
begin
|
|
New(dirp);
|
|
{ just in case }
|
|
FillChar(dirp^,sizeof(dir),#0);
|
|
if assigned(dirp) then
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(dirname);
|
|
args.param[3] := 0;
|
|
fd:=SysCall(syscall_nr_opendir,args);
|
|
if fd = -1 then
|
|
begin
|
|
Dispose(dirp);
|
|
sys_opendir := nil;
|
|
exit;
|
|
end;
|
|
dirp^.fd := fd;
|
|
sys_opendir := dirp;
|
|
exit;
|
|
end;
|
|
Errno := Sys_EMFILE;
|
|
sys_opendir := nil;
|
|
end;
|
|
|
|
|
|
function sys_access(const pathname : pchar; amode : cint): cint;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(pathname);
|
|
args.param[3] := amode;
|
|
sys_access := SysCall(syscall_nr_access,args);
|
|
end;
|
|
|
|
|
|
function sys_rename(const old : pchar; const newpath: pchar): cint;
|
|
var
|
|
args: SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(old);
|
|
args.param[3] := $FFFFFFFF;
|
|
args.param[4] := cint(newpath);
|
|
sys_rename := SysCall(syscall_nr_rename,args);
|
|
end;
|
|
|
|
|
|
function sys_rmdir(const path : pchar): cint;
|
|
var
|
|
args: SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(path);
|
|
sys_rmdir := SysCall(syscall_nr_rmdir,args);
|
|
end;
|
|
|
|
|
|
function sys_unlink(const path: pchar): cint;
|
|
var
|
|
args :SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(path);
|
|
sys_unlink := SysCall(syscall_nr_unlink,args);
|
|
end;
|
|
|
|
|
|
|
|
function sys_mkdir(const path : pchar; mode: mode_t):cint;
|
|
var
|
|
args :SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(path);
|
|
args.param[3] := cint(mode);
|
|
sys_mkdir := SysCall(syscall_nr_mkdir,args);
|
|
end;
|
|
|
|
|
|
function sys_fstat(fd : cint; var sb : stat): cint;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
args.param[1] := fd;
|
|
args.param[2] := $00;
|
|
args.param[3] := cint(@sb);
|
|
args.param[4] := $00000001;
|
|
sys_fstat := SysCall(syscall_nr_fstat, args);
|
|
end;
|
|
|
|
|
|
function sys_stat(const path: pchar; var buf : stat): cint;
|
|
var
|
|
args : SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(path);
|
|
args.param[3] := cint(@buf);
|
|
args.param[4] := $01000000;
|
|
sys_stat := SysCall(syscall_nr_stat, args);
|
|
end;
|
|
|
|
|
|
function sys_read(fd: cint; buf:pchar; nbytes : size_t): ssize_t;
|
|
var
|
|
args : SysCallArgs;
|
|
funcresult: ssize_t;
|
|
errorcode : cint;
|
|
begin
|
|
args.param[1] := fd;
|
|
args.param[2] := cint(buf);
|
|
args.param[3] := cint(nbytes);
|
|
args.param[4] := cint(@errorcode);
|
|
funcresult := ssize_t(Do_SysCall(syscall_nr_read,args));
|
|
if funcresult >= 0 then
|
|
begin
|
|
sys_read := funcresult;
|
|
errno := 0;
|
|
end
|
|
else
|
|
begin
|
|
sys_read := -1;
|
|
errno := errorcode;
|
|
end;
|
|
end;
|
|
|
|
|
|
function sys_write(fd: cint;const buf:pchar; nbytes : size_t): ssize_t;
|
|
var
|
|
args : SysCallArgs;
|
|
funcresult : ssize_t;
|
|
errorcode : cint;
|
|
begin
|
|
args.param[1] := fd;
|
|
args.param[2] := cint(buf);
|
|
args.param[3] := cint(nbytes);
|
|
args.param[4] := cint(@errorcode);
|
|
funcresult := Do_SysCall(syscall_nr_write,args);
|
|
if funcresult >= 0 then
|
|
begin
|
|
sys_write := funcresult;
|
|
errno := 0;
|
|
end
|
|
else
|
|
begin
|
|
sys_write := -1;
|
|
errno := errorcode;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
function sys_chdir(const path : pchar): cint;
|
|
var
|
|
args: SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(path);
|
|
sys_chdir := SysCall(syscall_nr_chdir, args);
|
|
end;
|
|
|
|
|
|
function sys_open(const path: pchar; flags : cint; mode: mode_t):cint;
|
|
var
|
|
args: SysCallArgs;
|
|
begin
|
|
args.param[1] := $FFFFFFFF;
|
|
args.param[2] := cint(path);
|
|
args.param[3] := flags;
|
|
args.param[4] := cint(mode);
|
|
args.param[5] := 0; { close on execute flag }
|
|
sys_open:= SysCall(syscall_nr_open, args);
|
|
end;
|
|
|
|
|
|
function sys_readdir(dirp : pdir) : pdirent;
|
|
var
|
|
args : SysCallArgs;
|
|
funcresult : cint;
|
|
begin
|
|
args.param[1] := dirp^.fd;
|
|
args.param[2] := cint(@(dirp^.ent));
|
|
args.param[3] := $0000011C;
|
|
args.param[4] := $00000001;
|
|
{ the error will be processed here }
|
|
funcresult := Do_SysCall(syscall_nr_readdir, args);
|
|
if funcresult <> 1 then
|
|
begin
|
|
if funcresult <> 0 then
|
|
errno := funcresult;
|
|
sys_readdir := nil;
|
|
exit;
|
|
end;
|
|
errno := 0;
|
|
sys_readdir := @dirp^.ent
|
|
end;
|
|
|
|
|
|
function sys_lseek(fd : cint; offset : off_t; whence : cint): off_t;
|
|
var
|
|
args: SysCallArgs;
|
|
|
|
begin
|
|
args.param[1] := fd;
|
|
args.param[2] := cint(offset and $FFFFFFFF);
|
|
args.param[3] := cint((offset shr 32) and $FFFFFFFF);
|
|
args.param[4] := whence;
|
|
{ we currently only support seeks upto 32-bit in length }
|
|
sys_lseek := off_t(SysCall(syscall_nr_lseek,args));
|
|
end;
|
|
|
|
|
|
function sys_ftruncate(fd : cint; flength : off_t): cint;
|
|
var
|
|
args: SysCallArgs;
|
|
wstat : pwstat;
|
|
begin
|
|
New(wstat);
|
|
FillChar(wstat^,sizeof(wstat),0);
|
|
wstat^.trunc_offset := flength;
|
|
args.param[1] := fd;
|
|
args.param[2] := $00000000;
|
|
args.param[3] := cint(wstat);
|
|
args.param[4] := $00000008;
|
|
args.param[5] := $00000001;
|
|
sys_ftruncate:=SysCall(syscall_nr_ftruncate, args);
|
|
Dispose(wstat);
|
|
end;
|
|
|
|
{
|
|
|
|
|
|
Revision 1.3 2005/02/14 17:13:21 peter
|
|
* truncate log
|
|
|
|
}
|