duskos

dusk os fork
git clone git://git.alexwennerberg.com/duskos
Log | Files | Refs | README | LICENSE

commit 23a89641836e49589484cb368c6cfe39e97b0df5
parent 29cc7ff8779ca2362b00877217ad2097ea811a9c
Author: Virgil Dupras <hsoft@hardcoded.net>
Date:   Wed,  1 Jun 2022 13:51:40 -0400

Implement ":" word

Diffstat:
M.gitignore | 1+
Masm.py | 27+++++++++++++++++++++------
Mdusk.c | 4+++-
Mforth.txt | 21+++++++++++++++++++++
Mops.txt | 2+-
5 files changed, 47 insertions(+), 8 deletions(-)

diff --git a/.gitignore b/.gitignore @@ -1,2 +1,3 @@ /dusk /forth.bin +/memdump diff --git a/asm.py b/asm.py @@ -16,6 +16,7 @@ fwlabels = [] # (name, pc) label forward references ps = [] # PS for immediate words aliases = [ + ('_n_', '(n)'), ('_dup', 'dup'), ('cdup', '?dup'), ('p2r', '>r'), @@ -60,6 +61,10 @@ def litwr(n): opwr('_i_') intwr(n) +def callwr(addr): + opwr('_call_') + intwr(addr) + def pc(): return len(outbuf) @@ -169,13 +174,11 @@ def slitwr(): def _create_(): newword() - opwr('_call_') - intwr(labels[b'lblcell']) + callwr(labels[b'lblcell']) def _value_(): newword() - opwr('_call_') - intwr(labels[b'lblval']) + callwr(labels[b'lblval']) n = litparse(nextt()) intwr(n) @@ -187,6 +190,17 @@ def spitnativewords(): opwr(name) opwr(';') +def _compile_(): + litwr(ops[b'_call_']) + callwr(words[b'c,']) + name = nextt() + off = words[name] + litwr(off) + callwr(words[b',']) + +def _callop_(): + intwr(ops[b'_call_']) + special = { b':': newword, b'(': _comment_, @@ -203,6 +217,8 @@ special = { b'create': _create_, b'value': _value_, b'spitnativewords': spitnativewords, + b'compile': _compile_, + b'callop': _callop_, } t = nextt() @@ -212,8 +228,7 @@ while t: elif t in ops: opwr(t) elif t in words: - opwr('_call_') - intwr(words[t]) + callwr(words[t]) elif t.startswith(b'lbl'): labelwr(t) else: diff --git a/dusk.c b/dusk.c @@ -62,6 +62,7 @@ static cell pc32() { cell n = gc(pc); pc+=CELLSIZE; return n; } /* Native words */ /* stack */ static void _i_() { push(pc32()); } +static void _n_() { pc = popRS(); _i_(); } static void drop() { pop(); } static void _dup() { push(peek()); } static void cdup() { if (peek()) push(peek()); } @@ -118,7 +119,7 @@ static void not() { push(pop() ? 0 : 1); } static void emit() { putchar(pop()); } static void key() { push(getchar()); } -static void (*ops[42])() = { +static void (*ops[43])() = { #include "ops.txt" }; @@ -189,5 +190,6 @@ int main() { tcsetattr(STDIN_FILENO, TCSANOW, &bkptio); } printdbg(); + memdump(); return 0; } diff --git a/forth.txt b/forth.txt @@ -3,6 +3,7 @@ lblcell: r> ; lblval: r> to? if ! else @ then ; spitnativewords : current _call_ lblval lblcurrent +: here _call_ lblval lblhere create A ," xxxx" value SPC $20 value CR $0d value LF $0a value BS $08 create in( @@ -26,6 +27,9 @@ create 'curword ," xxxxxx" : Ac@+ Ac@ A+ ; : Ac!+ Ac! A+ ; : c@+ dup 1+ swap c@ ; : c!+ tuck c! 1+ ; +: allot here + to here ; +: , here ! 4 allot ; +: c, here c! 1 allot ; : = - not ; : > swap < ; : 0< <<c nip ; : 0>= 0< not ; : >= < not ; : <= > not ; @@ -33,6 +37,9 @@ create 'curword ," xxxxxx" : min <> drop ; : max <> nip ; : -^ swap - ; : << <<c drop ; : >> >>c drop ; +: move ( src dst u -- ) ?dup if + >r >A begin ( src ) c@+ Ac!+ next drop then ; +: move, ( a u -- ) here over allot swap move ; : fill ( a u b -- *A* ) rot> >r >A begin dup Ac!+ next drop ; lblhex: ," 0123456789abcdef" : .h $f and _i_ lblhex + c@ emit ; @@ -83,6 +90,9 @@ lblhex: ," 0123456789abcdef" ?dup not if 2drop 1 exit then A>r >r >A ( a1 ) begin Ac@+ over c@ = not if r~ r>A drop 0 exit then 1+ next drop r>A 1 ; +: S= ( sa1 sl1 sa2 sl2 -- f ) + rot over = if ( same len, s2 s1 l ) []= + else drop 2drop 0 then ; : find ( sa sl -- w? f ) \ Guards A A>r >r >A current begin ( w R:sl ) dup 1- c@ $7f and ( wlen ) r@ = if ( w ) @@ -90,6 +100,16 @@ lblhex: ," 0123456789abcdef" []= if ( w ) r~ 1 r>A exit then then 5 - ( prev field ) @ ?dup not until r~ 0 r>A ( not found ) ; : (wnf) curword stype S" word not found" stype abort ; +: litn compile (n) , ; +: entry word tuck move, ( len ) + current , c, here to current ; +: xtcomp begin word S" ;" S= if compile exit exit then + curword parse if litn else curword find if + dup 1- c@ <<c nip ( imm? ) if execute else + _i_ callop c, , then + else (wnf) then then + again ; +: : entry xtcomp ; : stack? scnt 0< if S" stack underflow" stype abort then ; : psdump scnt not if exit then scnt >A begin dup .x spc> >r scnt not until @@ -103,3 +123,4 @@ lblhex: ," 0123456789abcdef" : interpret begin run1 again ; lblmain: in$ interpret bye : boot lblboot: lblcurrent: S" Dusk OS" stype abort +lblhere: diff --git a/ops.txt b/ops.txt @@ -1,4 +1,4 @@ -_i_, drop, _dup, cdup, swap, over, rot, p2r, r2p, rget, rdrop, scnt, rcnt, +_i_, _n_, drop, _dup, cdup, swap, over, rot, p2r, r2p, rget, rdrop, scnt, rcnt, _rs0, _ps0, _br_, _cbr_, _next_, _call_, ret, execute, bye, cfetch, cstore, fetch, store, to, isto, inc, dec, shl, shr, and, or, xor, add, sub, mul, lt, not,