[gforth] / gforth / see-ext.fs  

gforth: gforth/see-ext.fs


1 : pazsan 1.1 \ see-ext.fs extentions for see locals, floats
2 :    
3 : anton 1.3 \ Copyright (C) 1995-1997 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 2
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, write to the Free Software
19 :     \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20 :    
21 : pazsan 1.1 \ made extra 26jan97jaw
22 :    
23 :     : c-loop-lp+!# c-loop cell+ ;
24 :     : c-?branch-lp+!# c-?branch cell+ ;
25 :     : c-branch-lp+!# c-branch cell+ ;
26 :    
27 :     : c-@local#
28 :     Display? IF
29 :     S" @local" 0 .string
30 :     dup @ dup 1 cells / abs 0 <# #S rot sign #> 0 .string bl cemit
31 :     THEN
32 :     cell+ ;
33 :    
34 :     : c-flit
35 :     Display? IF
36 :     dup f@ scratch represent 0=
37 :     IF 2drop scratch 3 min 0 .string
38 :     ELSE
39 :     IF '- cemit THEN 1-
40 :     scratch over c@ cemit '. cemit 1 /string 0 .string
41 :     'E cemit
42 :     dup abs 0 <# #S rot sign #> 0 .string bl cemit
43 :     THEN THEN
44 :     float+ ;
45 :    
46 :     : c-f@local#
47 :     Display? IF
48 :     S" f@local" 0 .string
49 :     dup @ dup 1 floats / abs 0 <# #S rot sign #> 0 .string bl cemit
50 :     THEN
51 :     cell+ ;
52 :    
53 :     : c-laddr#
54 :     Display? IF
55 :     S" laddr# " 0 .string
56 :     dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
57 :     THEN
58 :     cell+ ;
59 :    
60 :     : c-lp+!#
61 :     Display? IF
62 :     S" lp+!# " 0 .string
63 :     dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
64 :     THEN
65 :     cell+ ;
66 :    
67 :     create c-extend1
68 :     ' @local# A, ' c-@local# A,
69 :     ' flit A, ' c-flit A,
70 :     ' f@local# A, ' c-f@local# A,
71 :     ' laddr# A, ' c-laddr# A,
72 :     ' lp+!# A, ' c-lp+!# A,
73 :     ' ?branch-lp+!# A, ' c-?branch-lp+!# A,
74 :     ' branch-lp+!# A, ' c-branch-lp+!# A,
75 :     ' (loop)-lp+!# A, ' c-loop-lp+!# A,
76 :     ' (+loop)-lp+!# A, ' c-loop-lp+!# A,
77 :     ' (s+loop)-lp+!# A, ' c-loop-lp+!# A,
78 :     ' (-loop)-lp+!# A, ' c-loop-lp+!# A,
79 :     ' (next)-lp+!# A, ' c-loop-lp+!# A,
80 :     0 , here 0 ,
81 :    
82 :     \ extend see-table
83 :     c-extender @
84 :     c-extend1 over a!
85 :     c-extender !

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help