From 5ee8f7e01dfbcb03c705f8bb6f252c2f1b829b46 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Thu, 26 Oct 2023 19:54:29 -0400
Subject: add .R PAD U.R U> UNUSED WITHIN

---
 README.md              |  2 +-
 alee-standalone.cpp    |  9 ++-------
 alee.cpp               |  9 ++-------
 forth/core-ext.fth     | 21 ++++++++++++++++++---
 forth/core.fth         |  3 ++-
 forth/hal.fth          | 16 ++++++++++++++++
 forth/tools.fth        | 25 +++++++++++++++++++++++++
 msp430/alee-msp430.cpp |  8 ++++----
 8 files changed, 70 insertions(+), 23 deletions(-)
 create mode 100644 forth/hal.fth
 create mode 100644 forth/tools.fth

diff --git a/README.md b/README.md
index 247624f..8680a18 100644
--- a/README.md
+++ b/README.md
@@ -15,7 +15,7 @@ Alee Forth uses the [Forth 2012 test suite](https://github.com/gerryjackson/fort
 **Missing** core extension words:
 
 ```
-.R HOLDS PAD PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID U.R U> UNUSED WITHIN [COMPILE]
+PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID [COMPILE]
 ```
 
 ## Building
diff --git a/alee-standalone.cpp b/alee-standalone.cpp
index d2151c8..509db2f 100644
--- a/alee-standalone.cpp
+++ b/alee-standalone.cpp
@@ -90,13 +90,8 @@ void user_sys(State& state)
                       state.dict.read(Dictionary::Base));
         std::cout << buf << ' ';
         break;
-    case 1: // u.
-        {
-        Addr ucell = static_cast<Addr>(state.pop());
-        std::to_chars(buf, buf + sizeof(buf), ucell,
-                      state.dict.read(Dictionary::Base));
-        std::cout << buf << ' ';
-        }
+    case 1: // unused
+        state.push(static_cast<Addr>(state.dict.capacity() - state.dict.here()));
         break;
     case 2: // emit
         std::cout << static_cast<char>(state.pop());
diff --git a/alee.cpp b/alee.cpp
index c7c9ddf..55cae57 100644
--- a/alee.cpp
+++ b/alee.cpp
@@ -90,13 +90,8 @@ void user_sys(State& state)
                       state.dict.read(Dictionary::Base));
         std::cout << buf << ' ';
         break;
-    case 1: // u.
-        {
-        Addr ucell = static_cast<Addr>(state.pop());
-        std::to_chars(buf, buf + sizeof(buf), ucell,
-                      state.dict.read(Dictionary::Base));
-        std::cout << buf << ' ';
-        }
+    case 1: // unused
+        state.push(static_cast<Addr>(state.dict.capacity() - state.dict.here()));
         break;
     case 2: // emit
         std::cout << static_cast<char>(state.pop());
diff --git a/forth/core-ext.fth b/forth/core-ext.fth
index e38d9b1..620dd64 100644
--- a/forth/core-ext.fth
+++ b/forth/core-ext.fth
@@ -1,6 +1,8 @@
 -1 constant true
 0 constant false
 
+: unused   1 sys ;
+
 : hex      16 base ! ;
 
 : nip      swap drop ;
@@ -8,6 +10,9 @@
 
 : 0>       0 > ;
 : 0<>      0= 0= ;
+: u>       swap u< ;
+
+: within   over - >r - r> swap u> ;
 
 : 2r@      ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
 
@@ -16,7 +21,7 @@
            begin dup c@ while 0 over c! char+ repeat drop ; imm
 : again    postpone repeat ; imm
 : ?do      ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
-           ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit ,
+           ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave ,
            postpone then postpone 2>r here ; imm
 
 : .(       [char] ) word count type ; imm
