apps/forth/dict.asm

@@ -243,75 +243,34 @@ DEFINE:
 	; been compiled by INTERPRET*. All those bytes will be copied as-is.
 	; All we need to do is to know how many bytes to copy. To do so, we
 	; skip compwords until EXIT is reached.
-	ex	de, hl		; DE is our dest
+	ld	(HERE), hl	; where we write compwords.
 	ld	l, (ix)
 	ld	h, (ix+1)
 .loop:
-	call	HLPointsNUMBER
-	jr	nz, .notNUMBER
-	; is number
-	ld	bc, 4
-	ldir
-	jr	.loop
-.notNUMBER:
-	call	HLPointsLIT
-	jr	nz, .notLIT
-	; is lit
-	ldi
-	ldi
-	inc	hl \ inc hl
-	call	strcpyM
-	inc	hl		; byte after word termination
-	jr	.loop
-.notLIT:
-	; it's a word
-	call	HLPointsIMMED
-	jr	nz, .notIMMED
-	; Immediate word, we'll have to call it.
-	; Before we make our call, let's save our current HL/DE position
-	ld	(HERE), de
-	ld	e, (hl)
-	inc	hl
-	ld	d, (hl)
-	inc	hl			; point to next word
-	push	de \ pop iy		; prepare for executeCodeLink
-	ld	(ix), l
-	ld	(ix+1), h
-	; Push return address
-	ld	hl, .retList
-	call	pushRS
-	; Ready!
-	jp	executeCodeLink
-.notIMMED:
-	; a good old regular word. We have 2 bytes to copy. But before we do,
-	; let's check whether it's an EXIT. LDI doesn't affect Z, so we can
-	; make our jump later.
 	call	HLPointsEXIT
