Add stripfc tool
This commit is contained in:
parent
2af959a13d
commit
ba384bfa0f
@ -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
|
FORTHSRC_PATHS = ${FORTHSRCS:%=../forth/%} forth/run.fs
|
||||||
OBJS = emul.o libz80/libz80.o
|
OBJS = emul.o libz80/libz80.o
|
||||||
SLATEST = ../tools/slatest
|
SLATEST = ../tools/slatest
|
||||||
|
STRIPFC = ../tools/stripfc
|
||||||
|
|
||||||
.PHONY: all
|
.PHONY: all
|
||||||
all: $(TARGETS)
|
all: $(TARGETS)
|
||||||
|
|
||||||
|
$(STRIPFC):
|
||||||
$(SLATEST):
|
$(SLATEST):
|
||||||
$(MAKE) -C ../tools
|
$(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
|
forth/stage1dbg: forth/stage.c $(OBJS) forth/forth0-bin.h
|
||||||
$(CC) -DDEBUG forth/stage.c $(OBJS) -o $@
|
$(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
|
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)
|
forth/forth1.bin: forth/core.bin $(SLATEST)
|
||||||
cat forth/boot.bin forth/z80c.bin forth/core.bin > $@
|
cat forth/boot.bin forth/z80c.bin forth/core.bin > $@
|
||||||
|
1
tools/.gitignore
vendored
1
tools/.gitignore
vendored
@ -5,3 +5,4 @@
|
|||||||
/ttysafe
|
/ttysafe
|
||||||
/pingpong
|
/pingpong
|
||||||
/slatest
|
/slatest
|
||||||
|
/stripfc
|
||||||
|
@ -5,8 +5,9 @@ FONTCOMPILE_TGT = fontcompile
|
|||||||
TTYSAFE_TGT = ttysafe
|
TTYSAFE_TGT = ttysafe
|
||||||
PINGPONG_TGT = pingpong
|
PINGPONG_TGT = pingpong
|
||||||
SLATEST_TGT = slatest
|
SLATEST_TGT = slatest
|
||||||
|
STRIPFC_TGT = stripfc
|
||||||
TARGETS = $(MEMDUMP_TGT) $(BLKDUMP_TGT) $(UPLOAD_TGT) $(FONTCOMPILE_TGT) \
|
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
|
OBJS = common.o
|
||||||
|
|
||||||
all: $(TARGETS)
|
all: $(TARGETS)
|
||||||
@ -22,6 +23,7 @@ $(FONTCOMPILE_TGT): $(FONTCOMPILE_TGT).c
|
|||||||
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
$(TTYSAFE_TGT): $(TTYSAFE_TGT).c
|
||||||
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
$(PINGPONG_TGT): $(PINGPONG_TGT).c
|
||||||
$(SLATEST_TGT): $(SLATEST_TGT).c
|
$(SLATEST_TGT): $(SLATEST_TGT).c
|
||||||
|
$(STRIPFC_TGT): $(STRIPFC_TGT).c
|
||||||
$(TARGETS): $(OBJS)
|
$(TARGETS): $(OBJS)
|
||||||
$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
|
$(CC) $(CFLAGS) $@.c $(OBJS) -o $@
|
||||||
|
|
||||||
|
55
tools/stripfc.c
Normal file
55
tools/stripfc.c
Normal file
@ -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;
|
||||||
|
}
|
Loading…
Reference in New Issue
Block a user