Merged revisions 1718,1722,1727 via svnmerge from

http://[email protected]/svn/fpc/trunk

........
r1718 | tom_at_work | 2005-11-10 18:06:25 +0100 (Thu, 10 Nov 2005) | 2 lines

* stack related things (sizes, calculations, etc.) are now 64 bit on 64 bit platforms
* default stack size is now also 32k for Windows (allows the use of stack checking when using threads)
........
r1722 | tom_at_work | 2005-11-11 13:16:08 +0100 (Fri, 11 Nov 2005) | 1 line

* added CheckInitialStkLen() function which checks whether the given stack size value is valid on the OS when creating a thread, fixing stack checking
........
r1727 | tom_at_work | 2005-11-12 12:34:15 +0100 (Sat, 12 Nov 2005) | 2 lines

* forgot to add CheckInitialStkLen function
* fixed two unitinitialized StackLength variables
........

git-svn-id: branches/fixes_2_0@1748 -

compiler/pmodules.pas

@@ -405,11 +405,15 @@ implementation
     procedure insertmemorysizes;
       begin
         { stacksize can be specified and is now simulated }
-        dataSegment.concat(Tai_align.Create(const_align(4)));
-        dataSegment.concat(Tai_symbol.Createname_global('__stklen',AT_DATA,4));
-        dataSegment.concat(Tai_const.Create_32bit(stacksize));
-        dataSegment.concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,4));
-        dataSegment.concat(Tai_const.Create_32bit(heapsize));
+        maybe_new_object_file(datasegment);
+        new_section(datasegment,sec_data,'__stklen', sizeof(aint));
+        datasegment.concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
+        datasegment.concat(Tai_const.Create_aint(stacksize));
+        { Initial heapsize }
+        maybe_new_object_file(datasegment);
+        new_section(datasegment,sec_data,'__heapsize',sizeof(aint));
+        datasegment.concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(aint)));
+        datasegment.concat(Tai_const.Create_aint(heapsize));
       end;
 
 

rtl/beos/system.pp

@@ -519,6 +519,11 @@ begin
   OpenStdIO(StdErr,fmOutput,StdErrorHandle);
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
 begin
 { Setup heap }
   zero:=0;

rtl/bsd/system.pp

@@ -242,11 +242,15 @@ begin
  GetProcessID := SizeUInt (fpGetPID);
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
 
 Begin
   IsConsole := TRUE;
   IsLibrary := FALSE;
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
   { Set up signals handlers }
   InstallSignals;

rtl/darwin/tthread.inc

@@ -181,7 +181,7 @@ end;
 
 { TThread }
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!

rtl/freebsd/tthread.inc

@@ -186,7 +186,7 @@ end;
 
 { TThread }
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!

rtl/go32v2/system.pp

@@ -610,10 +610,15 @@ begin
  GetProcessID := SizeUInt (Go32_info_block.pid);
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
 var
   temp_int : tseginfo;
 Begin
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := __stkbottom;
   { To be set if this is a GUI or console application }
   IsConsole := TRUE;

rtl/go32v2/tthread.inc

@@ -46,7 +46,7 @@ begin
 end;
 
 
-constructor TThread.Create(CreateSuspended: Boolean; const StackSize: DWord = DefaultStackSize);
+constructor TThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize);
 
 begin
  {IsMultiThread := TRUE; }

rtl/inc/system.inc

@@ -43,9 +43,19 @@ const
 { Used by the ansistrings and maybe also other things in the future }
 var
   emptychar : char;public name 'FPC_EMPTYCHAR';
-  initialstklen : longint;external name '__stklen';
-
-
+  initialstklen : SizeUint;external name '__stklen';
+
+{ checks whether the given suggested size for the stack of the current
+ thread is acceptable. If this is the case, returns it unaltered. 
+ Otherwise it should return an acceptable value.
+ 
+ Operating systems that automatically expand their stack on demand, should 
+ simply return a very large value.
+ Operating systems which do not have a possibility to retrieve stack size
+ information, should simply return the given stklen value (This is the default 
+ implementation).
+}
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt; forward;
 
 {****************************************************************************
                     Include processor specific routines
@@ -538,7 +548,7 @@ end;
 {$DEFINE STACKCHECK}
 {$ENDIF}
 {$S-}
-procedure fpc_stackcheck(stack_size:Cardinal);[public,alias:'FPC_STACKCHECK'];
+procedure fpc_stackcheck(stack_size:SizeUInt);[public,alias:'FPC_STACKCHECK'];
 var
   c : Pointer;
 begin

rtl/inc/systemh.inc

@@ -350,7 +350,7 @@ ThreadVar
   InOutRes    : Word;
   { Stack checking }
   StackBottom : Pointer;
-  StackLength : Cardinal;
+  StackLength : SizeUInt;
 
 
 { Numbers for routines that have compiler magic }

rtl/inc/thread.inc

@@ -21,7 +21,7 @@ Var
                            Threadvar initialization
 *****************************************************************************}
 
-    procedure InitThread(stklen:cardinal);
+    procedure InitThread(stklen:SizeUInt);
       begin
         SysResetFPU;
         { ExceptAddrStack and ExceptObjectStack are threadvars       }
@@ -32,7 +32,7 @@ Var
         InOutRes:=0;
         // ErrNo:=0;
         { Stack checking }
-        StackLength:=stklen;
+        StackLength:= CheckInitialStkLen(stkLen);
         StackBottom:=Sptr - StackLength;
         ThreadID := CurrentTM.GetCurrentThreadID();
       end;
@@ -63,9 +63,9 @@ Var
       end;
 
     function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
-                     var ThreadId : TThreadID; const SS: DWord) : TThreadID;
+                     var ThreadId : TThreadID; const stacksize: SizeUInt) : TThreadID;
       begin
-        BeginThread:=BeginThread(nil,SS,ThreadFunction,p,0,ThreadId);
+        BeginThread:=BeginThread(nil,stacksize,ThreadFunction,p,0,ThreadId);
       end;
 
     procedure EndThread;
@@ -73,13 +73,7 @@ Var
         EndThread(0);
       end;
 
-function BeginThread(sa : Pointer;stacksize : dword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;  var ThreadId : TThreadID) : TThreadID;
-
-begin
-  Result:=CurrentTM.BeginThread(sa,stacksize,threadfunction,P,creationflags,ThreadID);
-end;
-
-function BeginThread(sa : Pointer;stacksize : qword; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;  var ThreadId : TThreadID) : TThreadID;
+function BeginThread(sa : Pointer;stacksize : SizeUInt; ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;  var ThreadId : TThreadID) : TThreadID;
 
 begin
   Result:=CurrentTM.BeginThread(sa,stacksize,threadfunction,P,creationflags,ThreadID);

rtl/inc/threadh.inc

@@ -15,13 +15,8 @@
  **********************************************************************}
 
 const
-{$ifdef mswindows}
-  { on windows, use stack size of starting process }
-  DefaultStackSize = 0;
-{$else mswindows}
   { including 16384 margin for stackchecking }
   DefaultStackSize = 32768;
-{$endif mswindows}
 
 type
   PEventState = pointer;
@@ -102,13 +97,13 @@ Procedure SetNoThreadManager;
 {$endif DISABLE_NO_THREAD_MANAGER}
 // Needs to be exported, so the manager can call it.
 procedure InitThreadVars(RelocProc : Pointer);
-procedure InitThread(stklen:cardinal);
+procedure InitThread(stklen:SizeUInt);
 
 {*****************************************************************************
                          Multithread Handling
 *****************************************************************************}
 
-function BeginThread(sa : Pointer;stacksize : dword;
+function BeginThread(sa : Pointer;stacksize : SizeUInt;
   ThreadFunction : tthreadfunc;p : pointer;creationFlags : dword;
   var ThreadId : TThreadID) : TThreadID;
 
@@ -118,7 +113,7 @@ function BeginThread(ThreadFunction : tthreadfunc) : TThreadID;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : TThreadID;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : TThreadID) : TThreadID;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
-                     var ThreadId : TThreadID; const SS: DWord) : TThreadID;
+                     var ThreadId : TThreadID; const stacksize: SizeUInt) : TThreadID;
 
 procedure EndThread(ExitCode : DWord);
 procedure EndThread;

rtl/linux/osdefs.inc

@@ -30,4 +30,6 @@
   {$define usegetcwd}
 {$endif}
 
-
+{$if defined(cpupowerpc) or defined(cpupowerpc64) or defined(cpux86)}
+  {$DEFINE has_ugetrlimit}
+{$endif}

rtl/linux/ossysc.inc

@@ -458,7 +458,6 @@ begin
   FPsigprocmask:=do_syscall(syscall_nr_rt_sigprocmask,TSysParam(how),TSysParam(nset),TSysParam(oset),TSysParam(8));
 end;
 
-
 Function FpNanoSleep(req : ptimespec;rem : ptimespec):cint; [public, alias : 'FPC_SYSC_NANOSLEEP'];
 begin
   FpNanoSleep:=Do_SysCall(syscall_nr_nanosleep,TSysParam(req),TSysParam(rem));