-	ldi
-	ldi
-	jr	nz, .loop
+	jr	z, .loopend
+	call	compSkip
+	jr	.loop
+.loopend:
+	; At this point, HL points to EXIT compword. We'll copy it too.
+	; We'll use LDIR. BC will be RSTOP-OLDRSTOP+2
+	ld	e, (ix)
+	ld	d, (ix+1)
+	inc	hl \ inc hl	; our +2
+	or	a		; clear carry
+	sbc	hl, de
+	ld	b, h
+	ld	c, l
+	; BC has proper count
+	ex	de, hl		; HL is our source (old RS' TOS)
+	ld	de, (HERE)	; and DE is our dest
+	ldir			; go!
 	; HL has our new RS' TOS
 	ld	(ix), l
 	ld	(ix+1), h
 	ld	(HERE), de	; update HERE
 	jp	exit
 
-; This label is pushed to RS when an IMMED word is called. When that word calls
-; exit, this is where it returns. When we return, RS will need to be popped so
-; that we stay on the proper RS level.
-.retList:
-	.dw	.retWord
-.retWord:
-	.dw	.retEntry
-.retEntry:
-	call	popRS		; unwind stack
-	; recall old HL / DE values
-	ld	l, (ix)
-	ld	h, (ix+1)
-	ld	de, (HERE)
-	; continue!
-	jr	.loop
-
 	.db "DOES>"
 	.fill 3
 	.dw DEFINE
@@ -334,43 +293,10 @@ DOES:
 	ld	(HERE), iy
 	jp	exit
 
-
-	.db "IMMEDIA"
-	.db 0
-	.dw DOES
-IMMEDIATE:
-	.dw nativeWord
-	ld	hl, (CURRENT)
-	dec	hl
-	dec	hl
-	dec	hl
-	inc	(hl)
-	jp	exit
-
-; ( n -- )
-	.db "LITERAL"
-	.db 1		; IMMEDIATE
-	.dw IMMEDIATE
-LITERAL:
-	.dw nativeWord
-	ld	hl, (HERE)
-	ld	de, NUMBER
-	ld	(hl), e
-	inc	hl
-	ld	(hl), d
-	inc	hl
-	pop	de		; number from stack
-	ld	(hl), e
-	inc	hl
-	ld	(hl), d
-	inc	hl
-	ld	(HERE), hl
-	jp	exit
-
 ; ( -- c )
 	.db "KEY"
 	.fill 5
-	.dw LITERAL
+	.dw DOES
 KEY:
 	.dw nativeWord
 	call	stdioGetC

apps/forth/dictionary.txt

@@ -25,49 +25,39 @@ Atom: A word of the type compiledWord contains, in its PF, a list of what we
 call "atoms". Those atoms are most of the time word references, but they can
 also be references to NUMBER and LIT.
 
-*** Defining words ***
+*** Native Words ***
+
 : x ...     --              Define a new word
 ;           R:I --          Exit a colon definition
-ALLOT       n --            Move HERE by n bytes
-CREATE x    --              Create cell named x. Doesn't allocate a PF.
-CONSTANT x  n --            Creates cell x that when called pushes its value
-DOES>       --              See description at top of file
-IMMEDIATE   --              Flag the latest defined word as immediate.
-LITERAL     n --            Inserts number from TOS as a literal
-VARIABLE c  --              Creates cell x with 2 bytes allocation.
-
-*** Flow ***
-ELSE        --              Branch to THEN
-EXECUTE     a --            Execute wordref at addr a
-IF          n --            Branch to ELSE or THEN if n is zero
-INTERPRET   --              Get a line from stdin, compile it in tmp memory,
-                            then execute the compiled contents.
-QUIT        R:drop --       Return to interpreter promp immediately
-THEN        --              Does nothing. Serves as a branching merker for IF
-                            and ELSE.
-
-*** Stack ***
-DUP         a -- a a
-OVER        a b -- a b a
-SWAP        a b -- b a
-
-*** Memory ***
+.           n --            Print n in its decimal form
 @           a -- n          Set n to value at address a
 !           n a --          Store n in address a
-?           a --            Print value of addr a
-+!          n a --          Increase value of addr a by n
-CURRENT     -- n            Set n to wordref of last added entry.
-HERE        -- a            Push HERE's address
-
-*** Arithmetic ***
-
 +           a b -- c        a + b -> c
 -           a b -- c        a - b -> c
 *           a b -- c        a * b -> c
 /           a b -- c        a / b -> c
-
-*** I/O ***
-.           n --            Print n in its decimal form
+CREATE x    --              Create cell named x. Doesn't allocate a PF.
+CURRENT     -- n            Set n to wordref of last added entry.
+DOES>       --              See description at top of file
+DUP         a -- a a
+ELSE        --              Branch to THEN
 EMIT        c --            Spit char c to stdout
+EXECUTE     a --            Execute wordref at addr a
+HERE        -- a            Push HERE's address
+IF          n --            Branch to ELSE or THEN if n is zero
+QUIT        R:drop --       Return to interpreter promp immediately
 KEY         -- c            Get char c from stdin
+INTERPRET   --              Get a line from stdin, compile it in tmp memory,
+                            then execute the compiled contents.
+OVER        a b -- a b a
+SWAP        a b -- b a
+THEN        --              Does nothing. Serves as a branching merker for IF
+                            and ELSE.
 
+*** Core-but-Forth Words ***
+
+?           a --            Print value of addr a
++!          n a --          Increase value of addr a by n
+ALLOT       n --            Move HERE by n bytes
+CONSTANT x  n --            Creates cell x that when called pushes its value
+VARIABLE c  --              Creates cell x with 2 bytes allocation.

apps/forth/util.asm

@@ -274,20 +274,3 @@ entryhead:
 	ld	(HERE), hl
 	xor	a		; set Z
 	ret
-
-; Sets Z if wordref at (HL) is of the IMMEDIATE type
-HLPointsIMMED:
-	push	hl
-	call	intoHL
-	dec	hl
-	dec	hl
-	dec	hl
-	; We need an invert flag. We want to Z to be set when flag is non-zero.
-	ld	a, 1
-	and	(hl)
-	dec	a	; if A was 1, Z is set. Otherwise, Z is unset
-	inc	hl
-	inc	hl
-	inc	hl
-	pop	hl
-	ret

emul/.gitignore

@@ -1,5 +1,5 @@
 /shell/shell
-/forth/forth
+/bshell/shell
 /zasm/zasm
 /zasm/avra
 /runbin/runbin
@@ -7,4 +7,6 @@
 /*/*.bin
 /cfsin/zasm
 /cfsin/ed
+/cfsin/basic
+/cfsin/forth
 /cfsin/user.h

emul/Makefile

@@ -1,10 +1,10 @@
 CFSPACK_OBJ = ../tools/cfspack/libcfs.o
-TARGETS = shell/shell zasm/zasm runbin/runbin forth/forth
+TARGETS = shell/shell zasm/zasm runbin/runbin
 KERNEL = ../kernel
 APPS = ../apps
 ZASMBIN = zasm/zasm
 AVRABIN = zasm/avra
-SHELLAPPS = zasm ed
+SHELLAPPS = zasm ed forth
 SHELLTGTS = ${SHELLAPPS:%=cfsin/%}
 CFSIN_CONTENTS = $(SHELLTGTS) cfsin/user.h
 OBJS = emul.o libz80/libz80.o
@@ -24,15 +24,6 @@ shell/shell-bin.h: shell/shell.bin
 shell/shell: shell/shell.c $(SHELLOBJS) shell/shell-bin.h 
 	$(CC) shell/shell.c $(SHELLOBJS) -o $@
 
-forth/forth.bin: forth/glue.asm $(ZASMBIN)
-	$(ZASMBIN) $(KERNEL) $(APPS) < forth/glue.asm | tee $@ > /dev/null
-
-forth/forth-bin.h: forth/forth.bin
-	./bin2c.sh KERNEL < forth/forth.bin | tee $@ > /dev/null
-
-forth/forth: forth/forth.c $(OBJS) forth/forth-bin.h 
-	$(CC) forth/forth.c $(OBJS) -o $@
-
 zasm/kernel-bin.h: zasm/kernel.bin
 	./bin2c.sh KERNEL < zasm/kernel.bin | tee $@ > /dev/null
 

emul/forth/forth.c

@@ -1,68 +0,0 @@
-#include <stdint.h>
-#include <stdio.h>
-#include <unistd.h>
-#include <termios.h>
-#include "../emul.h"
-#include "forth-bin.h"
-
-// in sync with glue.asm
-#define RAMSTART 0x2000
-#define STDIO_PORT 0x00
-
-static int running;
-
-static uint8_t iord_stdio()
-{
-    int c = getchar();
-    if (c == EOF) {
-        running = 0;
-    }
-    return (uint8_t)c;
-}
-
-static void iowr_stdio(uint8_t val)
-{
-    if (val == 0x04) { // CTRL+D
-        running = 0;
-    } else {
-        putchar(val);
-    }
-}
-
-int main(int argc, char *argv[])
-{
-    bool tty = isatty(fileno(stdin));
-    struct termios termInfo;
-    if (tty) {
-        // Turn echo off: the shell takes care of its own echoing.
-        if (tcgetattr(0, &termInfo) == -1) {
-            printf("Can't setup terminal.\n");
-            return 1;
-        }
-        termInfo.c_lflag &= ~ECHO;
-        termInfo.c_lflag &= ~ICANON;
-        tcsetattr(0, TCSAFLUSH, &termInfo);
-    }
-
-    Machine *m = emul_init();
-    m->ramstart = RAMSTART;
-    m->iord[STDIO_PORT] = iord_stdio;
-    m->iowr[STDIO_PORT] = iowr_stdio;
-    // initialize memory
-    for (int i=0; i<sizeof(KERNEL); i++) {
-        m->mem[i] = KERNEL[i];
-    }
-    // Run!
-    running = 1;
-
-    while (running && emul_step());
-
-    if (tty) {
-        printf("Done!\n");
-        termInfo.c_lflag |= ECHO;
-        termInfo.c_lflag |= ICANON;
-        tcsetattr(0, TCSAFLUSH, &termInfo);
-        emul_printdebug();
-    }
-    return 0;
-}

emul/forth/glue.asm

@@ -1,40 +0,0 @@
-.inc "ascii.h"
-.equ	RAMSTART	0x2000
-.equ	STDIO_PORT	0x00
-
-	jp	init
-
-.inc "core.asm"
-.inc "str.asm"
-
-.equ	STDIO_RAMSTART	RAMSTART
-.equ	STDIO_GETC	emulGetC
-.equ	STDIO_PUTC	emulPutC
-.inc "stdio.asm"
-
-.inc "lib/util.asm"
-.inc "lib/parse.asm"
-.inc "lib/ari.asm"
-.inc "lib/fmt.asm"
-.equ FORTH_RAMSTART STDIO_RAMEND
-.inc "forth/main.asm"
-.inc "forth/util.asm"
-.inc "forth/stack.asm"
-.inc "forth/dict.asm"
-
-init:
-	di
-	; setup stack
-	ld	sp, 0xffff
-	call	forthMain
-	halt
-
-emulGetC:
-	; Blocks until a char is returned
-	in	a, (STDIO_PORT)
-	cp	a		; ensure Z
-	ret
-
-emulPutC:
-	out	(STDIO_PORT), a
-	ret