@@ -36,7 +41,7 @@
 : is       state @ if postpone ['] postpone defer! else ' defer! then ; imm
 : action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
 
-: erase    begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ;
+: erase    0 fill ;
 : roll     dup if swap >r 1- recurse r> swap exit then drop ;
 
 : marker   create _latest @ , here , does>
@@ -48,4 +53,14 @@
            swap 1+ swap r> tuck ! ; imm
 : endcase  swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm
 
-: holds begin dup while 1- 2dup + c@ hold repeat 2drop ;
+: holds    begin dup while 1- 2dup + c@ hold repeat 2drop ;
+
+: .r       over dup 0< if 1 else 0 then
+           begin 1+ swap base @ / dup 0<> while swap repeat
+           drop - spaces . ;
+: u.r      over 0 begin 1+ swap 0 base @ _/ dup 0<> while swap repeat
+           drop - spaces u. ;
+
+( WORD uses HERE and must be at least 33 characters. )
+: pad      here 50 chars + align ;
+
diff --git a/forth/core.fth b/forth/core.fth
index 360d269..a4bac26 100644
--- a/forth/core.fth
+++ b/forth/core.fth
@@ -8,7 +8,6 @@
 : cells    2 * ;
 
 : .        0 sys ;
-: u.       1 sys ;
 : emit     2 sys ;
 
 : 1+       1 + ;
@@ -229,3 +228,5 @@
            if 7 + then 48 + hold ;
 : #s       begin # 2dup or 0= until ;
 : sign     0< if [char] - hold then ;
+
+: u.       0 <# bl hold #s #> type ;
diff --git a/forth/hal.fth b/forth/hal.fth
new file mode 100644
index 0000000..99835ca
--- /dev/null
+++ b/forth/hal.fth
@@ -0,0 +1,16 @@
+1 constant bit0
+2 constant bit1
+4 constant bit2
+8 constant bit3
+16 constant bit4
+32 constant bit5
+64 constant bit6
+128 constant bit7
+
+1 constant port1
+2 constant port2
+3 constant port3
+4 constant port4
+5 constant port5
+
+: pindef
diff --git a/forth/tools.fth b/forth/tools.fth
new file mode 100644
index 0000000..3453ae3
--- /dev/null
+++ b/forth/tools.fth
@@ -0,0 +1,25 @@
+: .s       depth dup 0 ?do dup i - pick . loop drop ;
+: ?        @ . ;
+: dump     hex 0 do i cells over + @ s>d <# # # # # bl hold #> type loop
+           drop decimal ;
+
+7 cells 80 chars + constant _begin
+: words    _latest @ begin
+           dup @ dup 31 &
+           2 pick cell+ \ lt l len ws
+           2 pick 6 >> 1023 < if \ lt l len ws
+           rot 6 >> else \ lt len ws adv
+           >r cell+ rot drop r> @ then
+           -rot swap type space \ lt adv
+           over _begin <> while - repeat 2drop ;
+
+( xt -- caddr u )
+: _nameof  _latest @ begin \ xt lt
+           2dup < while \ xt lt
+           dup @ \ xt lt l
+           dup 6 >> 1023 < if \ xt lt l
+           6 >> - else
+           drop dup cell+ @ - then \ xt lt
+           repeat nip \ lt
+           dup @ swap cell+ over 31 & \ l lt len
+           rot 6 >> 1023 = if swap cell+ swap then ; \ lt len
diff --git a/msp430/alee-msp430.cpp b/msp430/alee-msp430.cpp
index 6328419..4bb82ef 100644
--- a/msp430/alee-msp430.cpp
+++ b/msp430/alee-msp430.cpp
@@ -143,13 +143,13 @@ void printint(DoubleCell n, char *buf)
 void user_sys(State& state)
 {
     switch (state.pop()) {
-    case 0:
+    case 0: // .
         printint(state.pop(), strbuf);
         break;
-    case 1:
-        printint(static_cast<Addr>(state.pop()), strbuf);
+    case 1: // unused
+        state.push(static_cast<Addr>(state.dict.capacity() - state.dict.here()));
         break;
-    case 2:
+    case 2: // emit
         serput(state.pop());
         break;
     case 3:
-- 
cgit v1.2.3