[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.10 \ Copyright (C) 1995,1996,1997,2003 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 : anton 1.11 \ as published by the Free Software Foundation, either version 3
10 : pazsan 1.2 \ 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 : anton 1.11 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : pazsan 1.2
20 : pazsan 1.1 \ made extra 26jan97jaw
21 :    
22 :     : c-loop-lp+!# c-loop cell+ ;
23 :     : c-?branch-lp+!# c-?branch cell+ ;
24 :     : c-branch-lp+!# c-branch cell+ ;
25 :    
26 :     : c-@local#
27 :     Display? IF
28 :     S" @local" 0 .string
29 :     dup @ dup 1 cells / abs 0 <# #S rot sign #> 0 .string bl cemit
30 :     THEN
31 :     cell+ ;
32 :    
33 :     : c-flit
34 :     Display? IF
35 :     dup f@ scratch represent 0=
36 :     IF 2drop scratch 3 min 0 .string
37 :     ELSE
38 :     IF '- cemit THEN 1-
39 :     scratch over c@ cemit '. cemit 1 /string 0 .string
40 :     'E cemit
41 :     dup abs 0 <# #S rot sign #> 0 .string bl cemit
42 :     THEN THEN
43 :     float+ ;
44 :    
45 :     : c-f@local#
46 :     Display? IF
47 :     S" f@local" 0 .string
48 :     dup @ dup 1 floats / abs 0 <# #S rot sign #> 0 .string bl cemit
49 :     THEN
50 :     cell+ ;
51 :    
52 :     : c-laddr#
53 :     Display? IF
54 :     S" laddr# " 0 .string
55 :     dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
56 :     THEN
57 :     cell+ ;
58 :    
59 :     : c-lp+!#
60 :     Display? IF
61 :     S" lp+!# " 0 .string
62 :     dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
63 :     THEN
64 :     cell+ ;
65 :    
66 :     create c-extend1
67 :     ' @local# A, ' c-@local# A,
68 : anton 1.7 [ifdef] flit ' flit A, ' c-flit A, [then]
69 : pazsan 1.1 ' f@local# A, ' c-f@local# A,
70 :     ' laddr# A, ' c-laddr# A,
71 :     ' lp+!# A, ' c-lp+!# A,
72 : pazsan 1.9 ' ?branch-lp+!# A, ' c-?branch-lp+!# A,
73 :     ' branch-lp+!# A, ' c-branch-lp+!# A,
74 :     ' (loop)-lp+!# A, ' c-loop-lp+!# A,
75 :     ' (+loop)-lp+!# A, ' c-loop-lp+!# A,
76 :     ' (s+loop)-lp+!# A, ' c-loop-lp+!# A,
77 :     ' (-loop)-lp+!# A, ' c-loop-lp+!# A,
78 :     ' (next)-lp+!# A, ' c-loop-lp+!# A,
79 : pazsan 1.1 0 , here 0 ,
80 :    
81 :     \ extend see-table
82 : anton 1.4 c-extend1 c-extender @ a!
83 : pazsan 1.1 c-extender !

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help