mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-21 21:50:07 +02:00
* Clone moved to linux, + few small unit unix changes
This commit is contained in:
parent
3d4733e1e9
commit
7bfead6dab
@ -26,86 +26,6 @@ begin
|
|||||||
fpmunmap(pointer(adr),cint(len));
|
fpmunmap(pointer(adr),cint(len));
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
|
||||||
begin
|
|
||||||
if (pointer(func)=nil) or (sp=nil) then
|
|
||||||
exit(-1); // give an error result
|
|
||||||
{$ifdef cpui386}
|
|
||||||
{$ASMMODE ATT}
|
|
||||||
asm
|
|
||||||
{ Insert the argument onto the new stack. }
|
|
||||||
movl sp,%ecx
|
|
||||||
subl $8,%ecx
|
|
||||||
movl args,%eax
|
|
||||||
movl %eax,4(%ecx)
|
|
||||||
|
|
||||||
{ Save the function pointer as the zeroth argument.
|
|
||||||
It will be popped off in the child in the ebx frobbing below. }
|
|
||||||
movl func,%eax
|
|
||||||
movl %eax,0(%ecx)
|
|
||||||
|
|
||||||
{ Do the system call }
|
|
||||||
pushl %ebx
|
|
||||||
movl flags,%ebx
|
|
||||||
movl SysCall_nr_clone,%eax
|
|
||||||
int $0x80
|
|
||||||
popl %ebx
|
|
||||||
test %eax,%eax
|
|
||||||
jnz .Lclone_end
|
|
||||||
|
|
||||||
{ We're in the new thread }
|
|
||||||
subl %ebp,%ebp { terminate the stack frame }
|
|
||||||
call *%ebx
|
|
||||||
{ exit process }
|
|
||||||
movl %eax,%ebx
|
|
||||||
movl $1,%eax
|
|
||||||
int $0x80
|
|
||||||
|
|
||||||
.Lclone_end:
|
|
||||||
movl %eax,__RESULT
|
|
||||||
end;
|
|
||||||
{$endif cpui386}
|
|
||||||
{$ifdef cpum68k}
|
|
||||||
{ No yet translated, my m68k assembler is too weak for such things PM }
|
|
||||||
(*
|
|
||||||
asm
|
|
||||||
{ Insert the argument onto the new stack. }
|
|
||||||
movl sp,%ecx
|
|
||||||
subl $8,%ecx
|
|
||||||
movl args,%eax
|
|
||||||
movl %eax,4(%ecx)
|
|
||||||
|
|
||||||
{ Save the function pointer as the zeroth argument.
|
|
||||||
It will be popped off in the child in the ebx frobbing below. }
|
|
||||||
movl func,%eax
|
|
||||||
movl %eax,0(%ecx)
|
|
||||||
|
|
||||||
{ Do the system call }
|
|
||||||
pushl %ebx
|
|
||||||
movl flags,%ebx
|
|
||||||
movl SysCall_nr_clone,%eax
|
|
||||||
int $0x80
|
|
||||||
popl %ebx
|
|
||||||
test %eax,%eax
|
|
||||||
jnz .Lclone_end
|
|
||||||
|
|
||||||
{ We're in the new thread }
|
|
||||||
subl %ebp,%ebp { terminate the stack frame }
|
|
||||||
call *%ebx
|
|
||||||
{ exit process }
|
|
||||||
movl %eax,%ebx
|
|
||||||
movl $1,%eax
|
|
||||||
int $0x80
|
|
||||||
|
|
||||||
.Lclone_end:
|
|
||||||
movl %eax,__RESULT
|
|
||||||
end;
|
|
||||||
*)
|
|
||||||
{$endif cpum68k}
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
Interface to Unix ioctl call.
|
Interface to Unix ioctl call.
|
||||||
Performs various operations on the filedescriptor Handle.
|
Performs various operations on the filedescriptor Handle.
|
||||||
@ -122,7 +42,10 @@ end;
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 2003-10-31 08:55:11 mazen
|
Revision 1.3 2003-11-17 11:28:08 marco
|
||||||
|
* Clone moved to linux, + few small unit unix changes
|
||||||
|
|
||||||
|
Revision 1.2 2003/10/31 08:55:11 mazen
|
||||||
+ assembler mode forced to ATT style for x86 cpu
|
+ assembler mode forced to ATT style for x86 cpu
|
||||||
|
|
||||||
Revision 1.1 2003/10/30 16:42:25 marco
|
Revision 1.1 2003/10/30 16:42:25 marco
|
||||||
|
@ -88,22 +88,12 @@ Const
|
|||||||
|
|
||||||
{Constansts Termios/Ioctl (used in Do_IsDevice) }
|
{Constansts Termios/Ioctl (used in Do_IsDevice) }
|
||||||
IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
|
IOCtl_TCGETS=$5401; // TCGETS is also in termios.inc, but the sysunix needs only this
|
||||||
|
|
||||||
{Checked for BSD using Linuxthreads port}
|
|
||||||
{ cloning flags }
|
|
||||||
CSIGNAL = $000000ff; // signal mask to be sent at exit
|
|
||||||
CLONE_VM = $00000100; // set if VM shared between processes
|
|
||||||
CLONE_FS = $00000200; // set if fs info shared between processes
|
|
||||||
CLONE_FILES = $00000400; // set if open files shared between processes
|
|
||||||
CLONE_SIGHAND = $00000800; // set if signal handlers shared
|
|
||||||
CLONE_PID = $00001000; // set if pid shared
|
|
||||||
type
|
|
||||||
TCloneFunc=function(args:pointer):longint;cdecl;
|
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.6 2002-09-07 16:01:19 peter
|
Revision 1.7 2003-11-17 11:28:08 marco
|
||||||
|
* Clone moved to linux, + few small unit unix changes
|
||||||
|
|
||||||
|
Revision 1.6 2002/09/07 16:01:19 peter
|
||||||
* old logs removed and tabs fixed
|
* old logs removed and tabs fixed
|
||||||
|
|
||||||
}
|
}
|
||||||
|
@ -35,9 +35,21 @@ Type
|
|||||||
end;
|
end;
|
||||||
PSysInfo = ^TSysInfo;
|
PSysInfo = ^TSysInfo;
|
||||||
|
|
||||||
|
|
||||||
Function Sysinfo(var Info:TSysinfo):Boolean;
|
Function Sysinfo(var Info:TSysinfo):Boolean;
|
||||||
|
|
||||||
|
Const
|
||||||
|
CSIGNAL = $000000ff; // signal mask to be sent at exit
|
||||||
|
CLONE_VM = $00000100; // set if VM shared between processes
|
||||||
|
CLONE_FS = $00000200; // set if fs info shared between processes
|
||||||
|
CLONE_FILES = $00000400; // set if open files shared between processes
|
||||||
|
CLONE_SIGHAND = $00000800; // set if signal handlers shared
|
||||||
|
CLONE_PID = $00001000; // set if pid shared
|
||||||
|
|
||||||
|
type
|
||||||
|
TCloneFunc=function(args:pointer):longint;cdecl;
|
||||||
|
|
||||||
|
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
Uses Syscall;
|
Uses Syscall;
|
||||||
@ -50,12 +62,94 @@ Begin
|
|||||||
Sysinfo:=do_SysCall(SysCall_nr_Sysinfo,longint(@info))=0;
|
Sysinfo:=do_SysCall(SysCall_nr_Sysinfo,longint(@info))=0;
|
||||||
End;
|
End;
|
||||||
|
|
||||||
|
function Clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if (pointer(func)=nil) or (sp=nil) then
|
||||||
|
exit(-1); // give an error result
|
||||||
|
{$ifdef cpui386}
|
||||||
|
{$ASMMODE ATT}
|
||||||
|
asm
|
||||||
|
{ Insert the argument onto the new stack. }
|
||||||
|
movl sp,%ecx
|
||||||
|
subl $8,%ecx
|
||||||
|
movl args,%eax
|
||||||
|
movl %eax,4(%ecx)
|
||||||
|
|
||||||
|
{ Save the function pointer as the zeroth argument.
|
||||||
|
It will be popped off in the child in the ebx frobbing below. }
|
||||||
|
movl func,%eax
|
||||||
|
movl %eax,0(%ecx)
|
||||||
|
|
||||||
|
{ Do the system call }
|
||||||
|
pushl %ebx
|
||||||
|
movl flags,%ebx
|
||||||
|
movl SysCall_nr_clone,%eax
|
||||||
|
int $0x80
|
||||||
|
popl %ebx
|
||||||
|
test %eax,%eax
|
||||||
|
jnz .Lclone_end
|
||||||
|
|
||||||
|
{ We're in the new thread }
|
||||||
|
subl %ebp,%ebp { terminate the stack frame }
|
||||||
|
call *%ebx
|
||||||
|
{ exit process }
|
||||||
|
movl %eax,%ebx
|
||||||
|
movl $1,%eax
|
||||||
|
int $0x80
|
||||||
|
|
||||||
|
.Lclone_end:
|
||||||
|
movl %eax,__RESULT
|
||||||
|
end;
|
||||||
|
{$endif cpui386}
|
||||||
|
{$ifdef cpum68k}
|
||||||
|
{ No yet translated, my m68k assembler is too weak for such things PM }
|
||||||
|
(*
|
||||||
|
asm
|
||||||
|
{ Insert the argument onto the new stack. }
|
||||||
|
movl sp,%ecx
|
||||||
|
subl $8,%ecx
|
||||||
|
movl args,%eax
|
||||||
|
movl %eax,4(%ecx)
|
||||||
|
|
||||||
|
{ Save the function pointer as the zeroth argument.
|
||||||
|
It will be popped off in the child in the ebx frobbing below. }
|
||||||
|
movl func,%eax
|
||||||
|
movl %eax,0(%ecx)
|
||||||
|
|
||||||
|
{ Do the system call }
|
||||||
|
pushl %ebx
|
||||||
|
movl flags,%ebx
|
||||||
|
movl SysCall_nr_clone,%eax
|
||||||
|
int $0x80
|
||||||
|
popl %ebx
|
||||||
|
test %eax,%eax
|
||||||
|
jnz .Lclone_end
|
||||||
|
|
||||||
|
{ We're in the new thread }
|
||||||
|
subl %ebp,%ebp { terminate the stack frame }
|
||||||
|
call *%ebx
|
||||||
|
{ exit process }
|
||||||
|
movl %eax,%ebx
|
||||||
|
movl $1,%eax
|
||||||
|
int $0x80
|
||||||
|
|
||||||
|
.Lclone_end:
|
||||||
|
movl %eax,__RESULT
|
||||||
|
end;
|
||||||
|
*)
|
||||||
|
{$endif cpum68k}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.2 2003-09-15 20:08:49 marco
|
Revision 1.3 2003-11-17 11:28:08 marco
|
||||||
|
* Clone moved to linux, + few small unit unix changes
|
||||||
|
|
||||||
|
Revision 1.2 2003/09/15 20:08:49 marco
|
||||||
* small fixes. FreeBSD now cycles
|
* small fixes. FreeBSD now cycles
|
||||||
|
|
||||||
Revision 1.1 2003/09/15 14:12:17 marco
|
Revision 1.1 2003/09/15 14:12:17 marco
|
||||||
|
@ -136,9 +136,6 @@ function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
|
|||||||
|
|
||||||
function CreateShellArgV(const prog:string):ppchar;
|
function CreateShellArgV(const prog:string):ppchar;
|
||||||
function CreateShellArgV(const prog:Ansistring):ppchar;
|
function CreateShellArgV(const prog:Ansistring):ppchar;
|
||||||
//Procedure Execve(Path: pathstr;args:ppchar;ep:ppchar);
|
|
||||||
//Procedure Execve(Path: AnsiString;args:ppchar;ep:ppchar);
|
|
||||||
//Procedure Execve(path: pchar;args:ppchar;ep:ppchar);
|
|
||||||
Function Execv(const path:pathstr;args:ppchar):cint;
|
Function Execv(const path:pathstr;args:ppchar):cint;
|
||||||
Function Execv(const path: AnsiString;args:ppchar):cint;
|
Function Execv(const path: AnsiString;args:ppchar):cint;
|
||||||
Function Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar):cint;
|
Function Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar):cint;
|
||||||
@ -154,7 +151,7 @@ Function Shell(const Command:String):cint;
|
|||||||
Function Shell (const Command:AnsiString):cint;
|
Function Shell (const Command:AnsiString):cint;
|
||||||
|
|
||||||
{Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
|
{Clone for FreeBSD is copied from the LinuxThread port, and rfork based}
|
||||||
function Clone(func:TCloneFunc;sp:pointer;flags:cint;args:pointer):cint;
|
//function Clone(func:TCloneFunc;sp:pointer;flags:cint;args:pointer):cint;
|
||||||
Function WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
|
Function WaitProcess(Pid:cint):cint; { like WaitPid(PID,@result,0) Handling of Signal interrupts (errno=EINTR), returning the Exitcode of Process (>=0) or -Status if terminated}
|
||||||
|
|
||||||
Function WIFSTOPPED(Status: Integer): Boolean;
|
Function WIFSTOPPED(Status: Integer): Boolean;
|
||||||
@ -1713,7 +1710,10 @@ End.
|
|||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$Log$
|
||||||
Revision 1.48 2003-11-17 10:05:51 marco
|
Revision 1.49 2003-11-17 11:28:08 marco
|
||||||
|
* Clone moved to linux, + few small unit unix changes
|
||||||
|
|
||||||
|
Revision 1.48 2003/11/17 10:05:51 marco
|
||||||
* threads for FreeBSD. Not working tho
|
* threads for FreeBSD. Not working tho
|
||||||
|
|
||||||
Revision 1.47 2003/11/14 17:30:14 marco
|
Revision 1.47 2003/11/14 17:30:14 marco
|
||||||
|
Loading…
Reference in New Issue
Block a user