From 08a5696e60d1f7de3ca6afe593d062336d6075fb Mon Sep 17 00:00:00 2001 From: Clyne Sullivan Date: Thu, 9 Mar 2023 19:52:36 -0500 Subject: [PATCH] move (most) of core-ext to its own file --- Makefile | 2 +- README.md | 8 +++---- core-ext.fth | 49 ++++++++++++++++++++++++++++++++++++++++ core.fth | 63 +++++++++------------------------------------------- 4 files changed, 65 insertions(+), 57 deletions(-) create mode 100644 core-ext.fth diff --git a/Makefile b/Makefile index afe8614..04dbefd 100644 --- a/Makefile +++ b/Makefile @@ -32,7 +32,7 @@ cppcheck: libalee alee*.cpp *dict.hpp test: standalone - echo "\nbye\n" | ./alee-standalone test/tester.fr test/core.fr + echo "\nbye\n" | ./alee-standalone core-ext.fth test/tester.fr test/core.fr $(LIBFILE): $(OBJFILES) $(AR) crs $@ $(OBJFILES) diff --git a/README.md b/README.md index e41b628..b59c463 100644 --- a/README.md +++ b/README.md @@ -12,9 +12,9 @@ System-specific functionality is obtained through a `sys` Forth word. This word # Forth compatibility -Alee implements a large majority of the "core" and "core extension" [glossaries](https://forth-standard.org/standard/core). Implementation is tracked in `compat.txt`, with missing words listed below. Fundamental words are built into Alee (written in C++); the rest of the implementation is in `core.fth`. +Alee implements a large majority of the "core" and "core extension" [word sets](https://forth-standard.org/standard/core). Implementation is tracked in `compat.txt`, with missing words listed below. Fundamental words are built into Alee (written in C++); the rest of the implementation is in `core.fth` and `core-ext.fth`. -This means Alee should be executed as `alee core.fth` to include these words. Alternatively, the `standalone` target packages the `core.fth` dictionary into the program. +Running Alee without `core.fth` or `core-ext.fth` passed as arguments will leave you with a minimal word set. The `standalone` target will package the `core.fth` dictionary into the program. **Missing** core features: * Pictured numeric output conversion `<# #>` @@ -36,8 +36,8 @@ Alee requires `make` and a C++17-compatible compiler. To compile, simply run the `make` command. This will produce a library, `libalee.a`, as well as a REPL binary named `alee`. A `small` target exists that optimizes the build for size. A `fast` target exists that optimizes for maximum performance on the host system. -The `standalone` target will produce a `alee-standalone` binary that contains and pre-loads the core dictionary. -The `msp430` target builds Alee for the [MSP430G2553](https://www.ti.com/product/MSP430G2553) microcontroller. Like `standalone`, the core dictionary is built into the binary. +The `standalone` target will produce a `alee-standalone` binary that has the core dictionary built in. +The `msp430` target builds Alee for the [MSP430G2553](https://www.ti.com/product/MSP430G2553) microcontroller. This target requires `standalone` for the core dictionary. Configurable constants and types are defined either in the Makefile or in `types.hpp`. diff --git a/core-ext.fth b/core-ext.fth new file mode 100644 index 0000000..e1f7eac --- /dev/null +++ b/core-ext.fth @@ -0,0 +1,49 @@ +-1 constant true +0 constant false + +: hex 16 base ! ; + +: nip swap drop ; +: tuck swap over ; + +: 0> 0 > ; +: 0<> 0= 0= ; + +: 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 , ['] exit , + 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 begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ; +: roll dup if swap >r 1- recurse r> swap exit then drop ; + +: marker create _latest @ , here , does> + dup @ _latest ! cell+ @ here swap - allot ; + +: case ['] _lit , 1 here 0 , ['] drop , ; imm +: of ['] over , ['] = , postpone if ; imm +: endof ['] _jmp , here >r 0 , postpone then + swap 1+ swap r> tuck ! ; imm +: endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm diff --git a/core.fth b/core.fth index 7807489..c23c366 100644 --- a/core.fth +++ b/core.fth @@ -48,8 +48,6 @@ : over 1 pick ; : rot >r swap r> swap ; : -rot rot rot ; -: nip swap drop ; -: tuck swap over ; : 2drop drop drop ; : 2dup over over ; @@ -63,11 +61,9 @@ : chars ; : decimal 10 base ! ; -: hex 16 base ! ; : 2r> ['] r> , ['] r> , ['] swap , ; imm : 2>r ['] swap , ['] >r , ['] >r , ; imm -: 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm : r@ ['] r> , ['] dup , ['] >r , ; imm : 2! swap over ! cell+ ! ; @@ -78,19 +74,13 @@ : <= 2dup < >r = r> | ; : > swap < ; : <> = 0= ; -: 0<> 0= 0= ; -: 0> 0 > ; : begin 0 here ; imm : while swap 1+ swap postpone if -rot ; imm : repeat ['] _jmp , , if postpone then then ; imm : until ['] _jmp0 , , drop ; imm -: again postpone repeat ; imm : do ['] _lit , here 0 , ['] >r , postpone 2>r here ; imm -: ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if - ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit , - postpone then postpone 2>r here ; imm : unloop postpone 2r> ['] 2drop , ['] r> , ['] drop , ; imm : leave postpone 2r> ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit , ; imm @@ -106,8 +96,8 @@ : j postpone 2r> ['] r> , postpone r@ ['] swap , ['] >r , ['] -rot , postpone 2>r ; imm -: align here 1 cells 1- tuck & if 1 cells swap - allot else drop then ; -: aligned dup 1 cells 1- tuck & if 1 cells swap - + else drop then ; +: align here 1 cells 1- swap over & if 1 cells swap - allot else drop then ; +: aligned dup 1 cells 1- swap over & if 1 cells swap - + else drop then ; : and & ; : or | ; @@ -137,8 +127,8 @@ : negate -1 * ; : abs dup 0< if negate then ; -: min 2dup <= if drop else nip then ; -: max 2dup <= if nip else drop then ; +: min 2dup <= if drop else swap drop then ; +: max 2dup <= if swap drop else drop then ; : source _source @ 0 begin 2dup + c@ while char+ repeat ; : key _source @ >in @ + @@ -147,15 +137,13 @@ : key? _source @ >in @ + c@ 0 <> ; : word here dup >r char+ >r begin key? if key 2dup <> else 0 0 then while - r> tuck c! char+ >r repeat - 2drop r> r> tuck - 1- over c! ; + r> swap over c! char+ >r repeat + 2drop r> r> swap over - 1- over c! ; : count dup char+ swap c@ ; : char bl word char+ c@ ; : [char] char postpone literal ; imm : ( begin [char] ) key <> while repeat ; imm -: \ _source @ >in @ + - begin dup c@ while 0 over c! char+ repeat drop ; imm : type begin dup 0 > while swap dup c@ emit char+ swap 1- repeat 2drop ; : s" state @ if ['] _jmp , here 0 , then @@ -164,20 +152,13 @@ dup cell+ allot rot here swap ! swap postpone literal postpone literal ; imm -: c" state @ if ['] _jmp , here 0 , then - [char] " word - state @ 0= if exit then - dup count nip allot - here rot ! - postpone literal ; imm : ." postpone s" state @ if ['] type , else type then ; imm -: .( [char] ) word count type ; imm : create align here 1 cells 1 chars - allot - bl word count nip + bl word count swap drop 1 chars allot - tuck over ! swap allot align + swap over over ! swap allot align ['] _lit , here 3 cells + , ['] exit dup , , dup @ 31 & over _latest @ - 6 << or over ! _latest ! ; : _does> _latest @ dup @ 31 & + cell+ aligned 2 cells + @@ -186,21 +167,9 @@ : does> ['] _jmp , here 2 cells + dup , 2 cells + , ['] _does> , ['] exit , ; imm : >body cell+ @ ; -: compile, postpone literal postpone execute ; -: buffer: create allot ; -: variable 1 cells buffer: ; +: variable create 1 cells allot ; : constant create , does> @ ; -: 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 - --1 constant true -0 constant false : quit begin _rdepth 1 > while r> drop repeat postpone [ ; : abort begin depth 0 > while drop repeat quit ; @@ -219,26 +188,16 @@ : fill -rot begin dup 0 > while >r 2dup c! char+ r> 1- repeat 2drop drop ; -: erase begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ; -: roll dup if swap >r 1- recurse r> swap exit then drop ; -: environment? 2drop false ; +: environment? 2drop 1 0= ; : accept over >r begin dup 0 > while key dup 32 < if 2drop 0 - else dup emit rot 2dup c! char+ nip swap 1- then + else dup emit rot 2dup c! char+ swap drop swap 1- then repeat drop r> - 1 chars / ; -: marker create _latest @ , here , does> - dup @ _latest ! cell+ @ here swap - allot ; : :noname 0 , here ] ; : evaluate _source @ >r _sourceu @ >r >in @ >r 0 >in ! _sourceu ! _source ! 5 sys r> >in ! r> _sourceu ! r> _source ! ; - -: case ['] _lit , 1 here 0 , ['] drop , ; imm -: of ['] over , ['] = , postpone if ; imm -: endof ['] _jmp , here >r 0 , postpone then - swap 1+ swap r> tuck ! ; imm -: endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm