From 4437e4ba8255ef676faf94682a8ecc2579d0f12d Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Thu, 2 Jun 2016 23:26:11 +1200 Subject: [PATCH] WORDS now searches transient vocab only. TODO: FORGET and HIDE. --- src/lib.4th | 8 +- ..._8_decompiler.4th => lib_7_decompiler.4th} | 33 ++++++++ src/lib_7_printwords.4th | 48 ----------- src/lib_8_vocab.4th | 82 +++++++++++++++++++ src/{lib_10_misc.4th => lib_9_misc.4th} | 0 src/lib_9_vocab.4th | 68 --------------- 6 files changed, 118 insertions(+), 121 deletions(-) rename src/{lib_8_decompiler.4th => lib_7_decompiler.4th} (80%) delete mode 100644 src/lib_7_printwords.4th create mode 100644 src/lib_8_vocab.4th rename src/{lib_10_misc.4th => lib_9_misc.4th} (100%) delete mode 100644 src/lib_9_vocab.4th diff --git a/src/lib.4th b/src/lib.4th index 496e639..e4da7a7 100644 --- a/src/lib.4th +++ b/src/lib.4th @@ -11,8 +11,6 @@ include lib_3_comments.4th include lib_4_printnum.4th include lib_5_strings.4th include lib_6_variables.4th -include lib_7_printwords.4th -include lib_8_decompiler.4th -include lib_9_vocab.4th - -include lib_10_misc.4th +include lib_7_decompiler.4th +include lib_8_vocab.4th +include lib_9_misc.4th diff --git a/src/lib_8_decompiler.4th b/src/lib_7_decompiler.4th similarity index 80% rename from src/lib_8_decompiler.4th rename to src/lib_7_decompiler.4th index e1470f3..505f7da 100644 --- a/src/lib_8_decompiler.4th +++ b/src/lib_7_decompiler.4th @@ -1,5 +1,38 @@ \ Decompilation +: .NAME + 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 >= OVER 127 <= AND 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 -- ) +; + +: ?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) ) +; + +: ?IMMEDIATE + 1+ ( skip over the link pointer ) + @ ( get the flags/length byte ) + F_IMMED AND ( mask the F_IMMED flag and return it (as a truth value) ) +; + : SEE BL WORD FIND ( find the dictionary entry to decompile ) diff --git a/src/lib_7_printwords.4th b/src/lib_7_printwords.4th deleted file mode 100644 index 9533556..0000000 --- a/src/lib_7_printwords.4th +++ /dev/null @@ -1,48 +0,0 @@ -\ Display dictionary contents - -: .NAME - 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 >= OVER 127 <= AND 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 -- ) -; - -: ?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) ) -; -: ?IMMEDIATE - 1+ ( skip over the link pointer ) - @ ( get the flags/length byte ) - F_IMMED AND ( mask the F_IMMED flag and return it (as a truth value) ) -; - -: WORDS - CR - LATEST @ ( start at LATEST dictionary entry ) - BEGIN - ?DUP ( while link pointer is not null ) - WHILE - DUP ?HIDDEN NOT IF ( ignore hidden words ) - DUP 1+ .NAME ( but if not hidden, print the word ) - SPACE - THEN - @ ( dereference the link pointer - go to previous word ) - REPEAT - CR -; diff --git a/src/lib_8_vocab.4th b/src/lib_8_vocab.4th new file mode 100644 index 0000000..34b8251 --- /dev/null +++ b/src/lib_8_vocab.4th @@ -0,0 +1,82 @@ +\ Vocabulary management + +: FORGET + BL WORD FIND >LINK ( find the word, gets the dictionary entry address ) + DUP @ LATEST ! ( set LATEST to point to the previous word ) + H ! ( and store H with the dictionary address ) +; + +: HIDE + BL WORD FIND DROP >NAME + DUP @ F_HIDDEN OR SWAP ! +; + +: VOCAB>LATEST ( vcfa -- vlatest ) + 1+ @ @ ; + +\ Create new vocabulary +: VOCABULARY + create 0 , +does> + body> context #context @ 1- + ! +; + +: DEFINITIONS + context #context @ 1- + @ current ! +; + +\ Define root vocabulary (always available) +vocabulary ROOT + +: ONLY + 1 #context ! + root + 2 #context ! + root +; + +: PREVIOUS + 1 #context -! +; + +: ALSO + context #context @ + dup 1- @ swap ! + 1 #context +! +; + +also root definitions + + : FORTH forth ; + + \ Display search order and compilation dictionary + : ORDER + + \ Search order + context #context @ 1- + context swap + do + i @ >name .name space + -1 +loop + + \ Current (definitions) + 5 spaces + current @ >name .name + ; + + \ Display transient vocabulary contents + : WORDS + cr + context #context @ 1- + @ + 1+ @ + BEGIN + ?DUP ( while link pointer is not 0 ) + WHILE + DUP ?HIDDEN NOT IF ( ignore hidden words ) + DUP 1+ .NAME ( but if not hidden, print the word ) + SPACE + THEN + @ ( dereference the link pointer - go to previous word ) + REPEAT + CR + ; + +only forth also definitions diff --git a/src/lib_10_misc.4th b/src/lib_9_misc.4th similarity index 100% rename from src/lib_10_misc.4th rename to src/lib_9_misc.4th diff --git a/src/lib_9_vocab.4th b/src/lib_9_vocab.4th deleted file mode 100644 index e4f836b..0000000 --- a/src/lib_9_vocab.4th +++ /dev/null @@ -1,68 +0,0 @@ -\ Vocabulary management - -: FORGET - BL WORD FIND >LINK ( find the word, gets the dictionary entry address ) - DUP @ LATEST ! ( set LATEST to point to the previous word ) - H ! ( and store H with the dictionary address ) -; - -: HIDE - BL WORD FIND DROP >NAME - DUP @ F_HIDDEN OR SWAP ! -; - -: VOCAB>LATEST ( vcfa -- vlatest ) - 1+ @ @ ; - -: ALSO - context #context @ + dup 1- @ swap ! - 1 #context +! -; - -\ Create new vocabulary -: VOCABULARY - create 0 , -does> - body> context #context @ 1- + ! -; - -: DEFINITIONS - context #context @ 1- + @ current ! -; - -\ Display search order and compilation dictionary -: ORDER - - \ Search order - context #context @ 1- + context swap - do - i @ >name .name space - -1 +loop - - \ Current (definitions) - 5 spaces - current @ >name .name -; - -\ Define root vocabulary (always available) -vocabulary ROOT - -: ONLY - 1 #context ! - root - 2 #context ! - root -; - -: PREVIOUS - 1 #context -! -; - -also root definitions - -: FORTH forth ; -: ALSO also ; -: WORDS words ; -: ORDER order ; - -only forth also definitions -- 2.20.1