version 1.1, 1997/05/21 20:39:38
|
version 1.2, 1997/07/06 15:55:25
|
Line 26 Variable vp
|
Line 26 Variable vp
|
: get-current ( -- wid ) current @ ; |
: get-current ( -- wid ) current @ ; |
: set-current ( wid -- ) current ! ; |
: set-current ( wid -- ) current ! ; |
|
|
: context ( -- addr ) vp dup @ cells + ; |
\ : context ( -- addr ) vp dup @ cells + ; |
|
: vp! dup vp ! cells vp + to context ; |
: definitions ( -- ) context @ current ! ; |
: definitions ( -- ) context @ current ! ; |
|
|
\ wordlist Vocabulary also previous 14may93py |
\ wordlist Vocabulary also previous 14may93py |
|
|
AVariable voclink |
Variable slowvoc 0 slowvoc ! |
|
|
Defer 'initvoc |
\ Forth-wordlist AConstant Forth-wordlist |
' drop ' 'initvoc >body ! |
|
|
|
Variable slowvoc slowvoc off |
: mappedwordlist ( map-struct -- wid ) \ gforth |
|
\G creates a wordlist with a special map-structure |
Forth-wordlist AConstant Forth-wordlist |
here 0 A, swap A, voclink @ A, 0 A, |
|
dup wordlist-link voclink ! |
|
dup initvoc ; |
|
|
: wordlist ( -- wid ) |
: wordlist ( -- wid ) |
here 0 A, |
|
slowvoc @ |
slowvoc @ |
IF [ Forth-wordlist wordlist-map @ ] ALiteral |
IF \ this is now f83search because hashing may be loaded already |
|
\ jaw |
|
f83search |
ELSE Forth-wordlist wordlist-map @ THEN |
ELSE Forth-wordlist wordlist-map @ THEN |
A, voclink @ A, slowvoc @ A, |
mappedwordlist ; |
dup wordlist-link dup voclink ! 'initvoc ; |
|
|
|
: Vocabulary ( -- ) Create wordlist drop DOES> context ! ; |
: Vocabulary ( -- ) Create wordlist drop DOES> context ! ; |
|
|
: also ( -- ) |
: also ( -- ) |
context @ vp @ 1+ dup maxvp > abort" Vocstack full" |
context @ vp @ 1+ dup maxvp > abort" Vocstack full" |
vp ! context ! ; |
vp! context ! ; |
|
|
: previous ( -- ) vp @ 1- dup 0= abort" Vocstack empty" vp ! ; |
: previous ( -- ) vp @ 1- dup 0= abort" Vocstack empty" vp! ; |
|
|
\ vocabulary find 14may93py |
\ vocabulary find 14may93py |
|
|
Line 88 Forth-wordlist AConstant Forth-wordlist
|
Line 90 Forth-wordlist AConstant Forth-wordlist
|
|
|
\ this is the wordlist-map of the dictionary |
\ this is the wordlist-map of the dictionary |
Create vocsearch ( -- wordlist-map ) |
Create vocsearch ( -- wordlist-map ) |
' (localsvocfind) A, ' (reveal) A, ' drop A, |
' (localsvocfind) A, ' (reveal) A, ' drop A, ' drop A, |
|
|
\ Only root 14may93py |
\ create dummy wordlist for kernel |
|
slowvoc on |
|
vocsearch mappedwordlist \ the wordlist structure ( -- wid ) |
|
|
|
\ we don't want the dummy wordlist in our linked list |
|
0 Voclink ! |
|
slowvoc off |
|
|
wordlist \ the wordlist structure |
\ Only root 14may93py |
vocsearch over wordlist-map ! \ patch the map into it |
|
|
|
Vocabulary Forth |
Vocabulary Forth |
Vocabulary Root |
Vocabulary Root |
|
|
: Only vp off also Root also definitions ; |
: Only 0 vp! also Root also definitions ; |
|
|
\ set initial search order 14may93py |
\ set initial search order 14may93py |
|
|
Forth-wordlist @ ' Forth >body ! |
Forth-wordlist @ ' Forth >body ! |
|
|
vp off also Root also definitions |
0 vp! also Root also definitions |
Only Forth also definitions |
Only Forth also definitions |
|
lookup ! \ our dictionary search order becomes the law ( -- ) |
lookup ! \ our dictionary search order becomes the law |
|
|
|
' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid |
' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid |
|
|
Line 118 lookup ! \ our dictionary search order b
|
Line 124 lookup ! \ our dictionary search order b
|
vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ; |
vp @ 0 ?DO vp cell+ I cells + @ LOOP vp @ ; |
|
|
: set-order ( wid1 .. widn n / -1 -- ) |
: set-order ( wid1 .. widn n / -1 -- ) |
dup -1 = IF drop Only exit THEN dup vp ! |
dup -1 = IF drop Only exit THEN dup vp! |
?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ; |
?dup IF 1- FOR vp cell+ I cells + ! NEXT THEN ; |
|
|
: seal ( -- ) context @ 1 set-order ; |
: seal ( -- ) context @ 1 set-order ; |
|
|
\ words visible in roots 14may93py |
|
|
|
: .name ( name -- ) \ gforth dot-name |
|
name>string type space ; |
|
|
|
require termsize.fs |
|
|
|
: words ( -- ) \ tools |
|
cr 0 context @ |
|
BEGIN |
|
@ dup |
|
WHILE |
|
2dup name>string nip 2 + dup >r + |
|
cols >= |
|
IF |
|
cr nip 0 swap |
|
THEN |
|
dup .name space r> rot + swap |
|
REPEAT |
|
2drop ; |
|
|
|
' words alias vlist ( -- ) \ gforth |
|
\g Old (pre-Forth-83) name for @code{WORDS}. |
|
|
|
: body> ( data -- cfa ) 0 >body - ; |
|
|
|
: .voc |
: .voc |
body> >name .name ; |
body> >head head>string type space ; |
|
|
: order ( -- ) \ search-ext |
: order ( -- ) \ search-ext |
\g prints the search order and the @code{current} wordlist. The |
\g prints the search order and the @code{current} wordlist. The |
\g standard requires that the wordlists are printed in the order |
\g standard requires that the wordlists are printed in the order |
Line 162 require termsize.fs
|
Line 143 require termsize.fs
|
.voc |
.voc |
LOOP |
LOOP |
4 spaces get-current .voc ; |
4 spaces get-current .voc ; |
|
|
: vocs ( -- ) \ gforth |
: vocs ( -- ) \ gforth |
\g prints vocabularies and wordlists defined in the system. |
\g prints vocabularies and wordlists defined in the system. |
voclink |
voclink |
BEGIN |
BEGIN |
@ dup @ |
@ dup |
WHILE |
WHILE |
dup 0 wordlist-link - .voc |
dup 0 wordlist-link - .voc |
REPEAT |
REPEAT |
Line 182 Root definitions
|
Line 164 Root definitions
|
|
|
Forth definitions |
Forth definitions |
|
|
include hash.fs |
|
|
|
\ table (case-sensitive wordlist) |
|
|
|
: table-find ( addr len wordlist -- nfa / false ) |
|
>r 2dup r> bucket @ (tablefind) ; |
|
|
|
Create tablesearch-map ( -- wordlist-map ) |
|
' table-find A, ' hash-reveal A, ' (rehash) A, |
|
|
|
: table ( -- wid ) |
|
\g create a case-sensitive wordlist |
|
wordlist |
|
tablesearch-map over wordlist-map ! ; |
|
|
|
\ marker 18dec94py |
|
|
|
\ Marker creates a mark that is removed (including everything |
|
\ defined afterwards) when executing the mark. |
|
|
|
: marker, ( -- mark ) here dup A, |
|
voclink @ A, voclink |
|
BEGIN @ dup @ WHILE dup 0 wordlist-link - @ A, REPEAT drop |
|
udp @ , ; |
|
|
|
: marker! ( mark -- ) |
|
dup @ swap cell+ |
|
dup @ voclink ! cell+ |
|
voclink |
|
BEGIN |
|
@ dup @ |
|
WHILE |
|
over @ over 0 wordlist-link - ! |
|
swap cell+ swap |
|
REPEAT |
|
drop voclink |
|
BEGIN |
|
@ dup @ |
|
WHILE |
|
dup 0 wordlist-link - rehash |
|
REPEAT |
|
drop |
|
@ udp ! dp ! ; |
|
|
|
: marker ( "mark" -- ) |
|
marker, Create A, |
|
DOES> ( -- ) |
|
@ marker! ; |
|