aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2023-10-26 19:54:29 -0400
committerClyne Sullivan <clyne@bitgloo.com>2023-10-26 19:54:29 -0400
commit5ee8f7e01dfbcb03c705f8bb6f252c2f1b829b46 (patch)
tree1c444cf6d11b31b8b072ca91272a0771d88f44aa
parent6b1955a69ed1dcb218ebc33fa22c6681924dff15 (diff)
add .R PAD U.R U> UNUSED WITHIN
-rw-r--r--README.md2
-rw-r--r--alee-standalone.cpp9
-rw-r--r--alee.cpp9
-rw-r--r--forth/core-ext.fth21
-rw-r--r--forth/core.fth3
-rw-r--r--forth/hal.fth16
-rw-r--r--forth/tools.fth25
-rw-r--r--msp430/alee-msp430.cpp8
8 files changed, 70 insertions, 23 deletions
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: