ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.2 1998/12/02 13:28:50 simonm Exp $
   3  *
   4  * STG-to-C glue.  Some architectures have this code written in
   5  * straight assembler (see StgRun.S), some in C.
   6  *
   7  * -------------------------------------------------------------------------- */
   8
   9 /* include Stg.h first because we want real machine regs in here: we
  10  * have to get the value of R1 back from Stg land to C land intact.
  11  */
  12 #include "Stg.h"
  13 #include "Rts.h"
  14 #include "StgRun.h"
  15
  16 #ifdef DEBUG
  17 #include "RtsFlags.h"
  18 #include "RtsUtils.h"
  19 #include "Printer.h"
  20 #endif
  21
  22 #ifdef USE_MINIINTERPRETER
  23
  24 /* -----------------------------------------------------------------------------
  25    any architecture (using miniinterpreter)
  26    -------------------------------------------------------------------------- */
  27
  28 /* The static @jmp_environment@ variable allows @miniInterpret@ to
  29  * communicate with @StgReturn@.
  30  *
  31  * Because @StgRun@ may be used recursively, we carefully
  32  * save and restore the whole of @jmp_environment@.
  33  */
  34 #include <setjmp.h>
  35 #include <string.h> /* for memcpy */
  36
  37 static jmp_buf jmp_environment;
  38
  39 extern StgThreadReturnCode StgRun(StgFunPtr f)
  40 {
  41     jmp_buf save_buf;
  42     /* Save jmp_environment for previous call to miniInterpret  */
  43     memcpy((void *) jmp_environment, (void *) save_buf, sizeof(jmp_buf));
  44     if (setjmp(jmp_environment) == 0) {
  45         while ( 1 ) {
  46             IF_DEBUG(evaluator,
  47                      fprintf(stderr,"Jumping to ");
  48                      printPtr((P_)f);
  49                      fprintf(stderr,"\n");
  50                      );
  51             f = (StgFunPtr) (f)();
  52         }
  53     }
  54     /* Restore jmp_environment for previous call */
  55     memcpy((void*) save_buf, (void*) jmp_environment, sizeof(jmp_buf));
  56
  57     return (StgThreadReturnCode)R1.i;
  58 }
  59
  60 EXTFUN(StgReturn)
  61 {
  62     longjmp(jmp_environment, 1);
  63 }
  64
  65 #else /* !USE_MINIINTERPRETER */
  66
  67 #ifdef LEADING_UNDERSCORE
  68 #define STG_RETURN "_StgReturn"
  69 #else
  70 #define STG_RETURN "StgReturn"
  71 #endif
  72
  73 /* -----------------------------------------------------------------------------
  74    sparc architecture
  75    -------------------------------------------------------------------------- */
  76
  77 #ifdef sparc_TARGET_ARCH
  78
  79 StgThreadReturnCode
  80 StgRun(StgFunPtr f) {
  81
  82     StgChar space[RESERVED_C_STACK_BYTES+sizeof(void *)];
  83     register void *i7 __asm__("%i7");
  84     ((void **)(space))[100] = i7;
  85     f();
  86     __asm__ volatile (".align 4\n"
  87             ".global " STG_RETURN "\n"
  88             STG_RETURN ":\n"
  89             "\tld %1,%0" : "=r" (i7) : "m" (((void **)(space))[100]));
  90     return (StgThreadReturnCode)R1.i;
  91 }
  92
  93 #endif
  94
  95 /* -----------------------------------------------------------------------------
  96    alpha architecture
  97    -------------------------------------------------------------------------- */
  98
  99 #ifdef alpha_TARGET_ARCH
 100
 101 StgThreadReturnCode
 102 StgRun(StgFunPtr f)
 103 {
 104     __asm__ volatile ("stq $9,-8($30)\n\t"
 105                       "stq $10,-16($30)\n\t"
 106                       "stq $11,-24($30)\n\t"
 107                       "stq $12,-32($30)\n\t"
 108                       "stq $13,-40($30)\n\t"
 109                       "stq $14,-48($30)\n\t"
 110                       "stq $15,-56($30)\n\t"
 111                       "stt $f2,-64($30)\n\t"
 112                       "stt $f3,-72($30)\n\t"
 113                       "stt $f4,-80($30)\n\t"
 114                       "stt $f5,-88($30)\n\t"
 115                       "stt $f6,-96($30)\n\t"
 116                       "stt $f7,-104($30)\n\t"
 117                       "stt $f8,-112($30)\n\t"
 118                       "stt $f9,-120($30)\n\t"
 119                       "lda $30,-%0($30)" : :
 120                       "K" (RESERVED_C_STACK_BYTES+
 121                            8*sizeof(double)+8*sizeof(long)));
 122
 123     f();
 124
 125     __asm__ volatile (".align 3\n"
 126                       ".globl " STG_RETURN "\n"
 127                       STG_RETURN ":\n\t"
 128                       "lda $30,%0($30)\n\t"
 129                       "ldq $9,-8($30)\n\t"
 130                       "ldq $10,-16($30)\n\t"
 131                       "ldq $11,-24($30)\n\t"
 132                       "ldq $12,-32($30)\n\t"
 133                       "ldq $13,-40($30)\n\t"
 134                       "ldq $14,-48($30)\n\t"
 135                       "ldq $15,-56($30)\n\t"
 136                       "ldt $f2,-64($30)\n\t"
 137                       "ldt $f3,-72($30)\n\t"
 138                       "ldt $f4,-80($30)\n\t"
 139                       "ldt $f5,-88($30)\n\t"
 140                       "ldt $f6,-96($30)\n\t"
 141                       "ldt $f7,-104($30)\n\t"
 142                       "ldt $f8,-112($30)\n\t"
 143                       "ldt $f9,-120($30)" : :
 144                       "K" (RESERVED_C_STACK_BYTES+
 145                            8*sizeof(double)+8*sizeof(long)));
 146
 147     return (StgThreadReturnCode)R1.i;
 148 }
 149
 150 #endif /* sparc_TARGET_ARCH */
 151
 152 #endif /* !USE_MINIINTERPRETER */