Decompilation works again.

diff --git a/src/lib.4th b/src/lib.4th
index e4da7a7..224e7cb 100644 (file)
--- a/src/lib.4th
+++ b/src/lib.4th
@@ -11,6 +11,6 @@ include lib_3_comments.4th
 include lib_4_printnum.4th
 include lib_5_strings.4th
 include lib_6_variables.4th
 include lib_4_printnum.4th
 include lib_5_strings.4th
 include lib_6_variables.4th

-include lib_7_decompiler.4th
-include lib_8_vocab.4th
+include lib_7_vocab.4th
+include lib_8_decompiler.4th

 include lib_9_misc.4th
 include lib_9_misc.4th

diff --git a/src/lib_2_control.4th b/src/lib_2_control.4th
index 464a9a4..beb232d 100644 (file)
--- a/src/lib_2_control.4th
+++ b/src/lib_2_control.4th
@@ -1,11 +1,18 @@
 \ Flow control
 
 \ Flow control
 

+\ ... if/unless ... [else ...] then
+

 : IF IMMEDIATE
         ['] 0BRANCH ,     \ compile 0BRANCH
         HERE          \ save location of the offset on the stack
         0 ,             \ compile a dummy offset
 ;
 
 : IF IMMEDIATE
         ['] 0BRANCH ,     \ compile 0BRANCH
         HERE          \ save location of the offset on the stack
         0 ,             \ compile a dummy offset
 ;
 

+: UNLESS IMMEDIATE
+        ['] NOT ,         \ compile NOT (to reverse the test)
+        [COMPILE] IF    \ continue by calling the normal IF
+;
+

 : THEN IMMEDIATE
         DUP
         HERE SWAP -   \ calculate the offset from the address saved on the stack
 : THEN IMMEDIATE
         DUP
         HERE SWAP -   \ calculate the offset from the address saved on the stack


@@ -22,6 +29,9 @@
         SWAP !
 ;
 
         SWAP !
 ;
 

+
+\ begin ... while ... repeat, begin ... until, begin ... repeat
+

 : BEGIN IMMEDIATE
         HERE          \ save location on the stack
 ;
 : BEGIN IMMEDIATE
         HERE          \ save location on the stack
 ;


@@ -53,10 +63,8 @@
         SWAP !          \ and back-fill it in the original location
 ;
 
         SWAP !          \ and back-fill it in the original location
 ;
 

-: UNLESS IMMEDIATE
-        ['] NOT ,         \ compile NOT (to reverse the test)
-        [COMPILE] IF    \ continue by calling the normal IF
-;
+
+\ [?]do ... [+]loop 

 
 : DO IMMEDIATE
         ['] LIT , -1 , [COMPILE] IF
 
 : DO IMMEDIATE
         ['] LIT , -1 , [COMPILE] IF


@@ -76,6 +84,8 @@
 
 : J RSP@ 6 - @ ;
 
 
 : J RSP@ 6 - @ ;
 

+: K RSP@ 9 - @ ;
+

 : ?LEAVE IMMEDIATE
         ['] 0BRANCH , 13 ,
         ['] R> , ['] RDROP , ['] RDROP ,
 : ?LEAVE IMMEDIATE
         ['] 0BRANCH , 13 ,
         ['] R> , ['] RDROP , ['] RDROP ,


@@ -123,7 +133,7 @@
 ;
 
 
 ;
 
 

-\ CASE ------------------------------------------------------------------------
+\ case [of ... endof]+ ... endcase

 
 : CASE IMMEDIATE
         0               \ push 0 to mark the bottom of the stack
 
 : CASE IMMEDIATE
         0               \ push 0 to mark the bottom of the stack

diff --git a/src/lib_8_vocab.4th b/src/lib_7_vocab.4th
similarity index 59%
rename from src/lib_8_vocab.4th
rename to src/lib_7_vocab.4th
index e0ba306..5f13b47 100644 (file)
--- a/src/lib_8_vocab.4th
+++ b/src/lib_7_vocab.4th
@@ -13,11 +13,41 @@
         DUP @ LATEST !      ( set LATEST to point to the previous word )
 ;
 
         DUP @ LATEST !      ( set LATEST to point to the previous word )
 ;
 

-: HIDE
+\ Mark word as hidden
+: HIDE ( -- )

         BL WORD FIND DROP >NAME
         DUP @ F_HIDDEN OR SWAP !
 ;
 
         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 >= 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 -- )
+;
+
+

 \ Create new vocabulary
 : VOCABULARY
         create 0 ,
 \ Create new vocabulary
 : VOCABULARY
         create 0 ,


@@ -40,7 +70,11 @@ vocabulary ROOT
 ;
 
 : PREVIOUS
 ;
 
 : PREVIOUS

-        1 #context -!
+        #context @ 1 > if
+                1 #context -!
+        else
+                CR ." Cannot empty search order stack!"
+        then

 ;
 
 : ALSO
 ;
 
 : ALSO

diff --git a/src/lib_7_decompiler.4th b/src/lib_8_decompiler.4th
similarity index 81%
rename from src/lib_7_decompiler.4th
rename to src/lib_8_decompiler.4th
index a27442b..90ba109 100644 (file)
--- a/src/lib_7_decompiler.4th
+++ b/src/lib_8_decompiler.4th
@@ -1,30 +1,54 @@
 \ Decompilation
 
 \ Decompilation
 

-: .NAME
-        DUP @           ( get the flags/length byte )
-        F_LENMASK AND   ( mask out the flags - just want the length )
+: VCFA>LATEST
+        1+ @
+;

 
 

-        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 -- )
+: CLOSESTLINK ( addr vcfa -- lfa )
+
+        vcfa>latest dup         ( addr link link )
+        rot dup -rot            ( link addr link addr )
+        < if
+                2drop
+                0 exit
+        then
+
+        swap    ( addr link )
+        0 -rot  ( 0 addr link )
+        
+        begin
+                rot drop        ( addr link )
+                dup -rot @      ( link addr nextlink )
+                2dup            ( link addr nextlink addr nextlink)
+        > until
+
+        2drop

 ;
 
 ;
 

-: ?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) )
+: MIN           ( n m -- max )
+        2dup - 0> if
+                swap drop
+        else
+                drop
+        then
+;
+
+: BODYLEN ( cfa -- len )
+
+        here swap ( clink addr )
+        context dup #context @ + swap
+        do
+                dup i @
+
+                closestlink ( clink addr clink' )
+
+                ?dup 0> if
+                        rot min
+                        swap
+                then
+        loop
+
+        -

 ;
 
 : ?IMMEDIATE
 ;
 
 : ?IMMEDIATE


@@ -33,10 +57,6 @@
         F_IMMED AND     ( mask the F_IMMED flag and return it (as a truth value) )
 ;
 
         F_IMMED AND     ( mask the F_IMMED flag and return it (as a truth value) )
 ;
 

-: BODYLEN
-        \ **TODO**
-;
-

 : SEE
         BL WORD FIND    ( find the dictionary entry to decompile )
 
 : SEE
         BL WORD FIND    ( find the dictionary entry to decompile )
 

diff --git a/src/lib_9_misc.4th b/src/lib_9_misc.4th
index a864cbb..9078fc4 100644 (file)
--- a/src/lib_9_misc.4th
+++ b/src/lib_9_misc.4th
@@ -1,4 +1,4 @@
-\ Miscellaneous core words
+\ Miscellaneous undefined core words

 
 : ROLL ( x_u x_u-1... x_0 u -- x_u-1 ... x_0 x_u )
         1+ DUP PICK SWAP    ( x_u x_u-1 ... x_0 x_u u+1 )
 
 : ROLL ( x_u x_u-1... x_0 u -- x_u-1 ... x_0 x_u )
         1+ DUP PICK SWAP    ( x_u x_u-1 ... x_0 x_u u+1 )


@@ -24,13 +24,5 @@
         then
 ;
 
         then
 ;
 

-: MIN           ( n m -- max )
-        2dup - 0> if
-                swap drop
-        else
-                drop
-        then
-;
-

 : UNUSED  ( -- cells )
         MEMSIZE HERE - ;
 : UNUSED  ( -- cells )
         MEMSIZE HERE - ;