@@ -473,3 +472,18 @@ begin
  fpgettimeofday:=do_syscall(syscall_nr_gettimeofday,TSysParam(tp),TSysParam(tzp));
 end;
 
+
+function FpGetRLimit(resource : cInt; rlim : PRLimit) : cInt;
+begin
+  FpGetRLimit := do_syscall(syscall_nr_getrlimit, 
+    TSysParam(resource), TSysParam(@rlim));
+end;
+
+{$ifdef HAS_UGETRLIMIT}
+function fpugetrlimit(resource : cInt; rlim : PRLimit) : cInt;
+begin
+  FpUGetRLimit := do_syscall(syscall_nr_ugetrlimit,
+    syscall_nr_getrlimit, 
+    TSysParam(resource), TSysParam(@rlim));
+end;
+{$endif}

rtl/linux/ostypes.inc

@@ -303,6 +303,28 @@ CONST
   F_SetOwn = 8;
   F_GetOwn = 9;
 
+{ getrlimit/ugetrlimit resource parameter constants }
+const
+  RLIMIT_CPU = 0;       { CPU time in ms  }
+  RLIMIT_FSIZE = 1;     { Maximum filesize  }
+  RLIMIT_DATA = 2;      { max data size  }
+  RLIMIT_STACK = 3;     { max stack size  }
+  RLIMIT_CORE = 4;      { max core file size  }
+  RLIMIT_RSS = 5;       { max resident set size  }
+  RLIMIT_NPROC = 6;     { max number of processes  }
+  RLIMIT_NOFILE = 7;    { max number of open files  }
+  RLIMIT_MEMLOCK = 8;   { max locked-in-memory address space  }
+  RLIMIT_AS = 9;        { address space limit(?)  }
+  RLIMIT_LOCKS = 10;    { maximum file locks held  }
+
+type
+  rlim_t = cULong;
+  PRLimit = ^TRLimit;
+  TRLimit = record
+    rlim_cur : rlim_t;
+    rlim_max : rlim_t;
+  end;
+
     {*************************************************************************}
     {                               SIGNALS                                   }
     {*************************************************************************}

rtl/linux/system.pp

@@ -231,12 +231,29 @@ begin
  GetProcessID := SizeUInt (fpGetPID);
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+var
+  limits : TRLimit;
+  success : boolean;
+begin
+  success := false;
+  fillchar(limits, sizeof(limits), 0);
+  {$ifdef has_ugetrlimit}
+  success := fpugetrlimit(RLIMIT_STACK, @limits)=0;
+  {$endif}
+  if (not success) then
+    success := fpgetrlimit(RLIMIT_STACK, @limits)=0;
+  if (success) and (limits.rlim_cur < stklen) then
+    result := limits.rlim_cur
+  else
+    result := stklen;
+end;
 
 Begin
   SysResetFPU;
   IsConsole := TRUE;
   IsLibrary := FALSE;
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(initialStkLen);
   StackBottom := Sptr - StackLength;
   { Set up signals handlers }
   InstallSignals;

rtl/linux/tthread.inc

@@ -186,7 +186,7 @@ end;
 
 { TThread }
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!

rtl/macos/system.pp

@@ -476,6 +476,11 @@ begin
 {$WARNING To be implemented - using GetProcessInformation???}
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
 var
   resHdl: Mac_Handle;
   isFolder, hadAlias, leafIsAlias: Boolean;
@@ -509,7 +514,7 @@ begin
   { To be set if this is a library and not a program  }
   IsLibrary := FALSE;
 
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := SPtr - StackLength;
   pathTranslation:= false;
 

rtl/morphos/system.pp

@@ -309,12 +309,17 @@ begin
  GetProcessID:=SizeUInt(FindTask(NIL));
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
 
 begin
   SysResetFPU;
   IsConsole := TRUE;
   IsLibrary := FALSE;
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
 { OS specific startup }
   MOS_ambMsg:=nil;

rtl/morphos/tthread.inc

@@ -112,7 +112,7 @@ begin
 end;
 
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 var
   Flags: cardinal;
 begin

rtl/netbsd/tthread.inc

@@ -177,7 +177,7 @@ end;
 
 { TThread }
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!

rtl/netware/system.pp

@@ -435,11 +435,16 @@ begin
 end;
 
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
 
 Begin
+  StackLength := CheckInitialStkLen(initialstklen);
   StackBottom := SPtr - StackLength;
   SigTermHandlerActive := false;
   NetwareCheckFunction := nil;

rtl/netware/systhrd.inc

@@ -151,7 +151,7 @@ function ThreadMain(param : pointer) : dword; cdecl;
      DoneThread;
   end;
 
