1 /* -----------------------------------------------------------------------------
2 * $Id: StgCRun.c,v 1.11 2000/02/15 13:16:20 sewardj Exp $
4 * (c) The GHC Team, 1998-1999
6 * STG-to-C glue. Some architectures have this code written in
7 * straight assembler (see StgRun.S), some in C.
9 * -------------------------------------------------------------------------- */
11 /* include Stg.h first because we want real machine regs in here: we
12 * have to get the value of R1 back from Stg land to C land intact.
24 #ifdef USE_MINIINTERPRETER
26 /* -----------------------------------------------------------------------------
27 any architecture (using miniinterpreter)
28 -------------------------------------------------------------------------- */
30 /* The static @jmp_environment@ variable allows @miniInterpret@ to
31 * communicate with @StgReturn@.
33 * Because @StgRun@ may be used recursively, we carefully
34 * save and restore the whole of @jmp_environment@.
37 #include <string.h> /* for memcpy */
39 static jmp_buf jmp_environment;
43 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
46 /* Save jmp_environment for previous call to miniInterpret */
47 memcpy((void *) jmp_environment, (void *) save_buf, sizeof(jmp_buf));
48 if (setjmp(jmp_environment) == 0) {
51 fprintf(stderr,"Jumping to ");
55 f = (StgFunPtr) (f)();
58 /* Restore jmp_environment for previous call */
59 memcpy((void*) save_buf, (void*) jmp_environment, sizeof(jmp_buf));
61 return (StgThreadReturnCode)R1.i;
66 longjmp(jmp_environment, 1);
71 static void scanStackSeg ( W_* ptr, int nwords )
78 fprintf ( stderr, "%d",w ); nwords--; ptr++;
79 while (w) { fprintf(stderr, "_"); w--; nwords--; ptr++; }
86 if (nwords < 0) fprintf(stderr, "erk: nwords < 0\n");
87 checkStackChunk ( ptr, ptr-nwords0 );
91 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
96 #define STACK_DETAILS 0
101 StgWord* sp = basereg->rSp;
102 StgWord* su = basereg->rSu;
103 StgTSO* tso = basereg->rCurrentTSO;
104 StgWord* sb = tso->stack + tso->stack_size;
107 fprintf(stderr, "== SP = %p SU = %p\n", sp,su);
109 if (su >= sb) goto postloop;
110 if (!sp || !su) goto postloop;
112 //printStack ( sp, sb, su);
116 switch (get_itbl((StgClosure*)su)->type) {
119 fprintf(stderr, "S%d ",ws);
120 fprintf(stderr, "\n");
124 fprintf(stderr,"U%d ",ws);
125 sp = su + sizeofW(StgUpdateFrame);
126 su = ((StgUpdateFrame*)su)->link;
130 fprintf(stderr,"Q%d ",ws);
131 sp = su + sizeofW(StgSeqFrame);
132 su = ((StgSeqFrame*)su)->link;
136 fprintf(stderr,"C%d ",ws);
137 sp = su + sizeofW(StgCatchFrame);
138 su = ((StgCatchFrame*)su)->link;
141 fprintf(stderr, "?\nweird record on stack\n");
150 fprintf(stderr,"\n");
152 fprintf(stderr,"-- enter: ");
153 nm = nameFromOPtr ( f );
155 fprintf(stderr, "%s (%p)", nm, f); else
157 fprintf ( stderr, "\n");
159 fprintf(stderr,"\n");
161 f = (StgFunPtr) (f)();
164 fprintf (stderr, "miniInterpreter: bye!\n\n" );
165 return (StgThreadReturnCode)R1.i;
176 #else /* !USE_MINIINTERPRETER */
178 #ifdef LEADING_UNDERSCORE
179 #define STG_RETURN "_StgReturn"
181 #define STG_RETURN "StgReturn"
184 /* -----------------------------------------------------------------------------
186 -------------------------------------------------------------------------- */
188 #ifdef sparc_TARGET_ARCH
191 StgRun(StgFunPtr f, StgRegTable *basereg) {
193 StgChar space[RESERVED_C_STACK_BYTES+sizeof(void *)];
194 register void *i7 __asm__("%i7");
195 ((void **)(space))[100] = i7;
197 __asm__ volatile (".align 4\n"
198 ".global " STG_RETURN "\n"
200 "\tld %1,%0" : "=r" (i7) : "m" (((void **)(space))[100]));
201 return (StgThreadReturnCode)R1.i;
206 /* -----------------------------------------------------------------------------
208 -------------------------------------------------------------------------- */
210 #ifdef alpha_TARGET_ARCH
213 StgRun(StgFunPtr f, StgRegTable *basereg)
215 StgThreadReturnCode ret;
217 __asm__ volatile ("stq $9,-8($30)\n\t"
218 "stq $10,-16($30)\n\t"
219 "stq $11,-24($30)\n\t"
220 "stq $12,-32($30)\n\t"
221 "stq $13,-40($30)\n\t"
222 "stq $14,-48($30)\n\t"
223 "stq $15,-56($30)\n\t"
224 "stt $f2,-64($30)\n\t"
225 "stt $f3,-72($30)\n\t"
226 "stt $f4,-80($30)\n\t"
227 "stt $f5,-88($30)\n\t"
228 "stt $f6,-96($30)\n\t"
229 "stt $f7,-104($30)\n\t"
230 "stt $f8,-112($30)\n\t"
231 "stt $f9,-120($30)\n\t"
232 "lda $30,-%0($30)" : :
233 "K" (RESERVED_C_STACK_BYTES+
234 8*sizeof(double)+8*sizeof(long)));
238 __asm__ volatile (".align 3\n"
239 ".globl " STG_RETURN "\n"
241 "lda %0,($14)\n\t" /* save R1 */
242 "lda $30,%0($30)\n\t"
244 "ldq $10,-16($30)\n\t"
245 "ldq $11,-24($30)\n\t"
246 "ldq $12,-32($30)\n\t"
247 "ldq $13,-40($30)\n\t"
248 "ldq $14,-48($30)\n\t"
249 "ldq $15,-56($30)\n\t"
250 "ldt $f2,-64($30)\n\t"
251 "ldt $f3,-72($30)\n\t"
252 "ldt $f4,-80($30)\n\t"
253 "ldt $f5,-88($30)\n\t"
254 "ldt $f6,-96($30)\n\t"
255 "ldt $f7,-104($30)\n\t"
256 "ldt $f8,-112($30)\n\t"
259 : "K" (RESERVED_C_STACK_BYTES+
260 8*sizeof(double)+8*sizeof(long)));
265 #endif /* alpha_TARGET_ARCH */
267 /* -----------------------------------------------------------------------------
269 -------------------------------------------------------------------------- */
271 #ifdef hppa1_1_TARGET_ARCH
274 StgRun(StgFunPtr f, StgRegTable *basereg)
276 StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
277 StgThreadReturnCode ret;
279 __asm__ volatile ("ldo %0(%%r30),%%r19\n"
280 "\tstw %%r3, 0(0,%%r19)\n"
281 "\tstw %%r4, 4(0,%%r19)\n"
282 "\tstw %%r5, 8(0,%%r19)\n"
283 "\tstw %%r6,12(0,%%r19)\n"
284 "\tstw %%r7,16(0,%%r19)\n"
285 "\tstw %%r8,20(0,%%r19)\n"
286 "\tstw %%r9,24(0,%%r19)\n"
287 "\tstw %%r10,28(0,%%r19)\n"
288 "\tstw %%r11,32(0,%%r19)\n"
289 "\tstw %%r12,36(0,%%r19)\n"
290 "\tstw %%r13,40(0,%%r19)\n"
291 "\tstw %%r14,44(0,%%r19)\n"
292 "\tstw %%r15,48(0,%%r19)\n"
293 "\tstw %%r16,52(0,%%r19)\n"
294 "\tstw %%r17,56(0,%%r19)\n"
295 "\tstw %%r18,60(0,%%r19)\n"
296 "\tldo 80(%%r19),%%r19\n"
297 "\tfstds %%fr12,-16(0,%%r19)\n"
298 "\tfstds %%fr13, -8(0,%%r19)\n"
299 "\tfstds %%fr14, 0(0,%%r19)\n"
300 "\tfstds %%fr15, 8(0,%%r19)\n"
301 "\tldo 32(%%r19),%%r19\n"
302 "\tfstds %%fr16,-16(0,%%r19)\n"
303 "\tfstds %%fr17, -8(0,%%r19)\n"
304 "\tfstds %%fr18, 0(0,%%r19)\n"
305 "\tfstds %%fr19, 8(0,%%r19)\n"
306 "\tldo 32(%%r19),%%r19\n"
307 "\tfstds %%fr20,-16(0,%%r19)\n"
308 "\tfstds %%fr21, -8(0,%%r19)\n" : :
309 "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
314 __asm__ volatile (".align 4\n"
315 "\t.EXPORT " STG_RETURN ",CODE\n"
316 "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
318 /* "\tldo %0(%%r3),%%r19\n" */
319 "\tldo %1(%%r30),%%r19\n"
320 "\tcopy %%r11, %0\n" /* save R1 */
321 "\tldw 0(0,%%r19),%%r3\n"
322 "\tldw 4(0,%%r19),%%r4\n"
323 "\tldw 8(0,%%r19),%%r5\n"
324 "\tldw 12(0,%%r19),%%r6\n"
325 "\tldw 16(0,%%r19),%%r7\n"
326 "\tldw 20(0,%%r19),%%r8\n"
327 "\tldw 24(0,%%r19),%%r9\n"
328 "\tldw 28(0,%%r19),%%r10\n"
329 "\tldw 32(0,%%r19),%%r11\n"
330 "\tldw 36(0,%%r19),%%r12\n"
331 "\tldw 40(0,%%r19),%%r13\n"
332 "\tldw 44(0,%%r19),%%r14\n"
333 "\tldw 48(0,%%r19),%%r15\n"
334 "\tldw 52(0,%%r19),%%r16\n"
335 "\tldw 56(0,%%r19),%%r17\n"
336 "\tldw 60(0,%%r19),%%r18\n"
337 "\tldo 80(%%r19),%%r19\n"
338 "\tfldds -16(0,%%r19),%%fr12\n"
339 "\tfldds -8(0,%%r19),%%fr13\n"
340 "\tfldds 0(0,%%r19),%%fr14\n"
341 "\tfldds 8(0,%%r19),%%fr15\n"
342 "\tldo 32(%%r19),%%r19\n"
343 "\tfldds -16(0,%%r19),%%fr16\n"
344 "\tfldds -8(0,%%r19),%%fr17\n"
345 "\tfldds 0(0,%%r19),%%fr18\n"
346 "\tfldds 8(0,%%r19),%%fr19\n"
347 "\tldo 32(%%r19),%%r19\n"
348 "\tfldds -16(0,%%r19),%%fr20\n"
349 "\tfldds -8(0,%%r19),%%fr21\n"
351 : "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
358 #endif /* hppa1_1_TARGET_ARCH */
360 #endif /* !USE_MINIINTERPRETER */