dForth

commit c9837e147e17f77130ae633e2d322888c3290272
Author: Pavel Renev <an2qzavok@gmail.com>
Date:   Sun, 17 Oct 2021 19:16:12 +0000

initial commit

Diffstat:
A
dForth.go
 | 
165
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

1 file changed, 165 insertions(+), 0 deletions(-)
diff --git a/dForth.go b/dForth.go
@@ -0,0 +1,165 @@
+package main
+
+import (
+	"fmt"
+	"strconv"
+	"encoding/binary"
+)
+
+var le = binary.LittleEndian
+
+const (
+	stpt = 0
+	rspt = 4
+	stackstart = 64
+	rstackstart = 512
+	initmemsize = 1024
+)
+
+type Word struct {
+	Name string
+	Builtin func() error
+	Code []int
+}
+
+func NewWord(name string, builtin func() error) *Word {
+	word := new(Word)
+	word.Name = name
+	word.Builtin = builtin
+	return word
+}
+
+func (word *Word) Compile(codes ...int) {
+	word.Code = append(word.Code, codes...)
+}
+
+type Forth struct {
+	Dict []*Word
+	Mem []byte
+}
+
+func NewForth() *Forth {
+	forth := new(Forth)
+	forth.Dict = make([]*Word, 0)
+	forth.Mem = make([]byte, initmemsize)
+	_ = forth.memStore(stpt, stackstart)
+	_ = forth.memStore(rspt, rstackstart)
+	return forth
+}
+
+func (forth *Forth) memFetch(pt int32) (int32, error) {
+	if (pt < 0) && (int(pt) > len(forth.Mem) - 4) {
+		return 0, fmt.Errorf("memFetch: pt out of bonds")
+	}
+	val := int32(binary.LittleEndian.Uint32(forth.Mem[pt:]))
+	return val, nil
+}
+
+func (forth *Forth) memStore(pt, val int32) error {
+	if (pt < 0) {
+		return fmt.Errorf("memStore: pt out of bonds")
+	}
+	if int(pt) > len(forth.Mem) - 4 {
+		forth.Mem = append(forth.Mem,
+		  make([]byte, int(pt) - len(forth.Mem) + 4)...)
+	}
+	binary.LittleEndian.PutUint32(forth.Mem[pt:], uint32(val))
+	return nil
+}
+
+func (forth *Forth) Push(pt, val int32) {
+	tos, err := forth.memFetch(pt)
+	if err != nil {
+		panic(err)
+	}
+	if err = forth.memStore(tos, val); err != nil {
+		panic(err)
+	}
+	if err = forth.memStore(pt, tos + 4); err != nil {
+		panic(err)
+	}
+}
+
+func (forth *Forth) Pop(pt int32) int32 {
+	tos, err := forth.memFetch(pt)
+	if err != nil {
+		panic(err)
+	}
+	tos -= 4
+	val, err := forth.memFetch(tos)
+	if err != nil {
+		panic(err)
+	}
+	if err = forth.memStore(pt, tos); err != nil {
+		panic(err)
+	}
+	return val
+}
+
+func (forth *Forth) Run() {
+	var (
+		err, nerr error
+		s string
+		i, id, num int
+		w *Word
+	)
+	for err = nil; err == nil; _, err = fmt.Scan(&s) {
+		/* We shouldn't get empty reads, but on 9front
+		 * we somehow do. (as of 18.10.2012)
+		 * Let's filter them out.
+		 */
+		if s == "" {
+			continue
+		}
+		id = -1
+		for i, w = range forth.Dict {
+			if (s == w.Name) {
+				id = i
+				break;
+			}
+		}
+		if id >= 0 {
+			if w.Builtin != nil {
+				w.Builtin()
+			}
+			// else exec code
+		} else {
+			if num, nerr = strconv.Atoi(s); nerr != nil {
+				fmt.Println("?")
+			} else {
+				forth.Push(stpt, int32(num))
+			}
+		}
+	}
+}
+
+func (forth *Forth) biDot() error {
+	val := forth.Pop(stpt)
+	fmt.Print(val)
+	return nil
+}
+
+func (forth *Forth) biFetch() error {
+	addr := forth.Pop(stpt)
+	val, err := forth.memFetch(addr)
+	if err == nil {
+		forth.Push(stpt, val)
+	}
+	return err
+}
+
+func (forth *Forth) biStore() error {
+	addr := forth.Pop(stpt)
+	val := forth.Pop(stpt)
+	err := forth.memStore(addr, val)
+	return err
+}
+
+func main() {
+	fmt.Println("Welcome to dForth")
+	forth := NewForth()
+	forth.Dict = append(forth.Dict, NewWord(".",     forth.biDot))
+	forth.Dict = append(forth.Dict, NewWord("@",     forth.biFetch))
+	forth.Dict = append(forth.Dict, NewWord("!",     forth.biStore))
+	forth.Run()
+}