Browse Source

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

marco 22 years ago
parent
commit
7bfead6dab
4 changed files with 116 additions and 109 deletions
  1. 4 81
      rtl/linux/sysc11.inc
  2. 4 14
      rtl/linux/sysconst.inc
  3. 96 2
      rtl/unix/linuxnew.inc
  4. 12 12
      rtl/unix/unix.pp

+ 4 - 81
rtl/linux/sysc11.inc

@@ -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

+ 4 - 14
rtl/linux/sysconst.inc

@@ -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
 
 }

+ 96 - 2
rtl/unix/linuxnew.inc

@@ -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

+ 12 - 12
rtl/unix/unix.pp

@@ -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