From: Tim Vaughan Date: Sun, 5 Jun 2016 12:46:44 +0000 (+1200) Subject: Decompilation works again. X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=90a9b8ad41a542c3ca7d150d4d1168cb8ec97b81;p=forth.jl.git Decompilation works again. --- diff --git a/src/lib.4th b/src/lib.4th index e4da7a7..224e7cb 100644 --- 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_7_decompiler.4th -include lib_8_vocab.4th +include lib_7_vocab.4th +include lib_8_decompiler.4th include lib_9_misc.4th diff --git a/src/lib_2_control.4th b/src/lib_2_control.4th index 464a9a4..beb232d 100644 --- a/src/lib_2_control.4th +++ b/src/lib_2_control.4th @@ -1,11 +1,18 @@ \ 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 ; +: 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 @@ -22,6 +29,9 @@ SWAP ! ; + +\ begin ... while ... repeat, begin ... until, begin ... repeat + : BEGIN IMMEDIATE HERE \ save location on the stack ; @@ -53,10 +63,8 @@ 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 @@ -76,6 +84,8 @@ : J RSP@ 6 - @ ; +: K RSP@ 9 - @ ; + : ?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 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 --- 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 ) ; -: 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 >= 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 , @@ -40,7 +70,11 @@ vocabulary ROOT ; : PREVIOUS - 1 #context -! + #context @ 1 > if + 1 #context -! + else + CR ." Cannot empty search order stack!" + then ; : 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 --- a/src/lib_7_decompiler.4th +++ b/src/lib_8_decompiler.4th @@ -1,30 +1,54 @@ \ 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 @@ -33,10 +57,6 @@ 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 ) diff --git a/src/lib_9_misc.4th b/src/lib_9_misc.4th index a864cbb..9078fc4 100644 --- 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 ) @@ -24,13 +24,5 @@ then ; -: MIN ( n m -- max ) - 2dup - 0> if - swap drop - else - drop - then -; - : UNUSED ( -- cells ) MEMSIZE HERE - ;