[BACK]Return to smartdots.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/smartdots.fs between versions 1.1 and 1.8

version 1.1, 2012/03/09 12:46:46 version 1.8, 2012/03/27 23:17:52
Line 1 Line 1
 \ smart .s  \ smart .s                                             09mar2012py
   
   \ Copyright (C) 2012 Free Software Foundation, Inc.
   
   \ This file is part of Gforth.
   
   \ Gforth is free software; you can redistribute it and/or
   \ modify it under the terms of the GNU General Public License
   \ as published by the Free Software Foundation, either version 3
   \ of the License, or (at your option) any later version.
   
   \ This program is distributed in the hope that it will be useful,
   \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   \ GNU General Public License for more details.
   
   \ You should have received a copy of the GNU General Public License
   \ along with this program. If not, see http://www.gnu.org/licenses/.
   
   \ idea: Gerald Wodni
   
 : addr? ( addr -- flag )  : addr? ( addr -- flag )
     TRY  @  IFERROR  2drop  false  ELSE  drop  true  THEN   ENDTRY ;      TRY  c@  IFERROR  2drop  false nothrow  ELSE  drop  true  THEN   ENDTRY ;
   : .var? ( addr -- flag )
       TRY  body> @ dovar: <> throw  IFERROR  2drop false nothrow
           ELSE  true  THEN   ENDTRY ;
   
 : string? ( addr u -- flag )  : string? ( addr u -- flag )
     TRY  bounds ?DO  I c@ bl < IF  -1 throw  THEN  LOOP      TRY  dup #80 u> throw  bounds ?DO  I c@ bl < IF  -1 throw  THEN  LOOP
         IFERROR  2drop drop false  ELSE  true  THEN  ENDTRY ;          IFERROR  2drop drop false nothrow ELSE  true  THEN  ENDTRY ;
   
 : .string. ( addr u -- )  : .string. ( addr u -- )
     '"' emit type '"' emit space ;      .\" s\" " type '"' emit space ;
 : .addr. ( addr -- )  hex. ;  : .addr. ( addr -- )
       dup >name dup IF  ." ' " .name drop  ELSE  drop hex.  THEN ;
   : .var. ( addr -- )
       dup body> >name dup IF  .name drop  ELSE  drop hex.  THEN ;
   
   Variable smart.s-skip
   
   : smart.s. ( n -- )
       smart.s-skip @  smart.s-skip off IF  drop  EXIT  THEN
       over r> i swap >r - \ we access the .s loop counter
       dup 1 = IF  false  ELSE  pick  2dup string?  THEN  IF
           .string. smart.s-skip on
       ELSE  drop dup addr? IF  dup .var? IF  .var.  ELSE  .addr.  THEN
           ELSE  .  THEN
       THEN ;
   
 : .s ( -- ) \ tools dot-s  ' smart.s. IS .s.
 \G Display the number of items on the data stack, followed by a list  
 \G of the items (but not more than specified by @code{maxdepth-.s};  
 \G TOS is the right-most item.  
     ." <" depth 0 .r ." > "  
     depth 0 max maxdepth-.s @ min  
     dup 0  
     ?do  
         dup i - pick  over i - pick  2dup string? IF  .string. 2  
         ELSE  drop dup addr? IF  .addr. 1  
             ELSE  .s. 1  THEN  
         THEN  
     +loop  
     drop ;  
Removed from v.1.1  
changed lines
  Added in v.1.8

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>