ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.3 1999/02/05 16:02:57 simonm 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 extern StgThreadReturnCode StgRun(StgFunPtr f)
  42 {
  43     jmp_buf save_buf;
  44     /* Save jmp_environment for previous call to miniInterpret  */
  45     memcpy((void *) jmp_environment, (void *) save_buf, sizeof(jmp_buf));
  46     if (setjmp(jmp_environment) == 0) {
  47         while ( 1 ) {
  48             IF_DEBUG(evaluator,
  49                      fprintf(stderr,"Jumping to ");
  50                      printPtr((P_)f);
  51                      fprintf(stderr,"\n");
  52                      );
  53             f = (StgFunPtr) (f)();
  54         }
  55     }
  56     /* Restore jmp_environment for previous call */
  57     memcpy((void*) save_buf, (void*) jmp_environment, sizeof(jmp_buf));
  58
  59     return (StgThreadReturnCode)R1.i;
  60 }
  61
  62 EXTFUN(StgReturn)
  63 {
  64     longjmp(jmp_environment, 1);
  65 }
  66
  67 #else /* !USE_MINIINTERPRETER */
  68
  69 #ifdef LEADING_UNDERSCORE
  70 #define STG_RETURN "_StgReturn"
  71 #else
  72 #define STG_RETURN "StgReturn"
  73 #endif
  74
  75 /* -----------------------------------------------------------------------------
  76    sparc architecture
  77    -------------------------------------------------------------------------- */
  78
  79 #ifdef sparc_TARGET_ARCH
  80
  81 StgThreadReturnCode
  82 StgRun(StgFunPtr f) {
  83
  84     StgChar space[RESERVED_C_STACK_BYTES+sizeof(void *)];
  85     register void *i7 __asm__("%i7");
  86     ((void **)(space))[100] = i7;
  87     f();
  88     __asm__ volatile (".align 4\n"
  89             ".global " STG_RETURN "\n"
  90             STG_RETURN ":\n"
  91             "\tld %1,%0" : "=r" (i7) : "m" (((void **)(space))[100]));
  92     return (StgThreadReturnCode)R1.i;
  93 }
  94
  95 #endif
  96
  97 /* -----------------------------------------------------------------------------
  98    alpha architecture
  99    -------------------------------------------------------------------------- */
 100
 101 #ifdef alpha_TARGET_ARCH
 102
 103 StgThreadReturnCode
 104 StgRun(StgFunPtr f)
 105 {
 106     __asm__ volatile ("stq $9,-8($30)\n\t"
 107                       "stq $10,-16($30)\n\t"
 108                       "stq $11,-24($30)\n\t"
 109                       "stq $12,-32($30)\n\t"
 110                       "stq $13,-40($30)\n\t"
 111                       "stq $14,-48($30)\n\t"
 112                       "stq $15,-56($30)\n\t"
 113                       "stt $f2,-64($30)\n\t"
 114                       "stt $f3,-72($30)\n\t"
 115                       "stt $f4,-80($30)\n\t"
 116                       "stt $f5,-88($30)\n\t"
 117                       "stt $f6,-96($30)\n\t"
 118                       "stt $f7,-104($30)\n\t"
 119                       "stt $f8,-112($30)\n\t"
 120                       "stt $f9,-120($30)\n\t"
 121                       "lda $30,-%0($30)" : :
 122                       "K" (RESERVED_C_STACK_BYTES+
 123                            8*sizeof(double)+8*sizeof(long)));
 124
 125     f();
 126
 127     __asm__ volatile (".align 3\n"
 128                       ".globl " STG_RETURN "\n"
 129                       STG_RETURN ":\n\t"
 130                       "lda $30,%0($30)\n\t"
 131                       "ldq $9,-8($30)\n\t"
 132                       "ldq $10,-16($30)\n\t"
 133                       "ldq $11,-24($30)\n\t"
 134                       "ldq $12,-32($30)\n\t"
 135                       "ldq $13,-40($30)\n\t"
 136                       "ldq $14,-48($30)\n\t"
 137                       "ldq $15,-56($30)\n\t"
 138                       "ldt $f2,-64($30)\n\t"
 139                       "ldt $f3,-72($30)\n\t"
 140                       "ldt $f4,-80($30)\n\t"
 141                       "ldt $f5,-88($30)\n\t"
 142                       "ldt $f6,-96($30)\n\t"
 143                       "ldt $f7,-104($30)\n\t"
 144                       "ldt $f8,-112($30)\n\t"
 145                       "ldt $f9,-120($30)" : :
 146                       "K" (RESERVED_C_STACK_BYTES+
 147                            8*sizeof(double)+8*sizeof(long)));
 148
 149     return (StgThreadReturnCode)R1.i;
 150 }
 151
 152 #endif /* sparc_TARGET_ARCH */
 153
 154 #endif /* !USE_MINIINTERPRETER */