shithub: sl

--- a/meson.build

+++ b/meson.build

@@ -383,9 +383,9 @@

 test('mp.lsp', flisp, args: ['mp.lsp'], workdir: tests_dir)

 test('perf.lsp', flisp, args: ['perf.lsp'], workdir: tests_dir, timeout: -1)

 test('tme.lsp', flisp, args: ['tme.lsp'], workdir: tests_dir)

-test('torture.lsp', flisp, args: ['torture.lsp'], workdir: tests_dir, timeout: -1)

+test('torture.lsp', flisp, args: ['-S', '8m', 'torture.lsp'], workdir: tests_dir, timeout: -1)

 test('torus.lsp', flisp, args: ['torus.lsp'], workdir: tests_dir)

-test('unit.lsp', flisp, args: ['unittest.lsp'], workdir: tests_dir)

+test('unit.lsp', flisp, args: ['-S', '1m', 'unittest.lsp'], workdir: tests_dir)

 bootstrap = find_program(

 	'bootstrap.sh',

--- a/src/dos/platform.h

+++ b/src/dos/platform.h

@@ -41,13 +41,6 @@

 #define PATHLISTSEPSTRING ":"

 #define ISPATHSEP(c) ((c) == '\\')

-#if !defined(INITIAL_HEAP_SIZE)

-#define INITIAL_HEAP_SIZE 4*1024*1024

-#endif

-#if !defined(ALLOC_LIMIT_TRIGGER)

-#define ALLOC_LIMIT_TRIGGER INITIAL_HEAP_SIZE

-#endif

 #define MEM_UNALIGNED_ACCESS

 #include "cc.h"

--- a/src/flisp.c

+++ b/src/flisp.c

@@ -1190,7 +1190,7 @@

 // initialization -------------------------------------------------------------

int

-fl_init(size_t initial_heapsize)

+fl_init(size_t heapsize, size_t stacksize)

 	int i;

@@ -1198,7 +1198,7 @@

 		return -1;

 	FL(scr_width) = 100;

-	FL(heapsize) = initial_heapsize;

+	FL(heapsize) = heapsize*sizeof(value_t);

 	if((FL(fromspace) = MEM_ALLOC(FL(heapsize))) == nil){

 failed:

@@ -1205,27 +1205,32 @@

 		MEM_FREE(FL(fromspace));

 		MEM_FREE(FL(tospace));

 		MEM_FREE(FL(consflags));

-		MEM_FREE(FL(stack));

 		MEM_FREE(FL(finalizers));

+		fl_segfree(FL(stack), stacksize*sizeof(value_t));

 		htable_free(&FL(printconses));

 		MEM_FREE(fl);

 		return -1;

 	if((FL(tospace) = MEM_ALLOC(FL(heapsize))) == nil)

 		goto failed;

-	if((FL(consflags) = bitvector_new(FL(heapsize)/sizeof(cons_t), 1)) == nil)

-		goto failed;

-	if((htable_new(&FL(printconses), 32)) == nil)

-		goto failed;

 	FL(curheap) = FL(fromspace);

 	FL(lim) = FL(curheap)+FL(heapsize)-sizeof(cons_t);

-	FL(nstack) = 64*1024*1024/sizeof(value_t);

-	if((FL(stack) = FL(sp) = MEM_ALLOC(FL(nstack)*sizeof(value_t))) == nil)

+	if((FL(stack) = fl_segalloc(stacksize*sizeof(value_t))) == nil)

 		goto failed;

-	FL(curr_frame) = FL(sp);

+	FL(curr_frame) = FL(sp) = FL(stack);

+	FL(nstack) = stacksize;

 	FL(maxfinalizers) = 512;

 	if((FL(finalizers) = MEM_ALLOC(FL(maxfinalizers) * sizeof(*FL(finalizers)))) == nil)

 		goto failed;

+	if((FL(consflags) = bitvector_new(FL(heapsize)/sizeof(cons_t), 1)) == nil)

+		goto failed;

+	if((htable_new(&FL(printconses), 32)) == nil)

+		goto failed;

 	comparehash_init();

 	FL_lambda = csymbol("λ");

@@ -1350,9 +1355,8 @@

 		ios_puts(ios_stderr, "fatal error during bootstrap: ");

 		fl_print(ios_stderr, FL(lasterror));

 		ios_putc(ios_stderr, '\n');

-		return 1;

+		return -1;

-	ios_close(value2c(ios_t*, FL(sp)[-1]));

 	FL(sp) = saveSP-1;

 	FL(loading) = false;

 	return 0;

--- a/src/flisp.h

+++ b/src/flisp.h

@@ -175,7 +175,7 @@

 #define POP() *(--FL(sp))

 bool isbuiltin(value_t x) fl_constfn fl_hotfn;

-int fl_init(size_t initial_heapsize);

+int fl_init(size_t heapsize, size_t stacksize);

 int fl_load_system_image(value_t ios);

 _Noreturn void fl_exit(int status);

--- a/src/flmain.c

+++ b/src/flmain.c

@@ -6,8 +6,30 @@

 #include "brieflz.h"

 #include "nan.h"

+#if !defined(ARGBEGIN)

+/* straight from 9front */

+static char *argv0 = nil;

+#define	ARGBEGIN \

+	for((argv0 ? 0 : (argv0=*argv)), argv++, argc--; argv[0] && argv[0][0]=='-' && argv[0][1]; argc--, argv++){ \

+		const char *_args, *_argt; \

+		Rune _argc; \

+		_args = &argv[0][1]; \

+		if(_args[0]=='-' && _args[1]==0){ \

+			argc--; \

+			argv++; \

+			break; \

+		}\

+		_argc = 0; \

+		while(*_args && (_args += chartorune(&_argc, _args))) \

+			switch(_argc)

+#define	ARGEND USED(_argt); USED(_argc); USED(_args);}USED(argv); USED(argc);

+#define	ARGF() (_argt=_args, _args="", (*_argt? _argt: argv[1]? (argc--, *++argv): 0))

+#define	ARGC() _argc

+#define	EARGF(x) (_argt=_args, _args="", (*_argt? _argt: argv[1]? (argc--, *++argv): (x, (char*)0)))

+#endif

 static value_t

-argv_list(int argc, char *argv[])

+argv_list(int argc, char **argv)

 	int i;

 	value_t lst = FL_nil, temp;

@@ -17,23 +39,72 @@

 		temp = cvalue_static_cstring(argv[i]);

 		lst = fl_cons(temp, lst);

+	lst = fl_cons(cvalue_static_cstring(argv0), lst);

 	fl_free_gc_handles(2);

 	return lst;

+static void

+sizesuffix(size_t *sz, char su)

+{

+	switch(tolower(su)){

+	case 'k':

+		*sz *= 1024;

+		break;

+	case 'm':

+		*sz *= 1024*1024;

+		break;

+	case 0:

+		break;

+	default:

+		ios_printf(ios_stderr, "invalid size suffix '%c'\n", su);

+		exit(1);

+	}

+}

+_Noreturn static void

+usage(void)

+{

+	ios_printf(ios_stderr, "%s: [-H heapsize] [-S stacksize] ...\n", argv0);

+	exit(0);

+}

 _Noreturn void

 flmain(const uint8_t *boot, int bootsz, int argc, char **argv)

+	size_t heapsize = HEAP_SIZE0, stacksize = STACK_SIZE0;

+	char *e;

 	nan_init();

 	randomize();

 	ios_init_stdstreams();

 	mpsetminbits(sizeof(fixnum_t)*8);

-	if(fl_init(INITIAL_HEAP_SIZE) != 0)

+	ARGBEGIN{

+	case 'H':

+		heapsize = strtoull(EARGF(usage()), &e, 0);

+		sizesuffix(&heapsize, *e);

+		break;

+	case 'S':

+		stacksize = strtoull(EARGF(usage()), &e, 0);

+		sizesuffix(&stacksize, *e);

+		break;

+	case 'h':

+		usage();

+	default:

+		break;

+	}ARGEND

+	if(fl_init(heapsize, stacksize) != 0){

+		ios_puts(ios_stderr, "init failed\n");

 		exit(1);

+	}

 	value_t f = cvalue(FL(iostreamtype), (int)sizeof(ios_t));

 	fl_gc_handle(&f);

+	value_t args = argv_list(argc, argv);

+	fl_gc_handle(&args);

 	ios_t *s = value2c(ios_t*, f);

 	uint8_t *unpacked = nil;

 	if(boot[0] == 0){

@@ -58,9 +129,9 @@

 		if(fl_load_system_image(f) == 0){

 			MEM_FREE(unpacked);

 			s = value2c(ios_t*, f);

-			fl_free_gc_handles(1);

+			fl_free_gc_handles(2);

 			ios_close(s);

-			fl_applyn(1, symbol_value(symbol("__start", false)), argv_list(argc, argv));

+			fl_applyn(1, symbol_value(symbol("__start", false)), args);

 			r = 0;

--- a/src/macos/platform.h

+++ b/src/macos/platform.h

@@ -47,12 +47,8 @@

 #error unknown byte order

 #endif

-#if !defined(INITIAL_HEAP_SIZE)

-#define INITIAL_HEAP_SIZE 128*1024

-#endif

-#if !defined(ALLOC_LIMIT_TRIGGER)

-#define ALLOC_LIMIT_TRIGGER INITIAL_HEAP_SIZE

-#endif

+#define HEAP_SIZE0 128*1024

+#define STACK_SIZE0 8*1024

 #include "cc.h"

 #include "mem.h"

--- a/src/mem.h

+++ b/src/mem.h

@@ -1,3 +1,15 @@

+#if !defined(HEAP_SIZE0)

+#define HEAP_SIZE0 4*1024*1024

+#endif

+#if !defined(STACK_SIZE0)

+#define STACK_SIZE0 64*1024

+#endif

+#if !defined(ALLOC_LIMIT_TRIGGER)

+#define ALLOC_LIMIT_TRIGGER HEAP_SIZE0

+#endif

 #if defined(USE_DLMALLOC)

 void *fl_malloc(size_t);

 void fl_free(void *);

@@ -9,6 +21,8 @@

 #define MEM_REALLOC(p, n) fl_realloc((p), (size_t)(n))

 #define MEM_FREE(x) fl_free(x)

 #define MEM_STRDUP(s) fl_strdup(s)

+#define fl_segalloc(sz) MEM_ALLOC((size_t)sz)

+#define fl_segfree(s, sz) MEM_FREE(s)

 #else

 #define MEM_CALLOC(n, sz) calloc((size_t)(n), (size_t)(sz))

 #define MEM_ALLOC(n) malloc((size_t)(n))

@@ -15,4 +29,6 @@

 #define MEM_REALLOC(p, n) realloc((p), (size_t)(n))

 #define MEM_FREE(x) free(x)

 #define MEM_STRDUP(s) strdup(s)

+void *fl_segalloc(size_t sz);

+void fl_segfree(void *s, size_t sz);

 #endif

--- a/src/plan9/platform.h

+++ b/src/plan9/platform.h

@@ -132,12 +132,5 @@

 int ftruncate(int f, off_t sz);

-#if !defined(INITIAL_HEAP_SIZE)

-#define INITIAL_HEAP_SIZE 16*1024*1024

-#endif

-#if !defined(ALLOC_LIMIT_TRIGGER)

-#define ALLOC_LIMIT_TRIGGER INITIAL_HEAP_SIZE

-#endif

 #include "cc.h"

 #include "mem.h"

--- a/src/plan9/sys.c

+++ b/src/plan9/sys.c

@@ -15,6 +15,19 @@

 	return (double)s + (double)ns/1.0e9;

+void *

+fl_segalloc(size_t sz)

+{

+	return segattach(SG_CEXEC, "memory", nil, sz);

+}

+void

+fl_segfree(void *s, size_t sz)

+{

+	USED(sz);

+	segdetach(s);

+}

/*

  * nsec() is wallclock and can be adjusted by timesync

  * so need to use cycles() instead, but fall back to

--- a/src/posix/platform.h

+++ b/src/posix/platform.h

@@ -95,13 +95,6 @@

 #define MEM_UNALIGNED_ACCESS

 #endif

-#if !defined(INITIAL_HEAP_SIZE)

-#define INITIAL_HEAP_SIZE 16*1024*1024

-#endif

-#if !defined(ALLOC_LIMIT_TRIGGER)

-#define ALLOC_LIMIT_TRIGGER INITIAL_HEAP_SIZE

-#endif

 #include "cc.h"

 #include "mem.h"

 #include "mp.h"

--- a/src/posix/sys.c

+++ b/src/posix/sys.c

@@ -1,6 +1,28 @@

 #include "flisp.h"

 #include "timefuncs.h"

+#include <sys/mman.h>

+static size_t pagesize = 4096;

+#define PAGEALIGNED(x) (((x) + pagesize-1) & ~(pagesize-1))

+void *

+fl_segalloc(size_t sz)

+{

+	sz = PAGEALIGNED(sz);

+	void *s = mmap(nil, sz, PROT_READ|PROT_WRITE, MAP_ANONYMOUS|MAP_PRIVATE, -1, 0);

+	if(s == (void*)-1)

+		s = nil;

+	return s;

+}

+void

+fl_segfree(void *s, size_t sz)

+{

+	sz = PAGEALIGNED(sz);

+	if(munmap(s, sz) != 0)

+		abort();

+}

 double

 sec_realtime(void)

@@ -81,5 +103,8 @@

 	setlocale(LC_NUMERIC, "C");

 	struct utsname u;

 	os_version = strdup(uname(&u) == 0 ? u.release : "");

+	long p = sysconf(_SC_PAGE_SIZE);

+	if(p > 0)

+		pagesize = p;

 	flmain(boot, sizeof(boot), argc, argv);

--- a/test/mkfile

+++ b/test/mkfile

@@ -14,5 +14,5 @@

 test:QV:

 	for(t in $TESTS){

 		echo $t

-		../$O.out $t

+		../$O.out -S 8m $t