Commit | Line | Data |
---|---|---|
ff1592a1 AW |
1 | define newline |
2 | call (void)scm_newline (scm_current_error_port ()) | |
3 | end | |
4 | ||
5 | define gdisplay | |
6 | call (void)scm_display ($arg0, scm_current_error_port ()) | |
7 | newline | |
8 | end | |
9 | ||
10 | define gwrite | |
11 | call (void)scm_write ($arg0, scm_current_error_port ()) | |
12 | newline | |
13 | end | |
14 | ||
15 | define sputs | |
16 | call (void)scm_puts ($arg0, scm_current_error_port ()) | |
17 | end | |
18 | ||
19 | define gslot | |
20 | print ((SCM**)$arg0)[1][$arg1] | |
21 | end | |
22 | ||
23 | define pslot | |
24 | gslot $arg0 $arg1 | |
25 | gwrite $ | |
26 | end | |
27 | ||
28 | define lforeach | |
29 | set $l=$arg0 | |
30 | while $l != 0x404 | |
31 | set $x=scm_car($l) | |
32 | $arg1 $x | |
33 | set $l = scm_cdr($l) | |
34 | end | |
35 | end | |
36 | ||
37 | define modsum | |
38 | modname $arg0 | |
39 | gslot $arg0 1 | |
40 | set $uses=$ | |
41 | output "uses:\n" | |
42 | lforeach $uses modname | |
43 | end | |
44 | ||
45 | define moduses | |
46 | pslot $arg0 1 | |
47 | end | |
48 | ||
49 | define modname | |
50 | pslot $arg0 5 | |
51 | end | |
52 | ||
53 | define modkind | |
54 | pslot $arg0 6 | |
55 | end | |
56 | ||
57 | define car | |
58 | call scm_car ($arg0) | |
59 | end | |
60 | ||
61 | define cdr | |
62 | call scm_cdr ($arg0) | |
63 | end | |
64 | ||
65 | define smobwordtox | |
66 | set $x=((SCM*)$arg0)[$arg1] | |
67 | end | |
68 | ||
69 | define smobdatatox | |
70 | smobwordtox $arg0 1 | |
71 | end | |
72 | ||
73 | define program | |
74 | smobdatatox $arg0 | |
75 | p *(struct scm_program*)$x | |
76 | end | |
77 | ||
78 | define proglocals | |
79 | set $i=bp->nlocs | |
80 | while $i > 0 | |
81 | set $i=$i-1 | |
82 | gwrite fp[bp->nargs+$i] | |
83 | end | |
84 | end | |
85 | ||
86 | define progstack | |
87 | set $x=sp | |
88 | while $x > stack_base | |
89 | gwrite *$x | |
90 | set $x=$x-1 | |
91 | end | |
92 | end | |
93 | ||
94 | define tc16 | |
95 | p ((scm_t_bits)$arg0) & 0xffff | |
96 | end | |
97 | ||
98 | define smobdescriptor | |
99 | p scm_smobs[0xff & (((scm_t_bits)$arg0) >> 8)] | |
100 | end | |
101 | ||
102 | define vmstack | |
103 | set $vmsp=sp | |
104 | set $vmstack_base=stack_base | |
105 | set $vmfp=fp | |
106 | set $vmbp=bp | |
107 | set $vmframe=0 | |
108 | while $vmsp > vp->stack_base | |
109 | set $orig_vmsp=$vmsp | |
110 | while $vmsp > $vmstack_base | |
111 | output $orig_vmsp - $vmsp | |
112 | sputs "\t" | |
113 | output $vmsp | |
114 | sputs "\t" | |
115 | gwrite *$vmsp | |
116 | set $vmsp=$vmsp-1 | |
117 | end | |
118 | newline | |
119 | sputs "Frame " | |
120 | output $vmframe | |
121 | newline | |
122 | sputs "ra:\t" | |
123 | output $vmsp | |
124 | sputs "\t" | |
125 | output (SCM*)*$vmsp | |
126 | set $vmsp=$vmsp-1 | |
127 | newline | |
128 | sputs "mvra:\t" | |
129 | output $vmsp | |
130 | sputs "\t" | |
131 | output (SCM*)*$vmsp | |
132 | set $vmsp=$vmsp-1 | |
133 | newline | |
134 | sputs "dl:\t" | |
135 | output $vmsp | |
136 | sputs "\t" | |
137 | set $vmdl=(SCM*)(*$vmsp) | |
138 | output $vmdl | |
139 | newline | |
140 | set $vmsp=$vmsp-1 | |
141 | sputs "hl:\t" | |
142 | output $vmsp | |
143 | sputs "\t" | |
144 | gwrite *$vmsp | |
145 | set $vmsp=$vmsp-1 | |
146 | sputs "el:\t" | |
147 | output $vmsp | |
148 | sputs "\t" | |
149 | gwrite *$vmsp | |
150 | set $vmsp=$vmsp-1 | |
151 | set $vmnlocs=(int)$vmbp->nlocs | |
152 | while $vmnlocs > 0 | |
153 | sputs "loc #" | |
154 | output $vmnlocs | |
155 | sputs ":\t" | |
156 | output $vmsp | |
157 | sputs "\t" | |
158 | gwrite *$vmsp | |
159 | set $vmsp=$vmsp-1 | |
160 | set $vmnlocs=$vmnlocs-1 | |
161 | end | |
162 | set $vmnargs=(int)$vmbp->nargs | |
163 | while $vmnargs > 0 | |
164 | sputs "arg #" | |
165 | output $vmnargs | |
166 | sputs ":\t" | |
167 | output $vmsp | |
168 | sputs "\t" | |
169 | gwrite *$vmsp | |
170 | set $vmsp=$vmsp-1 | |
171 | set $vmnargs=$vmnargs-1 | |
172 | end | |
173 | sputs "prog:\t" | |
174 | output $vmsp | |
175 | sputs "\t" | |
176 | gwrite *$vmsp | |
177 | set $vmsp=$vmsp-1 | |
178 | newline | |
179 | if !$vmdl | |
180 | loop_break | |
181 | end | |
182 | set $vmfp=$vmdl | |
183 | set $vmbp=(struct scm_program*)(((SCM*)($vmfp[-1]))[1]) | |
184 | set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4 | |
185 | set $vmframe=$vmframe+1 | |
186 | newline | |
187 | end | |
188 | end |