paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 16:09:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* a few functions added.

Browse Source
This commit is contained in:
marco 2000-02-04 12:05:04 +00:00
parent 84ad19e224
commit aa8b9730a1
1 changed files with 127 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

208
rtl/bsd/linux.pp
View File

@ -614,11 +614,13 @@ function AssignStream(var StreamIn, StreamOut, StreamErr: Text; const prog: Stri
General information General information
***************************} ***************************}
{
Function GetDomainName:String; Function GetDomainName:String;
Function GetHostName:String; Function GetHostName:String;
Function GetEnv(P:string):Pchar;
Function Sysinfo(var Info:TSysinfo):Boolean; Function Sysinfo(var Info:TSysinfo):Boolean;
Function Uname(var unamerec:utsname):Boolean; Function Uname(var unamerec:utsname):Boolean;
}
Function GetEnv(P:string):Pchar;
{************************** {**************************
Signal Signal
@ -628,7 +630,7 @@ Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet); Procedure SigProcMask (How:Integer;SSet,OldSSet:PSigSet);
Function SigPending:SigSet; Function SigPending:SigSet;
Procedure SigSuspend(Mask:Sigset); Procedure SigSuspend(Mask:Sigset);
Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler; //Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
Function Kill(Pid:longint;Sig:integer):integer; Function Kill(Pid:longint;Sig:integer):integer;
Procedure SigRaise(Sig:integer); Procedure SigRaise(Sig:integer);
Function Alarm(Sec : Longint) : longint; Function Alarm(Sec : Longint) : longint;
@ -2125,7 +2127,7 @@ begin
Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle); Dup2:=Dup2(filerec(oldfile).handle,filerec(newfile).handle);
end; end;
{
Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint; Function Select(N:longint;readfds,writefds,exceptfds:PFDSet;TimeOut:PTimeVal):longint;
{ {
Select checks whether the file descriptor sets in readfs/writefs/exceptfs Select checks whether the file descriptor sets in readfs/writefs/exceptfs
@ -2165,7 +2167,7 @@ begin
end; end;
Select:=Select(N,Readfds,WriteFds,ExceptFds,p); Select:=Select(N,Readfds,WriteFds,ExceptFds,p);
end; end;
}
Function SelectText(var T:Text;TimeOut :PTimeval):Longint; Function SelectText(var T:Text;TimeOut :PTimeval):Longint;
@ -2295,18 +2297,24 @@ Function AssignPipe(var pipe_in,pipe_out:longint):boolean;
} }
var var
pip : tpipe; pip : tpipe;
regs : SysCallregs; retval : LONGINT;
begin begin
regs.reg2:=longint(@pip); asm
SysCall(SysCall_nr_pipe,regs); lea pip,%ebx
pipe_in:=pip[1]; push %ebx
pipe_out:=pip[2]; mov $42,%eax
linuxerror:=errno; int $0x80
AssignPipe:=(LinuxError=0); addl $4,%esp
mov %eax,retval
end;
checkreturnvalue(retval,retval);
LinuxError:=Errno;
pipe_in:=pip[1];
pipe_out:=pip[2];
AssignPipe:=(LinuxError=0);
end; end;
Function AssignPipe(var pipe_in,pipe_out:text):boolean; Function AssignPipe(var pipe_in,pipe_out:text):boolean;
{ {
Sets up a pair of file variables, which act as a pipe. The first one can Sets up a pair of file variables, which act as a pipe. The first one can
@ -2375,12 +2383,17 @@ end;
Function PClose(Var F:text) :longint; Function PClose(Var F:text) :longint;
var var
sr : syscallregs;
pl : ^longint; pl : ^longint;
res : longint; res : longint;
begin begin
sr.reg2:=Textrec(F).Handle; res:=Textrec(F).Handle;
SysCall (syscall_nr_close,sr); asm
push res
mov $6,%eax
int $0x80
add $4,%esp
end;
{ closed our side, Now wait for the other - this appears to be needed ?? } { closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(textrec(f).userdata[2]); pl:=@(textrec(f).userdata[2]);
waitpid(pl^,@res,0); waitpid(pl^,@res,0);
@ -2390,19 +2403,23 @@ end;
Function PClose(Var F:file) : longint; Function PClose(Var F:file) : longint;
var var
sr : syscallregs;
pl : ^longint; pl : ^longint;
res : longint; res : longint;
begin begin
sr.reg2:=FileRec(F).Handle; res:=filerec(F).Handle;
SysCall (Syscall_nr_close,sr); asm
push res
mov $6,%eax
int $0x80
add $4,%esp
end;
{ closed our side, Now wait for the other - this appears to be needed ?? } { closed our side, Now wait for the other - this appears to be needed ?? }
pl:=@(filerec(f).userdata[2]); pl:=@(filerec(f).userdata[2]);
waitpid(pl^,@res,0); waitpid(pl^,@res,0);
pclose:=res shr 8; pclose:=res shr 8;
end; end;
Procedure PCloseText(Var F:text); Procedure PCloseText(Var F:text);
{ {
May not use @PClose due overloading May not use @PClose due overloading
@ -2411,8 +2428,6 @@ begin
PClose(f); PClose(f);
end; end;
Procedure POpen(var F:text;const Prog:String;rw:char); Procedure POpen(var F:text;const Prog:String;rw:char);
{ {
Starts the program in 'Prog' and makes it's input or out put the Starts the program in 'Prog' and makes it's input or out put the
@ -2577,17 +2592,26 @@ end;
Function mkFifo(pathname:string;mode:longint):boolean; Function mkFifo(pathname:string;mode:longint):boolean;
var var retval : LONGINT;
regs : SysCallRegs;
begin begin
pathname:=pathname+#0; pathname:=pathname+#0;
regs.reg2:=longint(@pathname[1]); asm
regs.reg3:=mode or STAT_IFIFO; lea %ecx,pathname
regs.reg4:=0; inc %ecx
mkFifo:=(SysCall(syscall_nr_mknod,regs)=0); push $0
mov mode,%ebx
or STAT_IFIFO,%ebx
push %ebx
push %ecx
mov $14,$eax
int $0x80
addl $12,%esp
mov %eax,retval
end;
mkfifo:=checkreturnvalue(retval,retval)=0;
LinuxError:=Errno;
end; end;
Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String); Procedure AssignStream(Var StreamIn,Streamout:text;Const Prog:String);
{ {
Starts the program in 'Prog' and makes its input and output the Starts the program in 'Prog' and makes its input and output the
@ -2754,6 +2778,7 @@ end;
General information calls General information calls
******************************************************************************} ******************************************************************************}
{
Function Sysinfo(var Info:TSysinfo):Boolean; Function Sysinfo(var Info:TSysinfo):Boolean;
{ {
Get system info Get system info
@ -2764,9 +2789,9 @@ Begin
regs.reg2:=longint(@info); regs.reg2:=longint(@info);
Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0; Sysinfo:=SysCall(SysCall_nr_Sysinfo,regs)=0;
End; End;
}
{
Function Uname(var unamerec:utsname):Boolean; Function Uname(var unamerec:utsname):Boolean;
{ {
Get machine's names Get machine's names
@ -2778,7 +2803,7 @@ Begin
Uname:=SysCall(SysCall_nr_uname,regs)=0; Uname:=SysCall(SysCall_nr_uname,regs)=0;
LinuxError:=Errno; LinuxError:=Errno;
End; End;
}
Function GetEnv(P:string):Pchar; Function GetEnv(P:string):Pchar;
@ -2810,7 +2835,7 @@ Begin
getenv:=nil; getenv:=nil;
end; end;
{
Function GetDomainName:String; Function GetDomainName:String;
{ {
@ -2827,8 +2852,6 @@ begin
getdomainname:=strpas(@Sysn.domainname[0]); getdomainname:=strpas(@Sysn.domainname[0]);
end; end;
Function GetHostName:String; Function GetHostName:String;
{ {
Get machines name. Returns empty string if not set. Get machines name. Returns empty string if not set.
@ -2843,7 +2866,7 @@ begin
else else
gethostname:=strpas(@Sysn.nodename[0]); gethostname:=strpas(@Sysn.nodename[0]);
end; end;
}
{****************************************************************************** {******************************************************************************
Signal handling calls Signal handling calls
@ -2858,19 +2881,23 @@ Function Kill(Pid:longint;Sig:integer):integer;
Return value is zero, except for case three, where the return value Return value is zero, except for case three, where the return value
is the number of processes to which the signal was sent. is the number of processes to which the signal was sent.
} }
var
regs : Syscallregs; var retval : LONGINT;
begin begin
regs.reg2:=Pid; asm
regs.reg3:=Sig; push Sig
kill:=SysCall(Syscall_nr_kill,regs); push Pid
if kill<0 then mov $37,$eax
Kill:=0; int $0x80
linuxerror:=errno; addl $8,%esp
mov %eax,retval
end;
Kill:=checkreturnvalue(retval,retval);
if kill<0 THEN
Kill:=0;
LinuxError:=Errno;
end; end;
Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec ); Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
{ {
Change action of process upon receipt of a signal. Change action of process upon receipt of a signal.
@ -2878,18 +2905,24 @@ Procedure SigAction(Signum:Integer;Var Act,OldAct:PSigActionRec );
If Act is non-nil, it is used to specify the new action. If Act is non-nil, it is used to specify the new action.
If OldAct is non-nil the previous action is saved there. If OldAct is non-nil the previous action is saved there.
} }
Var
sr : Syscallregs; var retval : LONGINT;
begin begin
sr.reg2:=Signum; asm
sr.reg3:=Longint(act); push oldact
sr.reg4:=Longint(oldact); push act
SysCall(Syscall_nr_sigaction,sr); push signum
linuxerror:=errno; mov $46,$eax
int $0x80
addl $12,%esp
mov %eax,retval
end;
SigAction:=checkreturnvalue(retval,retval);
if kill<0 THEN
Kill:=0;
LinuxError:=Errno;
end; end;
Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet); Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
{ {
Change the list of currently blocked signals. Change the list of currently blocked signals.
@ -2899,58 +2932,68 @@ Procedure SigProcMask(How:Integer;SSet,OldSSet:PSigSet);
SigSetMask : Set the list of blocked signals to SSet SigSetMask : Set the list of blocked signals to SSet
if OldSSet is non-null, the old set will be saved there. if OldSSet is non-null, the old set will be saved there.
} }
Var VAR retval : LONGINT;
sr : SyscallRegs;
begin begin
sr.reg2:=how; asm
sr.reg3:=longint(SSet); push OldSSet
sr.reg4:=longint(OldSSet); push SSet
SysCall(Syscall_nr_sigprocmask,sr); push How
linuxerror:=errno; mov $48,%eax
int $0x80
addl $12,%esp
mov %eax,retval
end;
SigProcMask:=checkreturnvalue(retval,retval);
LinuxError:=Errno;
end; end;
Function SigPending:SigSet; Function SigPending:SigSet;
{ {
Allows examination of pending signals. The signal mask of pending Allows examination of pending signals. The signal mask of pending
signals is set in SSet signals is set in SSet
} }
Var Var
sr : SyscallRegs;
dummy : Sigset; dummy : Sigset;
retval: LONGINT;
begin begin
sr.reg2:=longint(@dummy); asm
SysCall(Syscall_nr_sigpending,sr); push dummy
linuxerror:=errno; mov $52,%eax
Sigpending:=dummy; int $0x80
addl $4,%esp
end;
sigpending:=checkreturnvalue(retval,dummy);
LinuxError:=Errno;
end; end;
Procedure SigSuspend(Mask:Sigset); Procedure SigSuspend(Mask:Sigset);
{ {
Set the signal mask with Mask, and suspend the program until a signal Set the signal mask with Mask, and suspend the program until a signal
is received. is received.
} }
Var Var
sr : SyscallRegs; retval: LONGINT;
begin begin
sr.reg2:=mask; asm
SysCall(Syscall_nr_sigsuspend,sr); push mask
linuxerror:=errno; mov $111,%eax
int $0x80
addl $4,%esp
mov %eax,retval
end;
checkreturnvalue(retval,retval);
LinuxError:=Errno;
end; end;
{
Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler; Function Signal(Signum:Integer;Handler:SignalHandler):SignalHandler;
{ {
Install a new handler for signal Signum. Install a new handler for signal Signum.
The old signal handler is returned. The old signal handler is returned.
This call does, in fact, the same as SigAction. This call does, in fact, the same as SigAction.
} }
var
sr : Syscallregs;
begin begin
sr.reg2:=signum; sr.reg2:=signum;
sr.reg3:=longint(handler); sr.reg3:=longint(handler);
@ -2966,7 +3009,7 @@ begin
linuxerror:=0; linuxerror:=0;
end; end;
end; end;
}
procedure SigRaise(sig:integer); procedure SigRaise(sig:integer);
begin begin
@ -3996,7 +4039,10 @@ End.
{ {
$Log$ $Log$
Revision 1.1 2000-02-03 17:03:36 marco Revision 1.2 2000-02-04 12:05:04 marco
* a few functions added.
Revision 1.1 2000/02/03 17:03:36 marco
* initial version. Ported till line +/- 2000 * initial version. Ported till line +/- 2000