diff --git a/rtl/freebsd/sysconst.inc b/rtl/freebsd/sysconst.inc index 086cc72417..5acb3e1217 100644 --- a/rtl/freebsd/sysconst.inc +++ b/rtl/freebsd/sysconst.inc @@ -42,8 +42,8 @@ Const { The waitpid uses the following options:} Wait_NoHang = 1; Wait_UnTraced = 2; - Wait_Any = -1; - Wait_MyPGRP = 0; + Wait_Any = -1; + Wait_MyPGRP = 0; { Constants to check stat.mode - checked all STAT constants with BSD} STAT_IFMT = $f000; {00170000 } STAT_IFSOCK = $c000; {0140000 } @@ -55,12 +55,12 @@ Const STAT_IFIFO = $1000; {0010000 } STAT_ISUID = $0800; {0004000 } STAT_ISGID = $0400; {0002000 } - STAT_ISVTX = $0200; {0001000} + STAT_ISVTX = $0200; {0001000} { Constants to check permissions all } - STAT_IRWXO = $7; - STAT_IROTH = $4; - STAT_IWOTH = $2; - STAT_IXOTH = $1; + STAT_IRWXO = $7; + STAT_IROTH = $4; + STAT_IWOTH = $2; + STAT_IXOTH = $1; STAT_IRWXG = STAT_IRWXO shl 3; STAT_IRGRP = STAT_IROTH shl 3; @@ -92,10 +92,23 @@ 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.4 2001-06-19 08:34:16 marco + Revision 1.5 2001-10-14 13:33:20 peter + * start of thread support for linux + + Revision 1.4 2001/06/19 08:34:16 marco * Peter didn't merge the FreeBSD directory when he merged the Unix one. Fixed Revision 1.3 2001/01/23 20:37:14 marco diff --git a/rtl/linux/syscalls.inc b/rtl/linux/syscalls.inc index 39c8db51b2..76b2bd956d 100644 --- a/rtl/linux/syscalls.inc +++ b/rtl/linux/syscalls.inc @@ -445,6 +445,95 @@ begin Sys_mmap:=syscall(syscall_nr_mmap,t); end; +Function Sys_munmap(adr,len:longint):longint; // moved from sysunix.inc, used in sbrk +var + t : syscallregs; +begin + t.reg2:=adr; + t.reg3:=len; + Sys_munmap:=syscall(syscall_nr_munmap,t); +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 i386} + 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 i386} +{$ifdef m68k} + { 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 m68k} +end; + + + { Interface to Unix ioctl call. Performs various operations on the filedescriptor Handle. @@ -465,7 +554,10 @@ end; { $Log$ - Revision 1.4 2001-06-02 00:31:30 peter + Revision 1.5 2001-10-14 13:33:20 peter + * start of thread support for linux + + Revision 1.4 2001/06/02 00:31:30 peter * merge unix updates from the 1.0 branch, mostly related to the solaris target diff --git a/rtl/linux/sysconst.inc b/rtl/linux/sysconst.inc index 824bdf617e..6cafc26fbd 100644 --- a/rtl/linux/sysconst.inc +++ b/rtl/linux/sysconst.inc @@ -32,9 +32,9 @@ Const Open_NDelay = Open_NonBlock; Open_Sync = 1 shl 12; Open_Direct = 4 shl 12; - Open_LargeFile = 1 shl 15; - Open_Directory = 2 shl 15; - Open_NoFollow = 4 shl 15; + Open_LargeFile = 1 shl 15; + Open_Directory = 2 shl 15; + Open_NoFollow = 4 shl 15; { The waitpid uses the following options:} Wait_NoHang = 1; Wait_UnTraced = 2; @@ -88,10 +88,25 @@ 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.4 2001-06-02 00:31:30 peter + Revision 1.5 2001-10-14 13:33:20 peter + * start of thread support for linux + + Revision 1.4 2001/06/02 00:31:30 peter * merge unix updates from the 1.0 branch, mostly related to the solaris target diff --git a/rtl/linux/thread.inc b/rtl/linux/thread.inc new file mode 100644 index 0000000000..18d1c56722 --- /dev/null +++ b/rtl/linux/thread.inc @@ -0,0 +1,189 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 2001 by the Free Pascal development team. + + Multithreading implementation for Linux + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + 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. + + **********************************************************************} +{$ifdef MT} + + const + DefaultStackSize = 16384; + threadvarblocksize : dword = 0; + + type + pthreadinfo = ^tthreadinfo; + tthreadinfo = record + f : tthreadfunc; + p : pointer; + end; + + var + dataindex : pointer; + + procedure init_threadvar(var offset : dword;size : dword);[public,alias: 'FPC_INIT_THREADVAR']; + begin + offset:=threadvarblocksize; + inc(threadvarblocksize,size); + end; + + + function relocate_threadvar(offset : dword) : pointer;[public,alias: 'FPC_RELOCATE_THREADVAR']; + begin + Relocate_ThreadVar := DataIndex + Offset; + end; + + + procedure AllocateThreadVars; + begin + { we've to allocate the memory from system } + { because the FPC heap management uses } + { exceptions which use threadvars but } + { these aren't allocated yet ... } + { allocate room on the heap for the thread vars } + DataIndex:=Pointer(Sys_mmap(0,threadvarblocksize,3,MAP_PRIVATE+MAP_ANONYMOUS,-1,0)); + FillChar(DataIndex^,threadvarblocksize,0); + end; + + + procedure ReleaseThreadVars; + begin + Sys_munmap(Longint(dataindex),threadvarblocksize); + end; + + + procedure InitThread; + begin + ResetFPU; + { we don't need to set the data to 0 because we did this with } + { the fillchar above, but it looks nicer } + + { ExceptAddrStack and ExceptObjectStack are threadvars } + { so every thread has its on exception handling capabilities } + InitExceptions; + InOutRes:=0; + // ErrNo:=0; + end; + + + procedure DoneThread; + begin + { release thread vars } + ReleaseThreadVars; + end; + + + function ThreadMain(param : pointer) : longint;cdecl; + var + ti : tthreadinfo; + begin +{$ifdef DEBUG_MT} + writeln('New thread started, initialising ...'); +{$endif DEBUG_MT} + AllocateThreadVars; + InitThread; + ti:=pthreadinfo(param)^; + dispose(pthreadinfo(param)); +{$ifdef DEBUG_MT} + writeln('Jumping to thread function'); +{$endif DEBUG_MT} + ThreadMain:=ti.f(ti.p); + end; + + + function BeginThread(sa : Pointer;stacksize : dword; + ThreadFunction : tthreadfunc;p : pointer; + creationFlags : dword; var ThreadId : DWord) : DWord; + var + ti : pthreadinfo; + FStackPointer : pointer; + Flags : longint; + begin +{$ifdef DEBUG_MT} + writeln('Creating new thread'); +{$endif DEBUG_MT} + IsMultithread:=true; + { the only way to pass data to the newly created thread } + { in a MT safe way, is to use the heap } + new(ti); + ti^.f:=ThreadFunction; + ti^.p:=p; +{$ifdef DEBUG_MT} + writeln('Starting new thread'); +{$endif DEBUG_MT} + Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD; + { Setup stack } + Getmem(pointer(FStackPointer),StackSize); + inc(FStackPointer,StackSize); + { Clone } + ThreadID:=Clone(@ThreadMain,pointer(FStackPointer),Flags,ti); + end; + + + function BeginThread(ThreadFunction : tthreadfunc) : DWord; + var + dummy : dword; + begin + BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,nil,0,dummy); + end; + + + function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : DWord; + var + dummy : dword; + begin + BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,dummy); + end; + + + function BeginThread(ThreadFunction : tthreadfunc;p : pointer;var ThreadId : DWord) : DWord; + begin + BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,ThreadId); + end; + + + procedure EndThread(ExitCode : DWord); + begin + DoneThread; + Sys_Exit(ExitCode); + end; + + + procedure EndThread; + begin + EndThread(0); + end; + + procedure InitCriticalSection(var cs : tcriticalsection); + begin + end; + + procedure DoneCriticalSection(var cs : tcriticalsection); + begin + end; + + + procedure EnterCriticalSection(var cs : tcriticalsection); + begin + end; + + procedure LeaveCriticalSection(var cs : tcriticalsection); + begin + end; + +{$endif MT} + +{ + $Log$ + Revision 1.1 2001-10-14 13:33:20 peter + * start of thread support for linux + +} diff --git a/rtl/linux/unixsysc.inc b/rtl/linux/unixsysc.inc index 48e4873f4d..0f1ac0d8df 100644 --- a/rtl/linux/unixsysc.inc +++ b/rtl/linux/unixsysc.inc @@ -29,87 +29,6 @@ begin End; -function clone(func:TCloneFunc;sp:pointer;flags:longint;args:pointer):longint; -begin - if (pointer(func)=nil) or (sp=nil) then - begin - LinuxError:=Sys_EInval; - exit(-1); // give an error result - end; -{$ifdef i386} - 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 i386} -{$ifdef m68k} - { 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 m68k} -end; - - Procedure Execve(path:pathstr;args:ppchar;ep:ppchar); { Replaces the current program by the program specified in path, @@ -966,7 +885,10 @@ end; { $Log$ - Revision 1.4 2001-07-15 11:57:16 peter + Revision 1.5 2001-10-14 13:33:20 peter + * start of thread support for linux + + Revision 1.4 2001/07/15 11:57:16 peter * merged m68k updates Revision 1.3 2001/06/03 20:19:09 peter diff --git a/rtl/unix/linux.pp b/rtl/unix/linux.pp index 9e7b6138b2..029ffbf52f 100644 --- a/rtl/unix/linux.pp +++ b/rtl/unix/linux.pp @@ -33,17 +33,6 @@ var {******************** Process ********************} -const - {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; const { For getting/setting priority } @@ -392,7 +381,7 @@ Function NanoSleep(const req : timespec;var rem : timespec) : longint; Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean; Function TCGetAttr(fd:longint;var tios:TermIOS):boolean; -Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean; +Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean; Procedure CFSetISpeed(var tios:TermIOS;speed:Longint); Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint); Procedure CFMakeRaw(var tios:TermIOS); @@ -1935,7 +1924,7 @@ end; -Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean; +Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean; var nr:longint; begin @@ -2957,7 +2946,10 @@ End. { $Log$ - Revision 1.16 2001-09-17 21:36:31 peter + Revision 1.17 2001-10-14 13:33:20 peter + * start of thread support for linux + + Revision 1.16 2001/09/17 21:36:31 peter * merged fixes Revision 1.15 2001/08/12 18:08:59 peter diff --git a/rtl/unix/sysunix.inc b/rtl/unix/sysunix.inc index f140984e90..ccb9d323a8 100644 --- a/rtl/unix/sysunix.inc +++ b/rtl/unix/sysunix.inc @@ -43,6 +43,31 @@ var Misc. System Dependent Functions *****************************************************************************} +{$ifdef I386} +{ this should be defined in i386 directory !! PM } +const + fpucw : word = $1332; + FPU_Invalid = 1; + FPU_Denormal = 2; + FPU_DivisionByZero = 4; + FPU_Overflow = 8; + FPU_Underflow = $10; + FPU_StackUnderflow = $20; + FPU_StackOverflow = $40; + +{$endif I386} + +Procedure ResetFPU; +begin +{$ifdef I386} + asm + fninit + fldcw fpucw + end; +{$endif I386} +end; + + procedure prthaltproc;external name '_haltproc'; Procedure System_exit; @@ -514,37 +539,19 @@ begin dir:=thedir end; +{$ifdef linux} +{***************************************************************************** + Thread Handling +*****************************************************************************} + +{ include threading stuff, this is os independend part } +{$I thread.inc} +{$endif linux} {***************************************************************************** SystemUnit Initialization *****************************************************************************} - -{$ifdef I386} -{ this should be defined in i386 directory !! PM } -const - fpucw : word = $1332; - FPU_Invalid = 1; - FPU_Denormal = 2; - FPU_DivisionByZero = 4; - FPU_Overflow = 8; - FPU_Underflow = $10; - FPU_StackUnderflow = $20; - FPU_StackOverflow = $40; - -{$endif I386} - -Procedure ResetFPU; -begin -{$ifdef I386} - asm - fninit - fldcw fpucw - end; -{$endif I386} -end; - - {$ifdef BSD} procedure SignalToRunerror(Sig: longint; SigContext: SigContextRec;someptr:pointer); cdecl; {$else} @@ -724,7 +731,10 @@ End. { $Log$ - Revision 1.17 2001-09-30 21:10:20 peter + Revision 1.18 2001-10-14 13:33:21 peter + * start of thread support for linux + + Revision 1.17 2001/09/30 21:10:20 peter * erase(directory) returns now 2 to be tp compatible Revision 1.16 2001/08/05 12:24:20 peter diff --git a/rtl/unix/sysunixh.inc b/rtl/unix/sysunixh.inc index 8fedc339c2..1f371d17fa 100644 --- a/rtl/unix/sysunixh.inc +++ b/rtl/unix/sysunixh.inc @@ -18,6 +18,25 @@ {$define newsignal} {$I systemh.inc} + +{$ifdef linux} +type + { the fields of this record are os dependent } + { and they shouldn't be used in a program } + { only the type TCriticalSection is important } + TCriticalSection = packed record + DebugInfo : pointer; + LockCount : longint; + RecursionCount : longint; + OwningThread : DWord; + LockSemaphore : DWord; + Reserved : DWord; + end; + +{ include threading stuff } +{$i threadh.inc} +{$endif linux} + {$I heaph.inc} {$ifdef m68k} @@ -54,7 +73,10 @@ var { $Log$ - Revision 1.10 2001-06-27 21:37:39 peter + Revision 1.11 2001-10-14 13:33:21 peter + * start of thread support for linux + + Revision 1.10 2001/06/27 21:37:39 peter * v10 merges Revision 1.9 2001/06/18 14:26:16 jonas diff --git a/rtl/unix/unix.pp b/rtl/unix/unix.pp index 3b83f7fa81..3e7f3740c3 100644 --- a/rtl/unix/unix.pp +++ b/rtl/unix/unix.pp @@ -33,18 +33,6 @@ var {******************** Process ********************} -const - {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; - const { For getting/setting priority } Prio_Process = 0; @@ -379,7 +367,7 @@ Function NanoSleep(const req : timespec;var rem : timespec) : longint; Function IOCtl(Handle,Ndx: Longint;Data: Pointer):boolean; Function TCGetAttr(fd:longint;var tios:TermIOS):boolean; -Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean; +Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean; Procedure CFSetISpeed(var tios:TermIOS;speed:Longint); Procedure CFSetOSpeed(var tios:TermIOS;speed:Longint); Procedure CFMakeRaw(var tios:TermIOS); @@ -1916,7 +1904,7 @@ end; -Function TCSetAttr(fd:longint;OptAct:longint;var tios:TermIOS):boolean; +Function TCSetAttr(fd:longint;OptAct:longint;const tios:TermIOS):boolean; var nr:longint; begin @@ -2934,7 +2922,10 @@ End. { $Log$ - Revision 1.16 2001-09-17 21:36:31 peter + Revision 1.17 2001-10-14 13:33:21 peter + * start of thread support for linux + + Revision 1.16 2001/09/17 21:36:31 peter * merged fixes Revision 1.15 2001/08/12 18:05:19 peter