X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=src%2Flib_8_vocab.4th;h=22d98b573e3daa4d6ca74f62a1e2f7e7b379fb23;hb=f2ccca0d0ef6156118d6f3412671013efd9bc6b6;hp=e0ba306dfcfa4c2a50cbd7e7d8c82ad8350166d1;hpb=56f581c25775f4244cd60d5943a5beb46a9ccafb;p=forth.jl.git diff --git a/src/lib_8_vocab.4th b/src/lib_8_vocab.4th index e0ba306..22d98b5 100644 --- a/src/lib_8_vocab.4th +++ b/src/lib_8_vocab.4th @@ -10,14 +10,44 @@ >link - DUP @ LATEST ! ( set LATEST to point to the previous word ) + dup @ current @ 1+ ! ( set LATEST to point to the previous word ) ; -: HIDE +\ Mark word as hidden +: HIDE ( -- ) BL WORD FIND DROP >NAME DUP @ F_HIDDEN OR SWAP ! ; +: ?HIDDEN + 1+ ( skip over the link pointer ) + @ ( get the flags/length byte ) + F_HIDDEN AND ( mask the F_HIDDEN flag and return it (as a truth value) ) +; + +\ Display name of word +: .NAME ( cfa -- ) + DUP @ ( get the flags/length byte ) + F_LENMASK AND ( mask out the flags - just want the length ) + + BEGIN + DUP 0> ( length > 0? ) + WHILE + SWAP 1+ ( addr len -- len addr+1 ) + DUP @ ( len addr -- len addr char | get the next character) + DUP 32 >= IF + EMIT ( len addr char -- len addr | and print it) + ELSE + BASE @ SWAP HEX + ." \x" 0 .R + BASE ! + THEN + SWAP 1- ( len addr -- addr len-1 | subtract one from length ) + REPEAT + 2DROP ( len addr -- ) +; + + \ Create new vocabulary : VOCABULARY create 0 , @@ -40,6 +70,9 @@ vocabulary ROOT ; : PREVIOUS + #context @ + 1 <= abort" Cannot empty search order stack!" + 1 #context -! ;