-function SysBeginThread(sa : Pointer;stacksize : dword;
+function SysBeginThread(sa : Pointer;stacksize : SizeUInt;
                          ThreadFunction : tthreadfunc;p : pointer;
                          creationFlags : dword; var ThreadId : DWord) : DWord;
 

rtl/netware/tthread.inc

@@ -150,7 +150,7 @@ end;
 
 
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 var
   Flags: Integer;
 begin

rtl/netwlibc/system.pp

@@ -509,13 +509,17 @@ begin
 end;
 
 
-
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
 {*****************************************************************************
                          SystemUnit Initialization
 *****************************************************************************}
 
 Begin
   getCodeAddresses;
+  StackLength := CheckInitialStkLen(initialStkLen);
   StackBottom := SPtr - StackLength;
   SigTermHandlerActive := false;
   NetwareCheckFunction := nil;

rtl/netwlibc/systhrd.inc

@@ -126,7 +126,7 @@
       end;
 
 
-    function SysBeginThread(sa : Pointer;stacksize : dword;
+    function SysBeginThread(sa : Pointer;stacksize : SizeUInt;
                          ThreadFunction : tthreadfunc;p : pointer;
                          creationFlags : dword; var ThreadId : THandle) : DWord;
       var

rtl/netwlibc/tthread.inc

@@ -252,7 +252,7 @@ end;
 
 { TThread }
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!

rtl/openbsd/tthread.inc

@@ -186,7 +186,7 @@ begin
 end;
 
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean; const StackSize: DWord = DefaultStackSize);
+constructor TThread.Create(CreateSuspended: Boolean; const StackSize: SizeUInt = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!

rtl/os2/systhrd.inc

@@ -184,7 +184,7 @@ end;
       end;
 
 
-    function SysBeginThread(sa : Pointer;stacksize : dword;
+    function SysBeginThread(sa : Pointer;stacksize : SizeUInt;
                          ThreadFunction : tthreadfunc;p : pointer;
                          creationFlags : dword; var ThreadId : TThreadID) : DWord;
       var

rtl/os2/tthread.inc

@@ -174,7 +174,7 @@ begin
 end;
 
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 var
   Flags: cardinal;
 begin

rtl/palmos/system.pp

@@ -104,6 +104,11 @@ begin
  GetProcessID := 1;
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
+
 begin
    ExitCode:=0;
 end.

rtl/solaris/system.pp

@@ -206,11 +206,15 @@ begin
  GetProcessID := SizeUInt (fpGetPID);
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
 
 Begin
   IsConsole := TRUE;
   IsLibrary := FALSE;
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
 { Set up signals handlers }
   InstallSignals;

rtl/unix/oscdeclh.inc

@@ -86,6 +86,10 @@ Type TGrpArr = Array [0..0] of TGid;            { C style array workarounds}
     Function  fpReadLink           (name,linkname:pchar;maxlen:size_t):cint;  cdecl; external clib name 'readlink';
     Function  FpUmask       (cmask : TMode): TMode; cdecl; external clib name 'umask';
     function  fpsettimeofday(tp:ptimeval;tzp:ptimezone):cint; cdecl; external clib name 'settimeofday';
+    function FpGetRLimit(resource : cInt; rlim : PRLimit) : cInt; cdecl; external clib name 'getrlimit';
+    {$ifdef HAS_UGETRLIMIT}
+    function FpGetRLimit(resource : cInt; rlim : PRLimit) : cInt; cdecl; external clib name 'ugetrlimit';
+    {$endif}
 
 {$ifdef linux}
 {$ifndef FPC_IS_SYSTEM}

rtl/watcom/system.pp

@@ -1489,6 +1489,10 @@ begin
  GetProcessID := 1;
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
 
 var
   temp_int : tseginfo;

rtl/win32/system.pp

@@ -1118,13 +1118,17 @@ begin
  GetProcessID := ProcessID;
 end;
 
+function CheckInitialStkLen(stklen : SizeUInt) : SizeUInt;
+begin
+  result := stklen;
+end;
 
 const
    Exe_entry_code : pointer = @Exe_entry;
    Dll_entry_code : pointer = @Dll_entry;
 
 begin
-  StackLength := InitialStkLen;
+  StackLength := CheckInitialStkLen(InitialStkLen);
   StackBottom := Sptr - StackLength;
   { get some helpful informations }
   GetStartupInfo(@startupinfo);

rtl/win32/tthread.inc

@@ -115,7 +115,7 @@ begin
 end;
 
 constructor TThread.Create(CreateSuspended: Boolean;
-                           const StackSize: DWord = DefaultStackSize);
+                           const StackSize: SizeUInt = DefaultStackSize);
 var
   Flags: Integer;
 begin