Gracias Marcos !
Debido al trabajo hace días que no me conectaba , pero mi interés por Forth
nunca decae.
Saludos.
El Jueves 12 de noviembre de 2015 12:17, "Marcos Cruz
[email protected] [forth-es]" <[email protected]> escribió:
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
#yiv0929091706 #yiv0929091706 -- #yiv0929091706ygrp-mkp {border:1px solid
#d8d8d8;font-family:Arial;margin:10px 0;padding:0 10px;}#yiv0929091706
#yiv0929091706ygrp-mkp hr {border:1px solid #d8d8d8;}#yiv0929091706
#yiv0929091706ygrp-mkp #yiv0929091706hd
{color:#628c2a;font-size:85%;font-weight:700;line-height:122%;margin:10px
0;}#yiv0929091706 #yiv0929091706ygrp-mkp #yiv0929091706ads
{margin-bottom:10px;}#yiv0929091706 #yiv0929091706ygrp-mkp .yiv0929091706ad
{padding:0 0;}#yiv0929091706 #yiv0929091706ygrp-mkp .yiv0929091706ad p
{margin:0;}#yiv0929091706 #yiv0929091706ygrp-mkp .yiv0929091706ad a
{color:#0000ff;text-decoration:none;}#yiv0929091706 #yiv0929091706ygrp-sponsor
#yiv0929091706ygrp-lc {font-family:Arial;}#yiv0929091706
#yiv0929091706ygrp-sponsor #yiv0929091706ygrp-lc #yiv0929091706hd {margin:10px
0px;font-weight:700;font-size:78%;line-height:122%;}#yiv0929091706
#yiv0929091706ygrp-sponsor #yiv0929091706ygrp-lc .yiv0929091706ad
{margin-bottom:10px;padding:0 0;}#yiv0929091706 #yiv0929091706actions
{font-family:Verdana;font-size:11px;padding:10px 0;}#yiv0929091706
#yiv0929091706activity
{background-color:#e0ecee;float:left;font-family:Verdana;font-size:10px;padding:10px;}#yiv0929091706
#yiv0929091706activity span {font-weight:700;}#yiv0929091706
#yiv0929091706activity span:first-child
{text-transform:uppercase;}#yiv0929091706 #yiv0929091706activity span a
{color:#5085b6;text-decoration:none;}#yiv0929091706 #yiv0929091706activity span
span {color:#ff7900;}#yiv0929091706 #yiv0929091706activity span
.yiv0929091706underline {text-decoration:underline;}#yiv0929091706
.yiv0929091706attach
{clear:both;display:table;font-family:Arial;font-size:12px;padding:10px
0;width:400px;}#yiv0929091706 .yiv0929091706attach div a
{text-decoration:none;}#yiv0929091706 .yiv0929091706attach img
{border:none;padding-right:5px;}#yiv0929091706 .yiv0929091706attach label
{display:block;margin-bottom:5px;}#yiv0929091706 .yiv0929091706attach label a
{text-decoration:none;}#yiv0929091706 blockquote {margin:0 0 0
4px;}#yiv0929091706 .yiv0929091706bold
{font-family:Arial;font-size:13px;font-weight:700;}#yiv0929091706
.yiv0929091706bold a {text-decoration:none;}#yiv0929091706 dd.yiv0929091706last
p a {font-family:Verdana;font-weight:700;}#yiv0929091706 dd.yiv0929091706last p
span {margin-right:10px;font-family:Verdana;font-weight:700;}#yiv0929091706
dd.yiv0929091706last p span.yiv0929091706yshortcuts
{margin-right:0;}#yiv0929091706 div.yiv0929091706attach-table div div a
{text-decoration:none;}#yiv0929091706 div.yiv0929091706attach-table
{width:400px;}#yiv0929091706 div.yiv0929091706file-title a, #yiv0929091706
div.yiv0929091706file-title a:active, #yiv0929091706
div.yiv0929091706file-title a:hover, #yiv0929091706 div.yiv0929091706file-title
a:visited {text-decoration:none;}#yiv0929091706 div.yiv0929091706photo-title a,
#yiv0929091706 div.yiv0929091706photo-title a:active, #yiv0929091706
div.yiv0929091706photo-title a:hover, #yiv0929091706
div.yiv0929091706photo-title a:visited {text-decoration:none;}#yiv0929091706
div#yiv0929091706ygrp-mlmsg #yiv0929091706ygrp-msg p a
span.yiv0929091706yshortcuts
{font-family:Verdana;font-size:10px;font-weight:normal;}#yiv0929091706
.yiv0929091706green {color:#628c2a;}#yiv0929091706 .yiv0929091706MsoNormal
{margin:0 0 0 0;}#yiv0929091706 o {font-size:0;}#yiv0929091706
#yiv0929091706photos div {float:left;width:72px;}#yiv0929091706
#yiv0929091706photos div div {border:1px solid
#666666;height:62px;overflow:hidden;width:62px;}#yiv0929091706
#yiv0929091706photos div label
{color:#666666;font-size:10px;overflow:hidden;text-align:center;white-space:nowrap;width:64px;}#yiv0929091706
#yiv0929091706reco-category {font-size:77%;}#yiv0929091706
#yiv0929091706reco-desc {font-size:77%;}#yiv0929091706 .yiv0929091706replbq
{margin:4px;}#yiv0929091706 #yiv0929091706ygrp-actbar div a:first-child
{margin-right:2px;padding-right:5px;}#yiv0929091706 #yiv0929091706ygrp-mlmsg
{font-size:13px;font-family:Arial, helvetica, clean, sans-serif;}#yiv0929091706
#yiv0929091706ygrp-mlmsg table {font-size:inherit;font:100%;}#yiv0929091706
#yiv0929091706ygrp-mlmsg select, #yiv0929091706 input, #yiv0929091706 textarea
{font:99% Arial, Helvetica, clean, sans-serif;}#yiv0929091706
#yiv0929091706ygrp-mlmsg pre, #yiv0929091706 code {font:115%
monospace;}#yiv0929091706 #yiv0929091706ygrp-mlmsg *
{line-height:1.22em;}#yiv0929091706 #yiv0929091706ygrp-mlmsg #yiv0929091706logo
{padding-bottom:10px;}#yiv0929091706 #yiv0929091706ygrp-msg p a
{font-family:Verdana;}#yiv0929091706 #yiv0929091706ygrp-msg
p#yiv0929091706attach-count span {color:#1E66AE;font-weight:700;}#yiv0929091706
#yiv0929091706ygrp-reco #yiv0929091706reco-head
{color:#ff7900;font-weight:700;}#yiv0929091706 #yiv0929091706ygrp-reco
{margin-bottom:20px;padding:0px;}#yiv0929091706 #yiv0929091706ygrp-sponsor
#yiv0929091706ov li a {font-size:130%;text-decoration:none;}#yiv0929091706
#yiv0929091706ygrp-sponsor #yiv0929091706ov li
{font-size:77%;list-style-type:square;padding:6px 0;}#yiv0929091706
#yiv0929091706ygrp-sponsor #yiv0929091706ov ul {margin:0;padding:0 0 0
8px;}#yiv0929091706 #yiv0929091706ygrp-text
{font-family:Georgia;}#yiv0929091706 #yiv0929091706ygrp-text p {margin:0 0 1em
0;}#yiv0929091706 #yiv0929091706ygrp-text tt {font-size:120%;}#yiv0929091706
#yiv0929091706ygrp-vital ul li:last-child {border-right:none
!important;}#yiv0929091706
[Se han eliminado los trozos de este mensaje que no contenían texto]
