commit bf37c78fc0233a58b7199ea0f2f8c9f01a423d02
parent 776bd6c3605cb3d645a5a1def2c597ec5baf963a
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:40 -0400
Add rdln
Diffstat:
| M | Makefile | | | 4 | ++-- |
| M | asm.py | | | 36 | +++++++++++++++++++++++++++++++----- |
| M | dusk.c | | | 37 | ++++++++++++++++++++++++++++--------- |
| M | forth.txt | | | 42 | ++++++++++++++++++++++++++++++++---------- |
| M | ops.txt | | | 4 | ++-- |
5 files changed, 95 insertions(+), 28 deletions(-)
diff --git a/Makefile b/Makefile
@@ -1,11 +1,11 @@
-TARGETS = dusk
+TARGETS = dusk forth.bin
all: $(TARGETS)
forth.bin: forth.txt asm.py
./asm.py forth.txt > $@
-dusk: dusk.c forth.bin ops.txt
+dusk: dusk.c ops.txt
$(CC) $(CFLAGS) dusk.c $(LDFLAGS) -o $@
.PHONY: clean
diff --git a/asm.py b/asm.py
@@ -15,6 +15,27 @@ labels = {} # name:pc
fwlabels = [] # (name, pc) label forward references
ps = [] # PS for immediate words
+aliases = [
+ ('_dup', 'dup'),
+ ('p2r', '>r'),
+ ('r2p', 'r>'),
+ ('exit', ';'),
+ ('cfetch', 'c@'),
+ ('cstore', 'c!'),
+ ('fetch', '@'),
+ ('store', '!'),
+ ('isto', 'to?'),
+ ('inc', '1+'),
+ ('dec', '1-'),
+ ('shl', '<<c'),
+ ('shr', '>>c'),
+ ('add', '+'),
+ ('sub', '-'),
+ ('lt', '<'),
+]
+for a, b in aliases:
+ ops[b.encode()] = ops[a.encode()]
+
def out(fmt, *args):
outbuf.extend(struct.pack(fmt, *args))
@@ -77,8 +98,10 @@ def newword():
prevword = pc()
words[name] = prevword
-def exitwr():
- opwr('exit')
+def _comment_():
+ c = fp.read(1)
+ while c and c != b')':
+ c = fp.read(1)
def _if_():
opwr('_cbr_')
@@ -120,7 +143,9 @@ def strwr():
return s
def slitwr():
- _if_()
+ opwr('_br_')
+ ps.append(pc())
+ intwr(0)
spc = pc()
s = strwr()
_then_()
@@ -136,11 +161,12 @@ def _value_():
newword()
opwr('_call_')
intwr(labels[b'lblval'])
- intwr(0)
+ n = litparse(nextt())
+ intwr(n)
special = {
b':': newword,
- b';': exitwr,
+ b'(': _comment_,
b',"': strwr,
b'S"': slitwr,
b'if': _if_,
diff --git a/dusk.c b/dusk.c
@@ -1,7 +1,9 @@
+#include <unistd.h>
#include <inttypes.h>
#include <stdio.h>
+#include <termios.h>
-#define CSIZE 4
+#define CELLSIZE 4
#define MEMSIZE 0x10000
#define STACKSIZE 0x100
@@ -43,26 +45,30 @@ static cell pop() { return stack_pop(&ps); }
static void push(cell x) { stack_push(&ps, x); }
static cell popRS() { return stack_pop(&rs); }
static void pushRS(cell x) { stack_push(&rs, x); }
-static cell pc32() { cell n = gc(pc); pc+=CSIZE; return n; }
+static cell pc32() { cell n = gc(pc); pc+=CELLSIZE; return n; }
/* Native words */
/* stack */
static void _i_() { push(pc32()); }
static void drop() { pop(); }
-static void dup() { push(peek()); }
+static void _dup() { push(peek()); }
static void swap() { cell a = pop(); cell b = pop(); push(a); push(b); }
+static void over() { cell a = pop(); cell b = peek(); push(a); push(b); }
+static void rot() {
+ cell c = pop(); cell b = pop(); cell a = pop();
+ push(b); push(c); push(a); }
static void p2r() { pushRS(pop()); }
static void r2p() { push(popRS()); }
/* flow */
static void _br_() { pc = gc(pc); }
-static void _cbr_() { if (pop()) { pc+=CSIZE; } else { _br_(); } }
+static void _cbr_() { if (pop()) { pc+=CELLSIZE; } else { _br_(); } }
static void _next_() {
cell n = popRS()-1;
if (n) { pushRS(n); _br_(); }
- else { pc+=CSIZE; }
+ else { pc+=CELLSIZE; }
}
-static void _call_() { pushRS(pc+CSIZE); _br_(); }
+static void _call_() { pushRS(pc+CELLSIZE); _br_(); }
static void exit() { pc = popRS(); }
static void bye() { running = 0; }
@@ -79,14 +85,17 @@ static void inc() { push(pop()+1); }
static void dec() { push(pop()-1); }
static void shl() { cell n = pop(); push(n<<1); push(n>>31); }
static void shr() { cell n = pop(); push(n>>1); push(n&1); }
-static void and() { cell a = pop(); cell b = pop(); push(a&b); }
-static void add() { cell a = pop(); cell b = pop(); push(a+b); }
+static void and() { cell b = pop(); cell a = pop(); push(a&b); }
+static void add() { cell b = pop(); cell a = pop(); push(a+b); }
+static void sub() { cell b = pop(); cell a = pop(); push(a-b); }
+static void lt() { cell b = pop(); cell a = pop(); push(a<b); }
+static void not() { push(pop() ? 0 : 1); }
/* I/O */
static void emit() { putchar(pop()); }
static void key() { push(getchar()); }
-static void (*ops[26])() = {
+static void (*ops[31])() = {
#include "ops.txt"
};
@@ -109,6 +118,7 @@ byte step() {
}
int main() {
+ struct termios bkptio, tio;
FILE *fp = fopen("forth.bin", "r");
if (!fp) {
fprintf(stderr, "Can't open forth bin\n");
@@ -123,6 +133,15 @@ int main() {
fclose(fp);
ps.ptr = rs.ptr = pc = toflag = 0;
running = 1;
+ if (isatty(STDIN_FILENO)) {
+ tcgetattr(STDIN_FILENO, &tio);
+ bkptio = tio;
+ tio.c_lflag &=(~ICANON & ~ECHO); /* no echo, unbuffered */
+ tcsetattr(STDIN_FILENO, TCSANOW, &tio);
+ }
while (step());
+ if (isatty(STDIN_FILENO)) {
+ tcsetattr(STDIN_FILENO, TCSANOW, &bkptio);
+ }
return 0;
}
diff --git a/forth.txt b/forth.txt
@@ -1,15 +1,37 @@
_br_ lblboot
-lblcell: r2p ;
-lblval: r2p isto if store else fetch then ;
+lblcell: r> ;
+lblval: r> to? if ! else @ then ;
+create A ," xxxx"
create in(
," xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
-value in>
-: c@+ dup inc swap cfetch ;
-: << shl drop ;
-: >> shr drop ;
+value LNSZ 64
+: in) in( 64 + ;
+value in> 0
+value SPC $20 value CR $0d value LF $0a
+: 2drop drop drop ;
+: 2dup over over ;
+: nip swap drop ;
+: tuck swap over ;
+: rot> rot rot ;
+: A> A @ ; : >A A ! ;
+: A>r r> A> >r >r ; : r>A r> r> >A >r ;
+: A+ A> 1+ >A ; : A- A> 1- >A ;
+: Ac@ A> c@ ; : Ac! A> c! ;
+: Ac@+ Ac@ A+ ; : Ac!+ Ac! A+ ;
+: c@+ dup 1+ swap c@ ;
+: c!+ tuck c! 1+ ;
+: = - not ;
+: << <<c drop ;
+: >> >>c drop ;
+: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
lblhex: ," 0123456789abcdef"
-: .h $f and _i_ lblhex add cfetch emit ;
+: .h $f and _i_ lblhex + c@ emit ;
: .x dup >> >> >> >> .h .h ;
-: stype p2r begin c@+ emit next ;
-: foo S" Dusk OS" stype ;
-: BOOT lblboot: foo 42 to in> in> .x bye
+: nl> CR emit LF emit ;
+: stype >r begin c@+ emit next ;
+: lntype ( ptr c -- ptr+1 f )
+ dup SPC < if drop dup in) over - 0 fill 1 else
+ tuck emit c!+ dup in) = then ;
+: rdln S" ok" stype nl> in( begin key lntype until drop nl> ;
+: prompt S" Dusk OS" stype ;
+: BOOT lblboot: prompt rdln in( 64 stype bye
diff --git a/ops.txt b/ops.txt
@@ -1,5 +1,5 @@
-_i_, drop, dup, swap, p2r, r2p,
+_i_, drop, _dup, swap, over, rot, p2r, r2p,
_br_, _cbr_, _next_, _call_, exit, bye,
cfetch, cstore, fetch, store, to, isto,
-inc, dec, shl, shr, and, add,
+inc, dec, shl, shr, and, add, sub, lt, not,
emit, key
