aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2023-10-26 20:05:40 -0400
committerClyne Sullivan <clyne@bitgloo.com>2023-10-26 20:05:40 -0400
commitddba135e7d9b596f0c9856e1f409e9f8e07001f1 (patch)
tree6dbf1798fa618fdc1a623e50b1920a1795c0447e
parent79a15b78b1d1a5a140e49dbd2de6e3d072af4b72 (diff)
add [COMPILE], fix :NONAME
-rw-r--r--README.md2
-rw-r--r--forth/core-ext.fth47
-rw-r--r--forth/core.fth2
3 files changed, 26 insertions, 25 deletions
diff --git a/README.md b/README.md
index 8680a18..aaae13b 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:
```
-PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID [COMPILE]
+PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID
```
## Building
diff --git a/forth/core-ext.fth b/forth/core-ext.fth
index 620dd64..7e4da06 100644
--- a/forth/core-ext.fth
+++ b/forth/core-ext.fth
@@ -16,29 +16,30 @@
: 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
-: compile, postpone literal postpone execute ;
-: \ _source @ >in @ +
- 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 , ['] leave ,
- postpone then postpone 2>r here ; imm
-
-: .( [char] ) word count type ; imm
-: c" state @ if ['] _jmp , here 0 , then
- [char] " word
- state @ 0= if exit then
- dup count nip allot
- here rot !
- postpone literal ; imm
-
-: buffer: create allot ;
-: value constant ;
-: to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
-: defer create does> @ execute ;
-: defer@ >body @ ;
-: defer! >body ! ;
-: is state @ if postpone ['] postpone defer! else ' defer! then ; imm
+: compile, postpone literal postpone execute ;
+: [compile] bl word find -1 = if , else compile, then ; imm
+: \ _source @ >in @ +
+ 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 , ['] leave ,
+ postpone then postpone 2>r here ; imm
+
+: .( [char] ) word count type ; imm
+: c" state @ if ['] _jmp , here 0 , then
+ [char] " word
+ state @ 0= if exit then
+ dup count nip allot
+ here rot !
+ postpone literal ; imm
+
+: buffer: create allot ;
+: value constant ;
+: to ' 4 cells + state @ if postpone literal ['] ! , else ! then ; imm
+: defer create does> @ execute ;
+: defer@ >body @ ;
+: defer! >body ! ;
+: is state @ if postpone ['] postpone defer! else ' defer! then ; imm
: action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
: erase 0 fill ;
diff --git a/forth/core.fth b/forth/core.fth
index a4bac26..90a8577 100644
--- a/forth/core.fth
+++ b/forth/core.fth
@@ -198,7 +198,7 @@
else dup emit rot 2dup c! char+ swap drop swap 1- then
repeat drop r> - 1 chars / ;
-: :noname 0 , here ] ;
+: :noname here 0 , here swap ] ;
: evaluate _source @ >r _sourceu @ >r >in @ >r
0 >in ! _sourceu ! _source ! _ev