Esta es la versión de `decode` que escribí para Solo Forth. Creo que será más fácil de adaptar a FlashForth que la de la librería Afera, que es fig-Forth.
---- ( decode ) \ This file is part of Solo Forth \ http://programandala.net/en.program.solo_forth.html \ Copyright (C) 2015 Marcos Cruz (programandala.net) \ You may do whatever you want with this work, so long as you \ retain all copyright notices, all credit notices, and this \ license in all files of all redistributed copies and derived \ works. There is no warranty. \ Credits: \ \ This code was adapted and improved from Afera, by \ Marcos Cruz (2015). The Afera version was adapted and deeply \ modified from: Z80 CP/M fig-Forth 1.1g (adaptative version \ by EHR), modified by Dennis L. Wilson. The original code \ was written by Robert Dudley Ackerman, published in Forth \ Dimensions IV,#2 p28 (1982-07). \ Variables, indentation and pause control forth definitions decimal need body>name need name>body need case variable decode-level decode-level off \ depth of nesting variable decode-address \ in the word being decoded : indent ( -- ) cr decode-address @ u. decode-level @ 2 * spaces ; : indent+ ( -- ) 1 decode-level +! indent ; --> ( decode ) \ Special cases : decode-compile ( a1 -- a2 ) 2+ dup @ 2+ body>name id. ; : decode-literal ( a1 -- a2 ) 2+ dup @ . ; : decode-cliteral ( a1 -- a2 ) 2+ dup c@ . 1- ; : decode-branch ( a1 -- a2 ) 2+ dup @ u. ; : decode-sliteral ( a1 -- a2 ) 2+ dup count type dup c@ + 1 - ; --> ( decode ) \ Special cases dispatcher : decode-special ( a1 -- a1 | a2 ) dup @ case ['] compile of decode-compile endof ['] lit of decode-literal endof ['] clit of decode-cliteral endof ['] slit of decode-sliteral endof ['] branch of decode-branch endof ['] 0branch of decode-branch endof ['] ?branch of decode-branch endof ['] (loop) of decode-branch endof ['] (+loop) of decode-branch endof ['] (.") of decode-sliteral endof endcase ; --> ( decode ) \ Checks of the main code : decode-end? ( cfa -- f ) \ Is the given cfa the end of a definition? dup ['] ;s = swap ['] (;code) = or ; : colon-pfa? ( pfa -- f ) \ Is the given pfa a colon definition? body> @ ['] : @ = ; --> ( decode ) \ Main code : (decode) ( pfa -- ) \ Decode the definition at the given pfa. dup colon-pfa? if dup body> decode-address ! indent ." : " dup body>name id. begin ( pfa+n ) dup decode-address ! dup @ dup ( pfa+n cfa cfa ) decode-end? 0= \ ( pfa+n cfa f ) while \ high level & not end of colon definition \ ( pfa+n cfa ) 2+ ( pfa+n pfa' ) dup indent+ body>name id. key case [char] q of sp0 @ sp! quit endof \ q bl of drop endof \ space swap recurse \ default endcase decode-special 2+ -1 decode-level +! repeat indent 2+ body>name id. \ show the last word else ." Not a colon definition." then drop ; --> ( decode ) \ Interface : decode-usage ( -- ) cr ." Keys: space=more, q=quit, other=deeper." cr ; : decode ( "name" -- ) decode-usage defined ( nfa | 0 ) dup 0= -13 ?throw name>body 0 decode-level ! (decode) ; ---- -- Marcos Cruz http://programandala.net
