From ba384bfa0fffb4967063f217e4f56a1cd6c8abad Mon Sep 17 00:00:00 2001
From: Virgil Dupras <hsoft@hardcoded.net>
Date: Sat, 4 Apr 2020 10:27:21 -0400
Subject: [PATCH] Add stripfc tool

---
 emul/Makefile    |  6 +++++-
 tools/.gitignore |  1 +
 tools/Makefile   |  4 +++-
 tools/stripfc.c  | 55 ++++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 64 insertions(+), 2 deletions(-)
 create mode 100644 tools/stripfc.c

diff --git a/emul/Makefile b/emul/Makefile
index 0479fa6..44bb5b6 100644
--- a/emul/Makefile
+++ b/emul/Makefile
@@ -4,10 +4,12 @@ FORTHSRCS = core.fs print.fs str.fs parse.fs readln.fs fmt.fs z80a.fs
 FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
 OBJS = emul.o libz80/libz80.o
 SLATEST = ../tools/slatest
+STRIPFC = ../tools/stripfc
 
 .PHONY: all
 all: $(TARGETS)
 
+$(STRIPFC):
 $(SLATEST):
 	$(MAKE) -C ../tools
 
@@ -27,8 +29,10 @@ forth/stage1: forth/stage.c $(OBJS) forth/forth0-bin.h
 forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h 
 	$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
 
+# We don't really need to use stripfc, but we do it anyway to test that we
+# don't mistakenly break our code with that tool. It's easier to debug here.
 forth/core.bin: $(FORTHSRC_PATHS) forth/stage1
-	cat $(FORTHSRC_PATHS) ./forth/stop.fs | ./forth/stage1 | tee $@ > /dev/null
+	cat $(FORTHSRC_PATHS) ./forth/stop.fs | $(STRIPFC) | ./forth/stage1 | tee $@ > /dev/null
 
 forth/forth1.bin: forth/core.bin $(SLATEST)
 	cat forth/boot.bin forth/z80c.bin forth/core.bin > $@
diff --git a/tools/.gitignore b/tools/.gitignore
index 93cef83..2de759b 100644
--- a/tools/.gitignore
+++ b/tools/.gitignore
@@ -5,3 +5,4 @@
 /ttysafe
 /pingpong
 /slatest
+/stripfc
diff --git a/tools/Makefile b/tools/Makefile
index ddf0e01..d23016c 100644
--- a/tools/Makefile
+++ b/tools/Makefile
@@ -5,8 +5,9 @@ FONTCOMPILE_TGT = fontcompile
 TTYSAFE_TGT = ttysafe
 PINGPONG_TGT = pingpong
 SLATEST_TGT = slatest
+STRIPFC_TGT = stripfc
 TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
-	$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT)
+	$(TTYSAFE_TGT) $(PINGPONG_TGT) $(SLATEST_TGT) $(STRIPFC_TGT)
 OBJS = common.o
 
 all: $(TARGETS)
@@ -22,6 +23,7 @@ $(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
 $(TTYSAFE_TGT): $(TTYSAFE_TGT).c
 $(PINGPONG_TGT): $(PINGPONG_TGT).c
 $(SLATEST_TGT): $(SLATEST_TGT).c
+$(STRIPFC_TGT): $(STRIPFC_TGT).c
 $(TARGETS): $(OBJS)
 	$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
 
diff --git a/tools/stripfc.c b/tools/stripfc.c
new file mode 100644
index 0000000..d179617
--- /dev/null
+++ b/tools/stripfc.c
@@ -0,0 +1,55 @@
+#include <stdio.h>
+
+/* read stdin and strip Forth-style comments before spitting in stdout. This
+also deduplicate spaces and newlines.
+
+THIS PARSING IS IMPERFECT. Only a Forth interpreter can reliably detect
+comments. For example, a naive parser misinterprets the "(" word definition as
+a comment.
+
+We work around this by considering as a comment opener only "(" chars preceeded
+by more than once space or by a newline. Hackish, but works.
+*/
+
+int main()
+{
+    int spccnt = 0;
+    int incomment = 0;
+    int c;
+    c = getchar();
+    while ( c != EOF ) {
+        if (c == '\n') {
+            // We still spit newlines whenever we see them, Forth interpreter
+            // doesn't like when they're not there...
+            putchar(c);
+            spccnt += 2;
+        } else if (c == ' ') {
+            spccnt++;
+        } else {
+            if (incomment) {
+                if ((c == ')') && spccnt) {
+                    incomment = 0;
+                }
+            } else {
+                if ((c == '(') && (spccnt > 1)) {
+                    putchar(' ');
+                    spccnt = 0;
+                    int next = getchar();
+                    if (next <= ' ') {
+                        incomment = 1;
+                        continue;
+                    }
+                    putchar(c);
+                    c = next;
+                }
+                if (spccnt) {
+                    putchar(' ');
+                }
+                putchar(c);
+            }
+            spccnt = 0;
+        }
+        c = getchar();
+    }
+    return 0;
+}