From fc6b86468b6386a7b038fddd5c1859651807563d Mon Sep 17 00:00:00 2001
From: Jeremiah Orians <jeremiah@pdp10.guru>
Date: Sat, 8 Apr 2017 22:49:04 -0400
Subject: [PATCH] Enhanced stage2 lisp High level prototype to include line
 comments and write command

---
 stage2/High_level_prototypes/lisp.c      |  2 ++
 stage2/High_level_prototypes/lisp.h      |  1 +
 stage2/High_level_prototypes/lisp_eval.c | 22 +++++++++++++++++-----
 stage2/High_level_prototypes/lisp_read.c |  9 +++++++++
 4 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/stage2/High_level_prototypes/lisp.c b/stage2/High_level_prototypes/lisp.c
index 10ac7ad..03c71b9 100644
--- a/stage2/High_level_prototypes/lisp.c
+++ b/stage2/High_level_prototypes/lisp.c
@@ -32,6 +32,7 @@ int main()
 {
 	garbage_init();
 	init_sl3();
+	output = fopen("tape_02", "w");
 	for(;;)
 	{
 		garbage_collect();
@@ -43,5 +44,6 @@ int main()
 		writeobj(stdout, temp);
 		printf("\n");
 	}
+	fclose(output);
 	return 0;
 }
diff --git a/stage2/High_level_prototypes/lisp.h b/stage2/High_level_prototypes/lisp.h
index 1dc5d59..a457c86 100644
--- a/stage2/High_level_prototypes/lisp.h
+++ b/stage2/High_level_prototypes/lisp.h
@@ -56,3 +56,4 @@ struct cell* make_cons(struct cell* a, struct cell* b);
 
 /* Global objects */
 struct cell *all_symbols, *top_env, *nil, *tee, *quote, *s_if, *s_lambda, *s_define, *s_setb, *s_cond, *s_begin;
+FILE* output;
diff --git a/stage2/High_level_prototypes/lisp_eval.c b/stage2/High_level_prototypes/lisp_eval.c
index 05eb781..ed3af6c 100644
--- a/stage2/High_level_prototypes/lisp_eval.c
+++ b/stage2/High_level_prototypes/lisp_eval.c
@@ -376,30 +376,40 @@ struct cell* prim_listp(struct cell* args)
 	return nil;
 }
 
-struct cell* prim_display(struct cell* args)
+struct cell* prim_output(struct cell* args, FILE* out)
 {
 	for(; nil != args; args = args->cdr)
 	{
 		if(INT == args->car->type)
 		{
-			printf("%d", args->car->value);
+			fprintf(out, "%d", args->car->value);
 		}
 		else if(ASCII == args->car->type)
 		{
-			printf("%c", args->car->value);
+			fprintf(out, "%c", args->car->value);
 		}
 		else if(CONS == args->car->type)
 		{
-			prim_display(args->car);
+			prim_output(args->car, out);
 		}
 		else
 		{
-			printf("%s", args->car->string);
+			fprintf(out, "%s", args->car->string);
 		}
 	}
 	return tee;
 }
 
+struct cell* prim_display(struct cell* args)
+{
+	return prim_output(args, stdout);
+}
+
+struct cell* prim_write(struct cell* args)
+{
+	return prim_output(args, output);
+}
+
 int64_t cells_remaining();
 struct cell* prim_freecell(struct cell* args)
 {
@@ -425,6 +435,7 @@ struct cell* prim_ascii(struct cell* args)
 
 struct cell* prim_halt(struct cell* args)
 {
+	fclose(output);
 	exit(EXIT_SUCCESS);
 }
 
@@ -485,6 +496,7 @@ void init_sl3()
 	spinup(make_sym("<="), make_prim(prim_numle));
 	spinup(make_sym("<"), make_prim(prim_numlt));
 	spinup(make_sym("display"), make_prim(prim_display));
+	spinup(make_sym("write"), make_prim(prim_write));
 	spinup(make_sym("free_mem"), make_prim(prim_freecell));
 	spinup(make_sym("ascii!"), make_prim(prim_ascii));
 	spinup(make_sym("list?"), make_prim(prim_listp));
diff --git a/stage2/High_level_prototypes/lisp_read.c b/stage2/High_level_prototypes/lisp_read.c
index 109862d..1297723 100644
--- a/stage2/High_level_prototypes/lisp_read.c
+++ b/stage2/High_level_prototypes/lisp_read.c
@@ -231,6 +231,15 @@ uint32_t Readline(FILE* source_file, char* temp)
 		{
 			exit(EXIT_SUCCESS);
 		}
+		else if(59 == c)
+		{
+			/* drop everything until we hit newline */
+			while(10 != c)
+			{
+				c = fgetc(source_file);
+			}
+			goto Line_complete;
+		}
 		else if((0 == depth) && ((10 == c) || (13 == c) || (32 == c) || (9 == c)))
 		{
 			goto Line_complete;