paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 05:49:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Clone moved to linux, + few small unit unix changes

Browse Source
This commit is contained in:
marco 2003-11-17 11:28:08 +00:00
parent 3d4733e1e9
commit 7bfead6dab
4 changed files with 116 additions and 109 deletions

85
rtl/linux/sysc11.inc
View File

@ -26,86 +26,6 @@ begin
fpmunmap(pointer(adr),cint(len));
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.
Performs various operations on the filedescriptor Handle.
@ -122,7 +42,10 @@ end;
{
$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
Revision 1.1 2003/10/30 16:42:25 marco

18
rtl/linux/sysconst.inc
View File

@ -88,22 +88,12 @@ Const
{Constansts Termios/Ioctl (used in Do_IsDevice) }
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$
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
}

98
rtl/unix/linuxnew.inc
View File

@ -35,9 +35,21 @@ Type
end;
PSysInfo = ^TSysInfo;
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
Uses Syscall;
@ -50,12 +62,94 @@ Begin
Sysinfo:=do_SysCall(SysCall_nr_Sysinfo,longint(@info))=0;
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.
{
$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
Revision 1.1 2003/09/15 14:12:17 marco

24
rtl/unix/unix.pp
View File

@ -126,9 +126,9 @@ procedure GetTime(var hour,min,sec,sec100:word);
procedure GetTime(var hour,min,sec:word);
Procedure GetDate(Var Year,Month,Day:Word);
Procedure GetDateTime(Var Year,Month,Day,hour,minute,second:Word);
function SetTime(Hour,Min,Sec:word) : Boolean;
function SetDate(Year,Month,Day:Word) : Boolean;
function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
function SetTime(Hour,Min,Sec:word) : Boolean;
function SetDate(Year,Month,Day:Word) : Boolean;
function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
{**************************
Process Handling
@ -136,25 +136,22 @@ function SetDateTime(Year,Month,Day,hour,minute,second:Word) : Boolean;
function CreateShellArgV(const prog:string):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: AnsiString;args:ppchar):cint;
Function Execvp(Path: Pathstr;Args:ppchar;Ep:ppchar):cint;
Function Execvp(Path: AnsiString; Args:ppchar;Ep:ppchar):cint;
Function Execl(const Todo: String):cint;
Function Execl(const Todo: Ansistring):cint;
Function Execl (const Todo: String):cint;
Function Execl (const Todo: Ansistring):cint;
Function Execle(Todo: String;Ep:ppchar):cint;
Function Execle(Todo: AnsiString;Ep:ppchar):cint;
Function Execlp(Todo: string;Ep:ppchar):cint;
Function Execlp(Todo: Ansistring;Ep:ppchar):cint;
Function Shell(const Command:String):cint;
Function Shell(const Command:AnsiString):cint;
Function Shell (const Command:String):cint;
Function Shell (const Command:AnsiString):cint;
{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 WIFSTOPPED(Status: Integer): Boolean;
@ -1713,7 +1710,10 @@ End.
{
$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
Revision 1.47 2003/11/14 17:30:14 marco