1: \ see-ext.fs extentions for see locals, floats
2:
3: \ made extra 26jan97jaw
4:
5: : c-loop-lp+!# c-loop cell+ ;
6: : c-?branch-lp+!# c-?branch cell+ ;
7: : c-branch-lp+!# c-branch cell+ ;
8:
9: : c-@local#
10: Display? IF
11: S" @local" 0 .string
12: dup @ dup 1 cells / abs 0 <# #S rot sign #> 0 .string bl cemit
13: THEN
14: cell+ ;
15:
16: : c-flit
17: Display? IF
18: dup f@ scratch represent 0=
19: IF 2drop scratch 3 min 0 .string
20: ELSE
21: IF '- cemit THEN 1-
22: scratch over c@ cemit '. cemit 1 /string 0 .string
23: 'E cemit
24: dup abs 0 <# #S rot sign #> 0 .string bl cemit
25: THEN THEN
26: float+ ;
27:
28: : c-f@local#
29: Display? IF
30: S" f@local" 0 .string
31: dup @ dup 1 floats / abs 0 <# #S rot sign #> 0 .string bl cemit
32: THEN
33: cell+ ;
34:
35: : c-laddr#
36: Display? IF
37: S" laddr# " 0 .string
38: dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
39: THEN
40: cell+ ;
41:
42: : c-lp+!#
43: Display? IF
44: S" lp+!# " 0 .string
45: dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
46: THEN
47: cell+ ;
48:
49: create c-extend1
50: ' @local# A, ' c-@local# A,
51: ' flit A, ' c-flit A,
52: ' f@local# A, ' c-f@local# A,
53: ' laddr# A, ' c-laddr# A,
54: ' lp+!# A, ' c-lp+!# A,
55: ' ?branch-lp+!# A, ' c-?branch-lp+!# A,
56: ' branch-lp+!# A, ' c-branch-lp+!# A,
57: ' (loop)-lp+!# A, ' c-loop-lp+!# A,
58: ' (+loop)-lp+!# A, ' c-loop-lp+!# A,
59: ' (s+loop)-lp+!# A, ' c-loop-lp+!# A,
60: ' (-loop)-lp+!# A, ' c-loop-lp+!# A,
61: ' (next)-lp+!# A, ' c-loop-lp+!# A,
62: 0 , here 0 ,
63:
64: \ extend see-table
65: c-extender @
66: c-extend1 over a!
67: c-extender !
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>