[gforth] / gforth / smartdots.fs  

gforth: gforth/smartdots.fs

1 : pazsan 1.2 \ smart .s 09mar2012py
2 :    
3 : pazsan 1.4 \ Copyright (C) 2012 Free Software Foundation, Inc.
4 : pazsan 1.2
5 :     \ This file is part of Gforth.
6 :    
7 :     \ Gforth is free software; you can redistribute it and/or
8 :     \ modify it under the terms of the GNU General Public License
9 :     \ as published by the Free Software Foundation, either version 3
10 :     \ of the License, or (at your option) any later version.
11 :    
12 :     \ This program is distributed in the hope that it will be useful,
13 :     \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14 :     \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 :     \ GNU General Public License for more details.
16 :    
17 :     \ You should have received a copy of the GNU General Public License
18 :     \ along with this program. If not, see http://www.gnu.org/licenses/.
19 :    
20 :     \ idea: Gerald Wodni
21 : pazsan 1.1
22 :     : addr? ( addr -- flag )
23 : pazsan 1.6 TRY c@ IFERROR 2drop false nothrow ELSE drop true THEN ENDTRY ;
24 : pazsan 1.1
25 :     : string? ( addr u -- flag )
26 : pazsan 1.6 TRY dup #80 u> throw bounds ?DO I c@ bl < IF -1 throw THEN LOOP
27 : pazsan 1.2 IFERROR 2drop drop false nothrow ELSE true THEN ENDTRY ;
28 : pazsan 1.1
29 :     : .string. ( addr u -- )
30 : pazsan 1.3 .\" s\" " type '"' emit space ;
31 : pazsan 1.7 : .addr. ( addr -- )
32 :     dup >name dup IF ." ' " .name drop ELSE drop hex. THEN ;
33 : pazsan 1.1
34 : pazsan 1.2 Variable smart.s-skip
35 :    
36 :     : smart.s. ( n -- )
37 :     smart.s-skip @ smart.s-skip off IF drop EXIT THEN
38 : pazsan 1.5 over r> i swap >r -
39 :     dup 1 = IF false ELSE pick 2dup string? THEN IF
40 : pazsan 1.2 .string. smart.s-skip on
41 :     ELSE drop dup addr? IF .addr.
42 :     ELSE . THEN
43 :     THEN ;
44 :    
45 : pazsan 1.6 ' smart.s. IS .s.
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help