seg fault with List.tabulate in 3.9.1

[Stephen Weeks]

> The  trick  we  used  in older versions of MLton was to memmap a page with no
> permissions onto the end of the region, and then to catch SIGSEGV and to look
> at  the  address we were trying to access.  If it was in the bad page then we
> knew (technically assumed) that it was the region that we had overrun.

Here's the old code.  This is allocateStack.c from MLton version 1998-8-26 (when
MLton was still called smlc).

/*
 * Allocate a region of memory with a dead zone at the high end.
 * Any attempt to touch the dead zone (read or write) will cause
 * stdout to be fflushed, a message to be printed to stderr, and
 * the process to exit with status 2.
 */
#include <unistd.h>
#include <sys/mman.h>
#include <sys/types.h>
#include <signal.h>
#include <errno.h>
#include <stdio.h>
#include <asm/sigcontext.h>
#include "allocateStack.h"


/*
 * The following definitions make C more amenable to a purist.
 */
#define	bool	char			/* boolean type */
#define	uint	unsigned int		/* short names for unsigned types */
#define	ulong	unsigned long
#define	ullong	unsigned long long	/* GCC extension */
#define	llong	long long		/* GCC extension */
#define	uchar	unsigned char
#define	ushort	unsigned short int
#define	not	!			/* logical negation operator */
#define	and	&&			/* logical conjunction */
#define	or	||			/* logical disjunction */
#define	TRUE	(0 == 0)
#define	FALSE	(not TRUE)
#define	loop	while (TRUE)		/* loop until break */
#define	EOS	'\0'			/* end-of-string char */
#ifndef	NULL
#define	NULL	0			/* invalid pointer */
#endif

#define	unless(p)	if (not (p))
#define	until(p)	while (not (p))
#define	cardof(a)	(sizeof(a) / sizeof(*(a)))
#define	endof(a)	((a) + cardof(a))
#define	bitsof(a)	(sizeof(a) * 8)


static size_t	roundpage(size_t size);
static void	catcher(int sig, struct sigcontext_struct cont),
		die(char *msg);


static ulong	deadfwa,			/* start of dead zone */
		deadlim;			/* limit of dead zone */


/*
 * ssize is the number of usable bytes in the stack.
 * dsize is the minimum size of the dead zone.
 * Note, this code assumes that the stack alignment need
 * be no more coarse than gcd(ssize, pagesize).
 */
void	*
allocateStack(uint ssize, uint dsize)
{
	size_t	ssizep,
		dsizep;
	void	*p,
		*live,
		*dead;
	struct sigaction	sact;

	ssizep = roundpage(ssize);
	dsizep = roundpage(dsize);
	p = mmap((void *)NULL, ssizep + dsizep, PROT_READ | PROT_WRITE,
		MAP_PRIVATE | MAP_ANON, -1, (off_t)0);
	if (p == (void *)-1)
		die("Can't mmap stack");
	unless (munmap(p, ssizep + dsizep) == 0)
		die("Can't munmap stack");
	live = mmap(p, ssizep, PROT_READ | PROT_WRITE,
		MAP_FIXED | MAP_PRIVATE | MAP_ANON, -1, (off_t)0);
	unless (live == p)
		die("Can't re-mmap stack");
	dead = mmap(live + ssizep, dsizep, 0,
		MAP_PRIVATE | MAP_ANON, -1, (off_t)0);
	unless (dead == live + ssizep)
		die("Can't re-mmap stack dead zone");
	deadfwa = (ulong)dead;
	deadlim = deadfwa + (ulong)dsizep;
	live = live + ssizep - ssize;
	sact.sa_handler = (void (*)(int))catcher;
	sigemptyset(&sact.sa_mask);
	sact.sa_flags = 0;
	unless (sigaction(SIGSEGV, &sact, (struct sigaction *)NULL) == 0)
		die("Can't catch SIGSEGV");
	unless (sigaction(SIGBUS, &sact, (struct sigaction *)NULL) == 0)
		die("Can't catch SIGBUS");
	return (live);
}


/*
 * Round size up to a multiple of the size of a page.
 */
static size_t
roundpage(size_t size)
{
	static size_t	psize;

	if (psize == 0)
		psize = getpagesize();
	size += psize - 1;
	size -= size % psize;
	return (size);
}


static void
catcher(int sig, struct sigcontext_struct cont)
{
	fflush(stdout);
	if (deadfwa <= cont.cr2 && cont.cr2 < deadlim)
		fprintf(stderr, "Stack overflow.\nPlease use the -s compile-time option or the SMLC_stack_size run-time option.\n");
	else
		fprintf(stderr, "smlc bug. Please send a bug report \
to sweeks@research.nj.nec.com.\n\
(http://www.neci.nj.nec.com/homepages/sweeks/smlc/bug-report-form)\n");
	exit(2);
}


static void
die(char *msg)
{
	fflush(stdout);
	perror(msg);
	exit(3);
}