commit 55ebc81881d8c59734bc00412cbbafade5ec6436
parent bf37c78fc0233a58b7199ea0f2f8c9f01a423d02
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Wed, 1 Jun 2022 13:51:40 -0400
Implement word
Diffstat:
4 files changed, 31 insertions(+), 9 deletions(-)
diff --git a/asm.py b/asm.py
@@ -17,6 +17,7 @@ ps = [] # PS for immediate words
aliases = [
('_dup', 'dup'),
+ ('cdup', '?dup'),
('p2r', '>r'),
('r2p', 'r>'),
('exit', ';'),
@@ -182,13 +183,13 @@ special = {
t = nextt()
while t:
- if t in ops:
+ if t in special:
+ special[t]()
+ elif t in ops:
opwr(t)
elif t in words:
opwr('_call_')
intwr(words[t])
- elif t in special:
- special[t]()
elif t.startswith(b'lbl'):
labelwr(t)
else:
diff --git a/dusk.c b/dusk.c
@@ -52,6 +52,7 @@ static cell pc32() { cell n = gc(pc); pc+=CELLSIZE; return n; }
static void _i_() { push(pc32()); }
static void drop() { pop(); }
static void _dup() { push(peek()); }
+static void cdup() { if (peek()) 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() {
@@ -86,6 +87,8 @@ 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 b = pop(); cell a = pop(); push(a&b); }
+static void or() { cell b = pop(); cell a = pop(); push(a|b); }
+static void xor() { 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); }
@@ -95,7 +98,7 @@ static void not() { push(pop() ? 0 : 1); }
static void emit() { putchar(pop()); }
static void key() { push(getchar()); }
-static void (*ops[31])() = {
+static void (*ops[34])() = {
#include "ops.txt"
};
diff --git a/forth.txt b/forth.txt
@@ -2,12 +2,12 @@ _br_ lblboot
lblcell: r> ;
lblval: r> to? if ! else @ then ;
create A ," xxxx"
+value SPC $20 value CR $0d value LF $0a value BS $08
create in(
," xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
value LNSZ 64
-: in) in( 64 + ;
value in> 0
-value SPC $20 value CR $0d value LF $0a
+create 'curword ," xxxxxx"
: 2drop drop drop ;
: 2dup over over ;
: nip swap drop ;
@@ -21,6 +21,8 @@ value SPC $20 value CR $0d value LF $0a
: c@+ dup 1+ swap c@ ;
: c!+ tuck c! 1+ ;
: = - not ;
+: > swap < ;
+: 0< <<c nip ; : 0>= 0< not ; : >= < not ; : <= > not ;
: << <<c drop ;
: >> >>c drop ;
: fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ;
@@ -29,9 +31,25 @@ lblhex: ," 0123456789abcdef"
: .x dup >> >> >> >> .h .h ;
: nl> CR emit LF emit ;
: stype >r begin c@+ emit next ;
+: in) in( 64 + ;
+: bs? BS over = swap $7f = or ;
+: ws? SPC <= ;
: 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> ;
+: in<? ( -- c-or-0 )
+ in> in) < if in> c@+ swap to in> else 0 then ;
+: in< ( -- c ) in<? ?dup not if
+ rdln in( to in> SPC then ;
+: in$ in) to in> 'curword 6 0 fill ;
+: toword ( -- ) begin in< ws? not until ;
+: curword ( -- sa sl ) 'curword 1+ @ 'curword c@ ;
+: _ ( f sa sl -- ) 'curword c!+ tuck ! 4 + c! ;
+: word ( -- sa sl )
+ 'curword 5 + c@ if curword else
+ toword in> 1- 0 ( sa sl ) begin 1+ in<? ws? until then
+ ( sa sl ) 2dup 0 rot> _ ;
+: word! 1 rot> _ ;
: prompt S" Dusk OS" stype ;
-: BOOT lblboot: prompt rdln in( 64 stype bye
+: BOOT lblboot: in$ prompt word stype bye
diff --git a/ops.txt b/ops.txt
@@ -1,5 +1,5 @@
-_i_, drop, _dup, swap, over, rot, p2r, r2p,
+_i_, drop, _dup, cdup, swap, over, rot, p2r, r2p,
_br_, _cbr_, _next_, _call_, exit, bye,
cfetch, cstore, fetch, store, to, isto,
-inc, dec, shl, shr, and, add, sub, lt, not,
+inc, dec, shl, shr, and, or, xor, add, sub, lt, not,
emit, key
