Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

simplified u.r - albeit not sure whether it can be called a simplification. It's shorter though. #45

Open
wants to merge 7 commits into
base: master
Choose a base branch
from
Open
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
43 changes: 21 additions & 22 deletions src/cforth/decomp2.fth
Original file line number Diff line number Diff line change
Expand Up @@ -32,9 +32,8 @@ d# 300 2* /n* constant /positions
#out @ #line @ wljoin decompiler-ip rot 2! ( )
;
: ip>position ( ip -- true | #out #line false )
find-position if ( )
true ( true )
else ( adr )
find-position ( )
?dup 0= if
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I prefer the origin code in this case as it seems clearer to me.

2@ drop lwsplit ( #out #line )
false ( #out #line false )
then ( true | #out #line false )
Expand All @@ -45,7 +44,9 @@ d# 300 2* /n* constant /positions

headers
defer indent
: (indent) ( -- ) lmargin @ #out @ - 0 max spaces ;
: (indent) ( -- ) lmargin @ #out @ -
\ 0 max \ unnecessary, as spaces does that too.
spaces ;
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Formatting: if the definition fits entirely on one line, it can follow the stack diagram. Otherwise the entire body must be on a 3-space indent and the ; is on a line by itself

' (indent) is indent
headerless

Expand Down Expand Up @@ -122,10 +123,9 @@ variable break-type variable break-addr variable where-break
-1 break-addr ! ( prime stack)
end-breaks @ breaks ?do
i 2@ over break-addr @ u< if
break-type ! break-addr ! i where-break !
else
2drop
2dup break-type ! break-addr ! i where-break !
then
2drop
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This change seems hardly worth the effort. Your formulation compiles to slightly shorter code, but the improvement is so slight...

/n 2* +loop
break-addr @ -1 <> if -1 -1 where-break @ 2! then
;
Expand All @@ -142,7 +142,7 @@ variable break-type variable break-addr variable where-break
: bare-if? ( ip-of-branch-target -- f )
/branch - /token - dup token@ ( ip' possible-branch-acf )
dup ['] branch = \ unconditional branch means else or repeat
if drop drop false exit then ( ip' acf )
if 2drop false exit then ( ip' acf )
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Okay but add another space before the then (fixing my formatting error).

['] ?branch = \ cond. forw. branch is for an IF THEN with null body
if forward-branch? else drop true then
;
Expand Down Expand Up @@ -182,12 +182,11 @@ variable extent extent off
end-breaks @ breaks /breaks + >= ( adr,type full? )
abort" Decompiler table overflow" ( adr,type )
end-breaks @ breaks > if ( adr,type )
over end-breaks @ /n 2* - >r r@ 2@ ( adr,type adr prev-adr,type )
over end-breaks @ /n 2* - dup >r 2@ ( adr,type adr prev-adr,type )
['] .endof = -rot = and if ( adr,type )
r@ 2@ 2swap r> 2! ( prev-adr,type )
else ( adr,type )
r> drop ( adr,type )
r@ 2@ 2swap r@ 2! ( prev-adr,type )
then ( adr,type )
r> drop ( adr,type )
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I hope you aren't going to continue to swamp me with little tweaks of this magnitude...

then ( adr,type )
end-breaks @ 2! /n 2* end-breaks +! ( )
;
Expand All @@ -199,7 +198,7 @@ variable extent extent off
then
/n 2* +loop ( break-address break-type not-found? )

if add-break else 2drop then
if 2dup add-break then 2drop
;

: scan-of ( ip-of-(of -- ip' )
Expand Down Expand Up @@ -297,9 +296,9 @@ variable extent extent off
: type# ( $ -- ) \ render control characters as green #
bounds ?do
i c@ dup h# 20 < if
drop green-letters ." #" red-letters
drop green-letters ." #" red-letters
else
emit
emit
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for fixing the tabs and trailing whitespace

then
loop
;
Expand All @@ -316,7 +315,7 @@ variable extent extent off
: pretty-. ( n -- )
base @ d# 10 = if (.) else (u.) then ( adr len )
dup 3 + ?line indent add-position
green-letters
green-letters
base @ case
d# 10 of ." #" endof
d# 16 of ." $" endof
Expand Down Expand Up @@ -452,7 +451,7 @@ also forth definitions
['] dummy ['] do-scan (patch
['] dummy ['] .execution-class (patch
['] dummy ['] execution-class >body na1+
dup [ #decomp-classes ] literal ta+ tsearch
dup [ #decomp-classes ] literal ta+ tsearch
drop token!
;
previous definitions
Expand Down Expand Up @@ -482,10 +481,10 @@ headers
dup is decompiler-ip ( adr )
?cr ( adr )
break-addr @ over = if ( adr )
begin ( adr )
break-type @ execute ( adr )
next-break break-addr @ over <> ( adr done? )
until ( adr )
begin ( adr )
break-type @ execute ( adr )
next-break break-addr @ over <> ( adr done? )
until ( adr )
else ( adr )
.token ( adr' )
then ( adr' )
Expand Down Expand Up @@ -571,7 +570,7 @@ also forth definitions
: install-decomp-definer ( definer-acf display-acf -- )
['] dummy ['] .definition-class (patch
['] dummy ['] definition-class >body na1+
dup [ #definition-classes ] literal ta+ tsearch
dup [ #definition-classes ] literal ta+ tsearch
drop token!
;
previous definitions
Expand Down