alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Moved words and vlist to utils.

Browse Source
This commit is contained in:
Brad Nelson
2021-02-12 21:05:36 -08:00
parent 8fffafa018
commit f5787bcc7c
3 changed files with 15 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
ueforth/common/boot.fs
View File

@ -206,10 +206,6 @@ variable hld
if ." Unsupported word type: " see. cr exit then if ." Unsupported word type: " see. cr exit then
['] : see. dup see. space see-loop ['] ; see. cr ; ['] : see. dup see. space see-loop ['] ; see. cr ;
: see ' see-xt ; : see ' see-xt ;
75 value line-width
: onlines ( n xt -- n xt )
swap dup line-width > if drop 0 cr then over >name nip + 1+ swap ;
: words 0 context @ @ begin dup while onlines dup see. >link repeat 2drop cr ;
( Input ) ( Input )
: raw.s depth 0 max for aft sp@ r@ cells - @ . then next ; : raw.s depth 0 max for aft sp@ r@ cells - @ . then next ;

16
ueforth/common/utils.fs
View File

@ -7,6 +7,9 @@
: dump ( a n -- ) : dump ( a n -- )
cr 0 do i 16 mod 0= if cr then dup i + c@ . loop drop cr ; cr 0 do i 16 mod 0= if cr then dup i + c@ . loop drop cr ;
( Remove from Dictionary )
: forget ( "name" ) ' dup >link current @ ! >name drop here - allot ;
internals definitions internals definitions
: mem= ( a a n -- f) : mem= ( a a n -- f)
for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ; for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
@ -14,7 +17,16 @@ forth definitions also internals
: str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ; : str= ( a n a n -- f) >r swap r@ <> if rdrop 2drop 0 exit then r> mem= ;
: startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ; : startswith? ( a n a n -- f ) >r swap r@ < if rdrop 2drop 0 exit then r> mem= ;
: .s ." <" depth n. ." > " raw.s cr ; : .s ." <" depth n. ." > " raw.s cr ;
: see-all 0 context @ @ begin dup while onlines dup see-xt >link repeat 2drop cr ;
only forth definitions only forth definitions
: forget ( "name" ) ' dup >link current @ ! >name drop here - allot ; ( List words in Dictionary / Vocabulary )
internals definitions
75 value line-width
: onlines ( n xt -- n xt )
swap dup line-width > if drop 0 cr then over >name nip + 1+ swap ;
: >name-length ( xt -- n ) dup 0= if exit then >name nip ;
forth definitions also internals
: vlist 0 context @ @ begin dup >name-length while onlines dup see. >link repeat 2drop cr ;
: words 0 context @ @ begin dup while onlines dup see. >link repeat 2drop cr ;
: see-all 0 context @ @ begin dup while onlines dup see-xt >link repeat 2drop cr ;
only forth definitions

6
ueforth/common/vocabulary.fs
View File

@ -5,8 +5,6 @@ current @ constant forth-wordlist
: vocabulary ( "name" ) create 0 , current @ 2 cells + , current @ @ last-vocabulary ! : vocabulary ( "name" ) create 0 , current @ 2 cells + , current @ @ last-vocabulary !
does> cell+ context ! ; does> cell+ context ! ;
: definitions context @ current ! ; : definitions context @ current ! ;
: >name-length ( xt -- n ) dup 0= if exit then >name nip ;
: vlist 0 context @ @ begin dup >name-length while onlines dup see. >link repeat 2drop cr ;
( Make it easy to transfer words between vocabularies ) ( Make it easy to transfer words between vocabularies )
: transfer-xt ( xt -- ) context @ begin 2dup @ <> while @ >link& repeat nip : transfer-xt ( xt -- ) context @ begin 2dup @ <> while @ >link& repeat nip
@ -36,9 +34,7 @@ transfer{
'sys 'heap aliteral 'sys 'heap aliteral
leaving( )leaving leaving leaving, leaving( )leaving leaving leaving,
(do) (?do) (+loop) (do) (?do) (+loop)
parse-quote digit $@ parse-quote digit $@ raw.s
see. see-loop >name-length exit=
see-one raw.s
tib-setup input-limit tib-setup input-limit
}transfer }transfer
forth definitions forth definitions