Merge branch 'ctx'

README.md

@@ -45,6 +45,9 @@ Some of zForth's highlights:
 - **Small footprint**: the kernel C code compiles to about 3 or 4 kB of machine
   code, depending on the architecture and chosen cell data types.
 
+-- **Support for multiple instances**: The compiler and VM state is stored in a
+  struct, allowing multiple instances of zForth to run in parallel.
+
 - **Tracing**: zForth is able to show a nice trace of what it is doing under the
   hood, see below for an example.
 

forth/core.zf

@@ -58,6 +58,8 @@
 : allot  h +!  ;
 : var : ' lit , here 5 allot here swap ! 5 allot postpone ; ;
 : const : ' lit , , postpone ; ;
+: constant >r : r> postpone literal postpone ; ;
+: variable >r here r> postpone , constant ;
 
 ( 'begin' gets the current address, a jump or conditional jump back is generated
   by 'again', 'until' )

src/atmega8/main.c

@@ -31,12 +31,14 @@ int main(void)
 	uart_init(UART_BAUD(9600));
 	stdout = stdin = &f;
 
+	zf_ctx _ctx;
+	zf_ctx *ctx = &_ctx;
 
 	/* Initialize zforth */
 
-	zf_init(1);
-	zf_bootstrap();
-	zf_eval(": . 1 sys ;");
+	zf_init(ctx, 1);
+	zf_bootstrap(ctx);
+	zf_eval(ctx, ": . 1 sys ;");
 
 
 	/* Main loop: read words and eval */
@@ -47,7 +49,7 @@ int main(void)
 		int c = getchar();
 		putchar(c);
 		if(c == 10 || c == 13 || c == 32) {
-			zf_result r = zf_eval(buf);
+			zf_result r = zf_eval(ctx, buf);
 			if(r != ZF_OK) puts("A");
 			l = 0;
 		} else if(l < sizeof(buf)-1) {
@@ -60,19 +62,19 @@ int main(void)
 }
 
 
-zf_input_state zf_host_sys(zf_syscall_id id, const char *input)
+zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *input)
 {
 	char buf[16];
 
 	switch((int)id) {
 
 		case ZF_SYSCALL_EMIT:
-			putchar((char)zf_pop());
+			putchar((char)zf_pop(ctx));
 			fflush(stdout);
 			break;
 
 		case ZF_SYSCALL_PRINT:
-			itoa(zf_pop(), buf, 10);
+			itoa(zf_pop(ctx), buf, 10);
 			puts(buf);
 			break;
 	}
@@ -81,12 +83,12 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input)
 }
 
 
-zf_cell zf_host_parse_num(const char *buf)
+zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf)
 {
 	char *end;
         zf_cell v = strtol(buf, &end, 0);
 	if(*end != '\0') {
-                zf_abort(ZF_ABORT_NOT_A_WORD);
+                zf_abort(ctx, ZF_ABORT_NOT_A_WORD);
         }
         return v;
 }

src/atmega8/zfconf.h

@@ -44,7 +44,7 @@ typedef int32_t zf_cell;
    it will cause sign fill, so we need manual specify it */
 typedef int zf_int;
 
-/* The type to use for pointers and adresses. 'unsigned int' is usually a good
+/* The type to use for pointers and addresses. 'unsigned int' is usually a good
  * choice for best performance and smallest code size */
 
 typedef unsigned int zf_addr;

src/linux/main.c

@@ -20,11 +20,11 @@
  * Evaluate buffer with code, check return value and report errors
  */
 
-zf_result do_eval(const char *src, int line, const char *buf)
+zf_result do_eval(zf_ctx *ctx, const char *src, int line, const char *buf)
 {
 	const char *msg = NULL;
 
-	zf_result rv = zf_eval(buf);
+	zf_result rv = zf_eval(ctx, buf);
 
 	switch(rv)
 	{
@@ -56,15 +56,15 @@ zf_result do_eval(const char *src, int line, const char *buf)
  * Load given forth file
  */
 
-void include(const char *fname)
+void include(zf_ctx *ctx, const char *fname)
 {
 	char buf[256];
 
 	FILE *f = fopen(fname, "rb");
 	int line = 1;
 	if(f) {
 		while(fgets(buf, sizeof(buf), f)) {
-			do_eval(fname, line++, buf);
+			do_eval(ctx, fname, line++, buf);
 		}
 		fclose(f);
 	} else {
@@ -77,10 +77,10 @@ void include(const char *fname)
  * Save dictionary
  */
 
-static void save(const char *fname)
+static void save(zf_ctx *ctx, const char *fname)
 {
 	size_t len;
-	void *p = zf_dump(&len);
+	void *p = zf_dump(ctx, &len);
 	FILE *f = fopen(fname, "wb");
 	if(f) {
 		fwrite(p, 1, len, f);
@@ -93,10 +93,10 @@ static void save(const char *fname)
  * Load dictionary
  */
 
-static void load(const char *fname)
+static void load(zf_ctx *ctx, const char *fname)
 {
 	size_t len;
-	void *p = zf_dump(&len);
+	void *p = zf_dump(ctx, &len);
 	FILE *f = fopen(fname, "rb");
 	if(f) {
 		fread(p, 1, len, f);
@@ -111,29 +111,29 @@ static void load(const char *fname)
  * Sys callback function
  */
 
-zf_input_state zf_host_sys(zf_syscall_id id, const char *input)
+zf_input_state zf_host_sys(zf_ctx *ctx, zf_syscall_id id, const char *input)
 {
 	switch((int)id) {
 
 
 		/* The core system callbacks */
 
 		case ZF_SYSCALL_EMIT:
-			putchar((char)zf_pop());
+			putchar((char)zf_pop(ctx));
 			fflush(stdout);
 			break;
 
 		case ZF_SYSCALL_PRINT:
-			printf(ZF_CELL_FMT " ", zf_pop());
+			printf(ZF_CELL_FMT " ", zf_pop(ctx));
 			break;
 
 		case ZF_SYSCALL_TELL: {
-			zf_cell len = zf_pop();
-			zf_cell addr = zf_pop();
+			zf_cell len = zf_pop(ctx);
+			zf_cell addr = zf_pop(ctx);
 			if(addr >= ZF_DICT_SIZE - len) {
-				zf_abort(ZF_ABORT_OUTSIDE_MEM);
+				zf_abort(ctx, ZF_ABORT_OUTSIDE_MEM);
 			}
-			void *buf = (uint8_t *)zf_dump(NULL) + (int)addr;
+			void *buf = (uint8_t *)zf_dump(ctx, NULL) + (int)addr;
 			(void)fwrite(buf, 1, len, stdout);
 			fflush(stdout); }
 			break;
@@ -147,18 +147,18 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input)
 			break;
 
 		case ZF_SYSCALL_USER + 1:
-			zf_push(sin(zf_pop()));
+			zf_push(ctx, sin(zf_pop(ctx)));
 			break;
 
 		case ZF_SYSCALL_USER + 2:
 			if(input == NULL) {
 				return ZF_INPUT_PASS_WORD;
 			}
-			include(input);
+			include(ctx, input);
 			break;
 
 		case ZF_SYSCALL_USER + 3:
-			save("zforth.save");
+			save(ctx, "zforth.save");
 			break;
 
 		default:
@@ -174,7 +174,7 @@ zf_input_state zf_host_sys(zf_syscall_id id, const char *input)
  * Tracing output
  */
 
-void zf_host_trace(const char *fmt, va_list va)
+void zf_host_trace(zf_ctx *ctx, const char *fmt, va_list va)
 {
 	fprintf(stderr, "\033[1;30m");
 	vfprintf(stderr, fmt, va);
@@ -186,13 +186,13 @@ void zf_host_trace(const char *fmt, va_list va)
  * Parse number
  */
 
-zf_cell zf_host_parse_num(const char *buf)
+zf_cell zf_host_parse_num(zf_ctx *ctx, const char *buf)
 {
 	zf_cell v;
 	int n = 0;
 	int r = sscanf(buf, ZF_SCAN_FMT"%n", &v, &n);
 	if(r != 1 || buf[n] != '\0') {
-		zf_abort(ZF_ABORT_NOT_A_WORD);
+		zf_abort(ctx, ZF_ABORT_NOT_A_WORD);
 	}
 	return v;
 }
@@ -247,31 +247,33 @@ int main(int argc, char **argv)
 	argc -= optind;
 	argv += optind;
 
+	zf_ctx *ctx = malloc(sizeof(zf_ctx));
+	printf("%p\n", (void *)ctx);
 
 	/* Initialize zforth */
 
-	zf_init(trace);
+	zf_init(ctx, trace);
 
 
 	/* Load dict from disk if requested, otherwise bootstrap fort
 	 * dictionary */
 
 	if(fname_load) {
-		load(fname_load);
+		load(ctx, fname_load);
 	} else {
-		zf_bootstrap();
+		zf_bootstrap(ctx);
 	}
 
 
 	/* Include files from command line */
 
 	for(i=0; i<argc; i++) {
-		include(argv[i]);
+		include(ctx, argv[i]);
 	}
 
 	if(!quiet) {
 		zf_cell here;
-		zf_uservar_get(ZF_USERVAR_HERE, &here);
+		zf_uservar_get(ctx, ZF_USERVAR_HERE, &here);
 		printf("Welcome to zForth, %d bytes used\n", (int)here);
 	}
 
@@ -289,7 +291,7 @@ int main(int argc, char **argv)
 
 		if(strlen(buf) > 0) {
 
-			do_eval("stdin", ++line, buf);
+			do_eval(ctx, "stdin", ++line, buf);
 			printf("\n");
 
 			add_history(buf);
@@ -303,7 +305,7 @@ int main(int argc, char **argv)
 	for(;;) {
 		char buf[4096];
 		if(fgets(buf, sizeof(buf), stdin)) {
-			do_eval("stdin", ++line, buf);
+			do_eval(ctx, "stdin", ++line, buf);
 			printf("\n");
 		} else {
 			break;

src/linux/zfconf.h

@@ -44,7 +44,7 @@ typedef float zf_cell;
    it will cause sign fill, so we need manual specify it */
 typedef int zf_int;
 
-/* The type to use for pointers and adresses. 'unsigned int' is usually a good
+/* The type to use for pointers and addresses. 'unsigned int' is usually a good
  * choice for best performance and smallest code size */
 
 typedef unsigned int zf_addr;