[M3devel] Avoding thread-stack overflow, proof of concept of "leapfrog stacks"

[Mika Nystrom]

Notes:

1. the Modula-3 garbage collector gets confused (shoulda thought of that),
   so I have to turn it off

2. however if the GC were fixed, there's no need to "fix up" the stack
   after the return---you can just allocate the new stacks as GC-traced:
   even though the collector is compacting they are "pinned" because
   they are referenced from the thread stack!

3. alloca is built into gcc nowadays, so I had to track down an assembly
   version: I suspect that the compiler front-end could be modified to
   emit a call to alloca and thus get gcc to generate the same code, 
   obviating the need for any assembly code at all.


(* Unsafe interface ***************************************************)

INTERFACE Unsafe;
FROM Ctypes IMPORT int;

PROCEDURE DoIt();

<*EXTERNAL alloca*>
PROCEDURE alloca(size : int) : INTEGER;

END Unsafe.

(* Unsafe implementation **********************************************)

UNSAFE MODULE Unsafe;

IMPORT Thread, IO, Fmt;
IMPORT RTCollector, Random;

EXCEPTION Quit;

VAR rand := NEW(Random.Default).init();

PROCEDURE P(cl : Closure; arg : ARRAY[0..100] OF INTEGER) RAISES { Quit } = 
  CONST Fudge = 1024;
  VAR stack : REF ARRAY OF INTEGER := NIL;
  BEGIN 
    IO.Put(Fmt.F("Thread %s GetSP()=0x%s\n",
                 Fmt.Int(cl.id),
                 Fmt.Int(GetSP(), base := 16)) 
          ); 
    (*Thread.Pause(0.1d0);*)

    IF GetSP() < cl.lo + Fudge THEN
      IF cl.stacks >= rand.integer(3,10) THEN 
        IO.Put(Fmt.F("Thread %s quitting after %s stacks\n",
                     Fmt.Int(cl.id), Fmt.Int(cl.stacks)));
        RAISE Quit
      END;

      stack := NEW(REF ARRAY OF INTEGER, 8*1024);
      WITH lo = LOOPHOLE(ADR(stack[0]),INTEGER),
           hi = LOOPHOLE(ADR(stack[LAST(stack^)]),INTEGER),
           sp = GetSP() DO
        IO.Put(Fmt.F("Thread %s sp %s new stack lo %s hi %s\n",
                     Fmt.Int(cl.id), 
                     Fmt.Int(sp, base := 16),
                     Fmt.Int(lo, base := 16), 
                     Fmt.Int(hi, base:= 16)));

        (* new stack starts sp - hi away *)
        EVAL alloca(sp-hi);
        IO.Put(Fmt.F("After alloca, sp %s\n",
                     Fmt.Int(GetSP(),base := 16)));
        cl.lo := lo;
        INC(cl.stacks)
      END
    END;

    P(cl, arg) 
  END P;

TYPE 
  Closure = Thread.Closure OBJECT 
    id : CARDINAL;
    lo : INTEGER;
    stacks : CARDINAL;
  OVERRIDES 
    apply := Apply 
  END;

PROCEDURE Apply(cl : Closure) : REFANY =
  BEGIN 
    Thread.Pause(1.0d0); 

    LOOP
      TRY
        cl.lo := GetSP() - 1024*8; (* pretend we have 8k left *)
        cl.stacks := 0;
        P(cl, ARRAY [0..100] OF INTEGER { 0, .. }); 
      EXCEPT
        Quit => (* start over *)
      END
    END
  END Apply;

PROCEDURE DoIt() =
  BEGIN
    RTCollector.Disable();

    FOR i := 1 TO 2 DO
      EVAL Thread.Fork(NEW(Closure, id := i)) 
    END;
    
    LOOP Thread.Pause(1.0d0) END
  END DoIt;

PROCEDURE GetSP() : INTEGER = BEGIN RETURN alloca(1) END GetSP;

BEGIN END Unsafe.

(* Main can't be UNSAFE in Modula-3 ***********************************)

MODULE Main;
IMPORT Unsafe;

BEGIN Unsafe.DoIt() END Main.

(* alloca.s from FreeBSD (old code from BSD/386) **********************)

/*-
 * Copyright (c) 1990 The Regents of the University of California.
 * All rights reserved.
 *
 * This code is derived from software contributed to Berkeley by
 * William Jolitz.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. All advertising materials mentioning features or use of this software
 *    must display the following acknowledgement:
 *	This product includes software developed by the University of
 *	California, Berkeley and its contributors.
 * 4. Neither the name of the University nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

	.asciz "@(#)alloca.s	5.2 (Berkeley) 5/14/90"
#include <machine/asm.h>


/* like alloc, but automatic automatic free in return */

.globl alloca
        .type   alloca, @function
alloca:
	popl	%edx		/*  pop return addr */
	popl	%eax		/*  pop amount to allocate */
	movl	%esp,%ecx
	addl	$3,%eax		/*  round up to next word */
	andl	$0xfffffffc,%eax
	subl	%eax,%esp
	movl	%esp,%eax	/* base of newly allocated space */
	pushl	8(%ecx)		/* copy possible saved registers */
	pushl	4(%ecx)
	pushl	0(%ecx)
	pushl	%eax		/* dummy to pop at callsite */
	jmp	*%edx		/* "return" */