+ generic stack checking

rtl/go32v2/system.pp

@@ -805,44 +805,6 @@ end;
 var
   __stkbottom : longint;external name '__stkbottom';
 
-procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
-{
-  called when trying to get local stack if the compiler directive $S
-  is set this function must preserve esi !!!! because esi is set by
-  the calling proc for methods it must preserve all registers !!
-
-  With a 2048 byte safe area used to write to StdIo without crossing
-  the stack boundary
-}
-begin
-  asm
-        pushl   %eax
-        pushl   %ebx
-        movl    stack_size,%ebx
-        addl    $2048,%ebx
-        movl    %esp,%eax
-        subl    %ebx,%eax
-{$ifdef SYSTEMDEBUG}
-        movl    loweststack,%ebx
-        cmpl    %eax,%ebx
-        jb      .L_is_not_lowest
-        movl    %eax,loweststack
-.L_is_not_lowest:
-{$endif SYSTEMDEBUG}
-        movl    __stkbottom,%ebx
-        cmpl    %eax,%ebx
-        jae     .L__short_on_stack
-        popl    %ebx
-        popl    %eax
-        leave
-        ret     $4
-.L__short_on_stack:
-        { can be usefull for error recovery !! }
-        popl    %ebx
-        popl    %eax
-  end['EAX','EBX'];
-  HandleError(202);
-end;
 
 
 {*****************************************************************************
@@ -1520,6 +1482,7 @@ end;
 var
   temp_int : tseginfo;
 Begin
+  StackBottom := __stkbottom; 
 { save old int 0 and 75 }
   get_pm_interrupt($00,old_int00);
   get_pm_interrupt($75,old_int75);
@@ -1530,8 +1493,6 @@ Begin
   temp_int.offset:=@new_int75;
   set_pm_interrupt($75,temp_int);
 {$endif EXCEPTIONS_IN_SYSTEM}
-{ to test stack depth }
-  loweststack:=maxlongint;
 { Setup heap }
   InitHeap;
 {$ifdef MT}
@@ -1564,7 +1525,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.15  2002-03-11 19:10:33  peter
+  Revision 1.16  2002-04-12 17:34:05  carl
+  + generic stack checking
+
+  Revision 1.15  2002/03/11 19:10:33  peter
     * Regenerated with updated fpcmake
 
   Revision 1.14  2001/10/28 17:43:51  peter

rtl/inc/system.inc

@@ -47,6 +47,7 @@ const
 { Used by the ansistrings and maybe also other things in the future }
 var
   emptychar : char;public name 'FPC_EMPTYCHAR';
+  stacklength : longint;external name '__stklen';
 
 
 {****************************************************************************
@@ -305,6 +306,9 @@ begin
     Seed3 := (internRandom(65000) * internRandom(65000)) mod 765241;
 end;
 
+
+
+
 {****************************************************************************
                             Memory Management
 ****************************************************************************}
@@ -405,6 +409,26 @@ begin
   fillchar(x,count,byte(value));
 end;
 
+{*****************************************************************************
+                         Stack check code
+*****************************************************************************}
+{$IFOPT S+}
+{$DEFINE STACKCHECK}
+{$ENDIF}
+{$S-}
+procedure fpc_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
+var
+ c: cardinal;
+begin
+ c := cardinal(Sptr) - cardinal(stack_size) - STACK_MARGIN;
+ if (c <= cardinal(StackBottom)) then
+     HandleError(202);
+end;
+{$IFDEF STACKCHECK}
+{$S+}
+{$ENDIF}
+{$UNDEF STACKCHECK}
+
 
 {*****************************************************************************
                         Initialization / Finalization
@@ -687,7 +711,10 @@ end;
 
 {
   $Log$
-  Revision 1.24  2001-12-13 20:23:19  michael
+  Revision 1.25  2002-04-12 17:37:36  carl
+  + generic stack checking
+
+  Revision 1.24  2001/12/13 20:23:19  michael
   + Added double2real function from main branch
 
   Revision 1.23  2001/11/19 02:40:24  carl

rtl/netware/system.pp

@@ -154,22 +154,7 @@ begin
   end;
 end;
 
-{*****************************************************************************
-                         Stack check code
-*****************************************************************************}
-procedure int_stackcheck(stack_size:longint);[public,alias:'FPC_STACKCHECK'];
-{
-  called when trying to get local stack if the compiler directive $S
-  is set this function must preserve esi !!!! because esi is set by
-  the calling proc for methods it must preserve all registers !!
-
-  With a 2048 byte safe area used to write to StdIo without crossing
-  the stack boundary
-}
-begin
-  IF _stackavail > stack_size + 2048 THEN EXIT;
-  HandleError (202);
-end;
+
 
 {*****************************************************************************
                               ParamStr/Randomize
@@ -238,8 +223,8 @@ begin
       if HeapSbrkBlockList = nil then
       begin
         _free (P);
-	Sbrk := -1;
-	exit;
+    Sbrk := -1;
+    exit;
       end;
       fillchar (HeapSbrkBlockList^,sizeof(HeapSbrkBlockList^),0);
       HeapSbrkAllocated := HeapInitialMaxBlocks;
@@ -250,8 +235,8 @@ begin
       if p2 = nil then
       begin
         _free (P);
-	Sbrk := -1;
-	exit;
+    Sbrk := -1;
+    exit;
       end;
       inc (HeapSbrkAllocated, HeapInitialMaxBlocks);
     end;
@@ -400,9 +385,9 @@ begin
   do_filepos := res;
 end;
 
-CONST SEEK_SET = 0;	// Seek from beginning of file.
-      SEEK_CUR = 1;	// Seek from current position.
-      SEEK_END = 2;	// Seek from end of file.
+CONST SEEK_SET = 0; // Seek from beginning of file.
+      SEEK_CUR = 1; // Seek from current position.
+      SEEK_END = 2; // Seek from end of file.
 
 
 procedure do_seek(handle,pos : longint);
@@ -740,7 +725,7 @@ end;
                          SystemUnit Initialization
 *****************************************************************************}
 
-Begin
+Begin
   StackBottom := SPtr - StackLength;
 {$ifdef MT}
   { the exceptions use threadvars so do this _before_ initexceptions }
   AllocateThreadVars;
@@ -782,7 +767,10 @@ Begin
 End.
 {
   $Log$
-  Revision 1.10  2002-04-01 15:20:08  armin
+  Revision 1.11  2002-04-12 17:40:11  carl
+  + generic stack checking
+
+  Revision 1.10  2002/04/01 15:20:08  armin
   + unload module no longer shows: Module did not release...
   + check-function will no longer be removed when smartlink is on
 

rtl/os2/system.pas

@@ -213,60 +213,6 @@ procedure emx_init; external 'EMX' index 1;
      { all other cases ... we keep the same error code }
    end;
 
-{***************************************************************************
-
-                Runtime error checking related routines.
-
-***************************************************************************}
-
-{$S-}
-procedure st1(stack_size : longint); [public,alias : 'FPC_STACKCHECK'];
-var
- c: cardinal;
-begin
- c := cardinal(Sptr) - cardinal(stack_size) - 16384;
- if os_mode = osos2 then
-   begin
-     if (c <= cardinal(StackBottom)) then
-        HandleError(202);
-   end
- else
-   begin
-     if (c <= cardinal(heap_brk)) then
-        HandleError(202);
-   end;
-end;
-(*
-procedure st1(stack_size:longint); assembler; [public,alias: 'FPC_STACKCHECK'];
-{ called when trying to get local stack }
-{ if the compiler directive $S is set   }
-
-asm
-    movl stack_size,%ebx
-    movl %esp,%eax
-    subl %ebx,%eax
-{$ifdef SYSTEMDEBUG}
-    movl loweststack,%ebx
-    cmpl %eax,%ebx
-    jb   .Lis_not_lowest
-    movl %eax,loweststack
-.Lis_not_lowest:
-{$endif SYSTEMDEBUG}
-    cmpb osOS2,os_mode
-    jne .Lrunning_in_dos
-    movl stackbottom,%ebx
-    jmp .Lrunning_in_os2
-.Lrunning_in_dos:
-    movl heap_brk,%ebx
-.Lrunning_in_os2:
-    cmpl %eax,%ebx
-    jae  .Lshort_on_stack
-.Lshort_on_stack:
-    pushl $202
-    call HandleError
-end ['EAX','EBX'];
-{no stack check in system }
-*)
 
 {****************************************************************************
 
@@ -1032,7 +978,7 @@ begin
     {At 0.9.2, case for enumeration does not work.}
     case os_mode of
         osDOS:
-            stackbottom:=0;     {In DOS mode, heap_brk is also the
+            stackbottom:=cardinal(heap_brk);     {In DOS mode, heap_brk is also the
                                  stack bottom.}
         osOS2:
             begin
@@ -1062,8 +1008,6 @@ begin
     { ... and exceptions }
     InitExceptions;
 
-    { to test stack depth }
-    loweststack:=maxlongint;
 
     OpenStdIO(Input,fmInput,StdInputHandle);
     OpenStdIO(Output,fmOutput,StdOutputHandle);
@@ -1075,7 +1019,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-03-11 19:10:33  peter
+  Revision 1.20  2002-04-12 17:42:16  carl
+  + generic stack checking
+
+  Revision 1.19  2002/03/11 19:10:33  peter
     * Regenerated with updated fpcmake
 
   Revision 1.18  2002/02/10 13:46:20  hajny

rtl/unix/sysunix.inc

@@ -746,6 +746,7 @@ end;
 
 
 Begin
+  StackBottom := Sptr - StackLength;
 { Set up signals handlers }
    InstallSignals;
 { Setup heap }
@@ -764,7 +765,10 @@ End.
 
 {
   $Log$
-  Revision 1.19  2002-03-11 19:10:33  peter
+  Revision 1.20  2002-04-12 17:43:28  carl
+  + generic stack checking
+
+  Revision 1.19  2002/03/11 19:10:33  peter
     * Regenerated with updated fpcmake
 
   Revision 1.18  2001/10/14 13:33:21  peter

rtl/win32/system.pp

@@ -952,25 +952,6 @@ begin
   ExitProcess(ExitCode);
 end;
 
-{$ifdef dummy}
-Function SetUpStack : longint;
-{ This routine does the following :                            }
-{  returns the value of the initial SP - __stklen              }
-begin
-  asm
-    pushl %ebx
-    pushl %eax
-    movl  __stklen,%ebx
-    movl  %esp,%eax
-    subl  %ebx,%eax
-    movl  %eax,__RESULT
-    popl  %eax
-    popl  %ebx
-  end;
-end;
-{$endif}
-
-
 var
   { value of the stack segment
     to check if the call stack can be written on exceptions }
@@ -1531,6 +1512,7 @@ const
    Dll_entry_code : pointer = @Dll_entry;
 
 begin
+  StackBottom := Sptr - StackLength;
   { get some helpful informations }
   GetStartupInfo(@startupinfo);
   { some misc Win32 stuff }
@@ -1539,8 +1521,6 @@ begin
     HInstance:=getmodulehandle(GetCommandFile);
   MainInstance:=HInstance;
   cmdshow:=startupinfo.wshowwindow;
-  { to test stack depth }
-  loweststack:=maxlongint;
   { real test stack depth        }
   {   stacklimit := setupstack;  }
 {$ifdef MT}
@@ -1585,7 +1565,10 @@ end.
 
 {
   $Log$
-  Revision 1.25  2002-03-11 19:10:33  peter
+  Revision 1.26  2002-04-12 17:45:13  carl
+  + generic stack checking
+
+  Revision 1.25  2002/03/11 19:10:33  peter
     * Regenerated with updated fpcmake
 
   Revision 1.24  2002/01/30 14:57:11  pierre