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 | ||
887ce75a | 102 | define vmstackinit |
ff1592a1 AW |
103 | set $vmsp=sp |
104 | set $vmstack_base=stack_base | |
105 | set $vmfp=fp | |
106 | set $vmbp=bp | |
107 | set $vmframe=0 | |
887ce75a AW |
108 | end |
109 | ||
110 | define nextframe | |
111 | set $orig_vmsp=$vmsp | |
112 | while $vmsp > $vmstack_base | |
113 | output $orig_vmsp - $vmsp | |
ff1592a1 | 114 | sputs "\t" |
ff1592a1 AW |
115 | output $vmsp |
116 | sputs "\t" | |
117 | gwrite *$vmsp | |
118 | set $vmsp=$vmsp-1 | |
887ce75a AW |
119 | end |
120 | newline | |
121 | sputs "Frame " | |
122 | output $vmframe | |
123 | newline | |
124 | sputs "ra:\t" | |
125 | output $vmsp | |
126 | sputs "\t" | |
127 | output (SCM*)*$vmsp | |
128 | set $vmsp=$vmsp-1 | |
129 | newline | |
130 | sputs "mvra:\t" | |
131 | output $vmsp | |
132 | sputs "\t" | |
133 | output (SCM*)*$vmsp | |
134 | set $vmsp=$vmsp-1 | |
135 | newline | |
136 | sputs "dl:\t" | |
137 | output $vmsp | |
138 | sputs "\t" | |
139 | set $vmdl=(SCM*)(*$vmsp) | |
140 | output $vmdl | |
141 | newline | |
142 | set $vmsp=$vmsp-1 | |
143 | sputs "hl:\t" | |
144 | output $vmsp | |
145 | sputs "\t" | |
146 | gwrite *$vmsp | |
147 | set $vmsp=$vmsp-1 | |
148 | sputs "el:\t" | |
149 | output $vmsp | |
150 | sputs "\t" | |
151 | gwrite *$vmsp | |
152 | set $vmsp=$vmsp-1 | |
153 | set $vmnlocs=(int)$vmbp->nlocs | |
154 | while $vmnlocs > 0 | |
155 | sputs "loc #" | |
156 | output $vmnlocs | |
157 | sputs ":\t" | |
ff1592a1 AW |
158 | output $vmsp |
159 | sputs "\t" | |
160 | gwrite *$vmsp | |
161 | set $vmsp=$vmsp-1 | |
887ce75a AW |
162 | set $vmnlocs=$vmnlocs-1 |
163 | end | |
164 | set $vmnargs=(int)$vmbp->nargs | |
165 | while $vmnargs > 0 | |
166 | sputs "arg #" | |
167 | output $vmnargs | |
168 | sputs ":\t" | |
ff1592a1 AW |
169 | output $vmsp |
170 | sputs "\t" | |
171 | gwrite *$vmsp | |
172 | set $vmsp=$vmsp-1 | |
887ce75a AW |
173 | set $vmnargs=$vmnargs-1 |
174 | end | |
175 | sputs "prog:\t" | |
176 | output $vmsp | |
177 | sputs "\t" | |
178 | gwrite *$vmsp | |
179 | set $vmsp=$vmsp-1 | |
180 | newline | |
181 | if !$vmdl | |
182 | loop_break | |
183 | end | |
184 | set $vmfp=$vmdl | |
185 | set $vmbp=(struct scm_program*)(((SCM*)($vmfp[-1]))[1]) | |
186 | set $vmstack_base=$vmfp+$vmbp->nargs+$vmbp->nlocs+4 | |
187 | set $vmframe=$vmframe+1 | |
188 | newline | |
189 | end | |
190 | ||
191 | define vmstack | |
192 | vmstackinit | |
193 | while $vmsp > vp->stack_base | |
194 | nextframe | |
ff1592a1 AW |
195 | end |
196 | end |