ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.11 2000/02/15 13:16:20 sewardj Exp $
   3  *
   4  * (c) The GHC Team, 1998-1999
   5  *
   6  * STG-to-C glue.  Some architectures have this code written in
   7  * straight assembler (see StgRun.S), some in C.
   8  *
   9  * -------------------------------------------------------------------------- */
  10
  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.
  13  */
  14 #include "Stg.h"
  15 #include "Rts.h"
  16 #include "StgRun.h"
  17
  18 #ifdef DEBUG
  19 #include "RtsFlags.h"
  20 #include "RtsUtils.h"
  21 #include "Printer.h"
  22 #endif
  23
  24 #ifdef USE_MINIINTERPRETER
  25
  26 /* -----------------------------------------------------------------------------
  27    any architecture (using miniinterpreter)
  28    -------------------------------------------------------------------------- */
  29
  30 /* The static @jmp_environment@ variable allows @miniInterpret@ to
  31  * communicate with @StgReturn@.
  32  *
  33  * Because @StgRun@ may be used recursively, we carefully
  34  * save and restore the whole of @jmp_environment@.
  35  */
  36 #include <setjmp.h>
  37 #include <string.h> /* for memcpy */
  38
  39 static jmp_buf jmp_environment;
  40
  41 #if 0
  42
  43 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
  44 {
  45     jmp_buf save_buf;
  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) {
  49         while ( 1 ) {
  50             IF_DEBUG(evaluator,
  51                      fprintf(stderr,"Jumping to ");
  52                      printPtr((P_)f);
  53                      fprintf(stderr,"\n");
  54                      );
  55             f = (StgFunPtr) (f)();
  56         }
  57     }
  58     /* Restore jmp_environment for previous call */
  59     memcpy((void*) save_buf, (void*) jmp_environment, sizeof(jmp_buf));
  60
  61     return (StgThreadReturnCode)R1.i;
  62 }
  63
  64 EXTFUN(StgReturn)
  65 {
  66     longjmp(jmp_environment, 1);
  67 }
  68
  69 #else
  70
  71 static void scanStackSeg ( W_* ptr, int nwords )
  72 {
  73    W_ w;
  74    int nwords0 = nwords;
  75    while (nwords > 0) {
  76       w = *ptr;
  77       if (IS_ARG_TAG(w)) {
  78          fprintf ( stderr, "%d",w ); nwords--; ptr++;
  79          while (w) { fprintf(stderr, "_"); w--; nwords--; ptr++; }
  80       }
  81       else {
  82          fprintf(stderr, "p");
  83          nwords--; ptr++;
  84       }
  85    }
  86    if (nwords < 0) fprintf(stderr, "erk: nwords < 0\n");
  87    checkStackChunk ( ptr, ptr-nwords0 );
  88 }
  89
  90
  91 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
  92 {
  93     char* nm;
  94     while (1) {
  95
  96 #define STACK_DETAILS 0
  97
  98 #if STACK_DETAILS
  99    {
 100    int i;
 101    StgWord* sp  = basereg->rSp;
 102    StgWord* su  = basereg->rSu;
 103    StgTSO*  tso = basereg->rCurrentTSO;
 104    StgWord* sb  = tso->stack + tso->stack_size;
 105    int ws;
 106
 107    fprintf(stderr, "== SP = %p   SU = %p\n", sp,su);
 108
 109    if (su >= sb) goto postloop;
 110    if (!sp || !su) goto postloop;
 111
 112    //printStack ( sp, sb, su);
 113
 114    while (1) {
 115       ws = su - sp;
 116       switch (get_itbl((StgClosure*)su)->type) {
 117          case STOP_FRAME:
 118             scanStackSeg(sp,ws);
 119             fprintf(stderr, "S%d ",ws);
 120             fprintf(stderr, "\n");
 121             goto postloop;
 122          case UPDATE_FRAME:
 123             scanStackSeg(sp,ws);
 124             fprintf(stderr,"U%d ",ws);
 125             sp = su + sizeofW(StgUpdateFrame);
 126             su = ((StgUpdateFrame*)su)->link;
 127             break;
 128          case SEQ_FRAME:
 129             scanStackSeg(sp,ws);
 130             fprintf(stderr,"Q%d ",ws);
 131             sp = su + sizeofW(StgSeqFrame);
 132             su = ((StgSeqFrame*)su)->link;
 133             break;
 134          case CATCH_FRAME:
 135             scanStackSeg(sp,ws);
 136             fprintf(stderr,"C%d ",ws);
 137             sp = su + sizeofW(StgCatchFrame);
 138             su = ((StgCatchFrame*)su)->link;
 139             break;
 140          default:
 141             fprintf(stderr, "?\nweird record on stack\n");
 142             goto postloop;
 143       }
 144    }
 145    postloop:
 146    }
 147 #endif
 148
 149 #if STACK_DETAILS
 150        fprintf(stderr,"\n");
 151 #endif
 152        fprintf(stderr,"-- enter: ");
 153        nm = nameFromOPtr ( f );
 154        if (nm)
 155             fprintf(stderr, "%s (%p)", nm, f); else
 156             printPtr((P_)f);
 157        fprintf ( stderr, "\n");
 158 #if STACK_DETAILS
 159        fprintf(stderr,"\n");
 160 #endif
 161        f = (StgFunPtr) (f)();
 162        if (!f) break;
 163     }
 164     fprintf (stderr, "miniInterpreter: bye!\n\n" );
 165     return (StgThreadReturnCode)R1.i;
 166 }
 167
 168 EXTFUN(StgReturn)
 169 {
 170    return 0;
 171 }
 172 #endif
 173
 174
 175
 176 #else /* !USE_MINIINTERPRETER */
 177
 178 #ifdef LEADING_UNDERSCORE
 179 #define STG_RETURN "_StgReturn"
 180 #else
 181 #define STG_RETURN "StgReturn"
 182 #endif
 183
 184 /* -----------------------------------------------------------------------------
 185    sparc architecture
 186    -------------------------------------------------------------------------- */
 187
 188 #ifdef sparc_TARGET_ARCH
 189
 190 StgThreadReturnCode
 191 StgRun(StgFunPtr f, StgRegTable *basereg) {
 192
 193     StgChar space[RESERVED_C_STACK_BYTES+sizeof(void *)];
 194     register void *i7 __asm__("%i7");
 195     ((void **)(space))[100] = i7;
 196     f();
 197     __asm__ volatile (".align 4\n"
 198             ".global " STG_RETURN "\n"
 199             STG_RETURN ":\n"
 200             "\tld %1,%0" : "=r" (i7) : "m" (((void **)(space))[100]));
 201     return (StgThreadReturnCode)R1.i;
 202 }
 203
 204 #endif
 205
 206 /* -----------------------------------------------------------------------------
 207    alpha architecture
 208    -------------------------------------------------------------------------- */
 209
 210 #ifdef alpha_TARGET_ARCH
 211
 212 StgThreadReturnCode
 213 StgRun(StgFunPtr f, StgRegTable *basereg)
 214 {
 215     StgThreadReturnCode ret;
 216
 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)));
 235
 236     f();
 237
 238     __asm__ volatile (".align 3\n"
 239                       ".globl " STG_RETURN "\n"
 240                       STG_RETURN ":\n\t"
 241                       "lda %0,($14)\n\t"  /* save R1 */
 242                       "lda $30,%0($30)\n\t"
 243                       "ldq $9,-8($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"
 257                       "ldt $f9,-120($30)"
 258                       : "=r" (ret)
 259                       : "K" (RESERVED_C_STACK_BYTES+
 260                            8*sizeof(double)+8*sizeof(long)));
 261
 262     return ret;
 263 }
 264
 265 #endif /* alpha_TARGET_ARCH */
 266
 267 /* -----------------------------------------------------------------------------
 268    HP-PA architecture
 269    -------------------------------------------------------------------------- */
 270
 271 #ifdef hppa1_1_TARGET_ARCH
 272
 273 StgThreadReturnCode
 274 StgRun(StgFunPtr f, StgRegTable *basereg)
 275 {
 276     StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
 277     StgThreadReturnCode ret;
 278
 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"
 310                       );
 311
 312     f();
 313
 314     __asm__ volatile (".align 4\n"
 315                       "\t.EXPORT " STG_RETURN ",CODE\n"
 316                       "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
 317                       STG_RETURN "\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"
 350                          : "=r" (ret)
 351                          : "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
 352                          : "%r19"
 353                       );
 354
 355     return ret;
 356 }
 357
 358 #endif /* hppa1_1_TARGET_ARCH */
 359
 360 #endif /* !USE_MINIINTERPRETER */