duskos

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

Make A register words native

Diffstat:
M
asm.py
 | 
7
++++---
M
dusk.c
 | 
13
++++++++++++-
M
ops.txt
 | 
1
+
M
xcomp.txt
 | 
24
++++++++++++++----------

4 files changed, 31 insertions(+), 14 deletions(-)
diff --git a/asm.py b/asm.py
@@ -20,6 +20,8 @@ aliases = [
     ('r2p', 'r>'),
     ('rget', 'r@'),
     ('rdrop', 'r~'),
+    ('a2r', 'A>r'),
+    ('r2a', 'r>A'),
 ]
 for a, b in aliases:
     opcode = ops[a.encode()]
@@ -175,10 +177,9 @@ def _alias_():
     intwr(off)
 
 def _opwriter_():
-    name = nextt()
-    newword(name)
+    newword()
     outbuf[-1] |= 0x80 # immediate
-    opcode = ops[name]
+    opcode = ops[nextt()]
     litwr(opcode)
     callwr(words[b'c,'])
     retwr()
diff --git a/dusk.c b/dusk.c
@@ -31,6 +31,7 @@ struct stack ps, rs;
 cell pc;
 byte running;
 byte toflag;
+cell areg;
 
 /* Utilities */
 static void checka(cell *addr) {
@@ -114,11 +115,21 @@ static void mul() { 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); }
 
+/* A register */
+static void a2p() { push(areg); }
+static void p2a() { areg = pop(); }
+static void a2r() { pushRS(areg); }
+static void r2a() { areg = popRS(); }
+static void ainc() { areg++; }
+static void adec() { areg--; }
+static void acfetch() { checka(&areg); push(mem[areg]); }
+static void acstore() { checka(&areg); mem[areg] = pop(); }
+
 /* I/O */
 static void _emit() { putchar(pop()); }
 static void _key() { push(getchar()); }
 
-static void (*ops[42])() = {
+static void (*ops[50])() = {
 #include "ops.txt"
 };
 
diff --git a/ops.txt b/ops.txt
@@ -2,4 +2,5 @@ _i_, _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,
+a2p, p2a, a2r, r2a, ainc, adec, acfetch, acstore,
 _emit, _key
diff --git a/xcomp.txt b/xcomp.txt
@@ -28,6 +28,12 @@ _br_ lblmain
 : * mul ;
 : < lt ;
 : not _not ;
+: A> a2p ;
+: >A p2a ;
+: A+ ainc ;
+: A- adec ;
+: Ac@ acfetch ;
+: Ac! acstore ;
 : emit _emit ;
 : key _key ;
 
@@ -37,7 +43,6 @@ lblval: r> to? if ! else @ then ;
 lblalias: r> to? if ! else @ >r then ;
 : 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(
 ," xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx"
@@ -55,11 +60,8 @@ create 'curword ," xxxxxx"
 : tuck swap over ;
 : rot> rot rot ;
 : leave r> r~ 1 >r >r ;
-: 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+ ;
+: Ac@+ Ac@ A+ ;
+: Ac!+ Ac! A+ ;
 : c@+ dup 1+ swap c@ ;
 : c!+ tuck c! 1+ ;
 : allot here + to here ;
@@ -159,10 +161,12 @@ alias in< boot<
   word parse not if
     curword find not if (wnf) then execute stack? then ;
 : interpret begin run1 again ;
-opwriter r>
-opwriter >r
-opwriter r@
-opwriter r~
+opwriter r> r>
+opwriter >r >r
+opwriter r@ r@
+opwriter r~ r~
+opwriter A>r A>r
+opwriter r>A r>A
 : prompt lblcurrent: S" Dusk OS" stype ;
 lblmain: 0 'curword 5 + c! interpret bye
 lblhere: