ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.4 1999/03/01 17:42:11 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 /* -----------------------------------------------------------------------------
 155    HP-PA architecture
 156    -------------------------------------------------------------------------- */
 157
 158 #ifdef hppa1_1_TARGET_ARCH
 159
 160 StgThreadReturnCode
 161 StgRun(StgFunPtr f)
 162 {
 163     StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
 164     __asm__ volatile ("ldo %0(%%r30),%%r19\n"
 165                       "\tstw %%r3, 0(0,%%r19)\n"
 166                       "\tstw %%r4, 4(0,%%r19)\n"
 167                       "\tstw %%r5, 8(0,%%r19)\n"
 168                       "\tstw %%r6,12(0,%%r19)\n"
 169                       "\tstw %%r7,16(0,%%r19)\n"
 170                       "\tstw %%r8,20(0,%%r19)\n"
 171                       "\tstw %%r9,24(0,%%r19)\n"
 172                       "\tstw %%r10,28(0,%%r19)\n"
 173                       "\tstw %%r11,32(0,%%r19)\n"
 174                       "\tstw %%r12,36(0,%%r19)\n"
 175                       "\tstw %%r13,40(0,%%r19)\n"
 176                       "\tstw %%r14,44(0,%%r19)\n"
 177                       "\tstw %%r15,48(0,%%r19)\n"
 178                       "\tstw %%r16,52(0,%%r19)\n"
 179                       "\tstw %%r17,56(0,%%r19)\n"
 180                       "\tstw %%r18,60(0,%%r19)\n"
 181                       "\tldo 80(%%r19),%%r19\n"
 182                       "\tfstds %%fr12,-16(0,%%r19)\n"
 183                       "\tfstds %%fr13, -8(0,%%r19)\n"
 184                       "\tfstds %%fr14,  0(0,%%r19)\n"
 185                       "\tfstds %%fr15,  8(0,%%r19)\n"
 186                       "\tldo 32(%%r19),%%r19\n"
 187                       "\tfstds %%fr16,-16(0,%%r19)\n"
 188                       "\tfstds %%fr17, -8(0,%%r19)\n"
 189                       "\tfstds %%fr18,  0(0,%%r19)\n"
 190                       "\tfstds %%fr19,  8(0,%%r19)\n"
 191                       "\tldo 32(%%r19),%%r19\n"
 192                       "\tfstds %%fr20,-16(0,%%r19)\n"
 193                       "\tfstds %%fr21, -8(0,%%r19)\n" : :
 194                       "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
 195                       );
 196
 197     f();
 198
 199     __asm__ volatile (".align 4\n"
 200                       "\t.EXPORT " STG_RETURN ",CODE\n"
 201                       "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
 202                       STG_RETURN "\n"
 203                       /* "\tldo %0(%%r3),%%r19\n" */
 204                       "\tldo %0(%%r30),%%r19\n"
 205                       "\tldw  0(0,%%r19),%%r3\n"
 206                       "\tldw  4(0,%%r19),%%r4\n"
 207                       "\tldw  8(0,%%r19),%%r5\n"
 208                       "\tldw 12(0,%%r19),%%r6\n"
 209                       "\tldw 16(0,%%r19),%%r7\n"
 210                       "\tldw 20(0,%%r19),%%r8\n"
 211                       "\tldw 24(0,%%r19),%%r9\n"
 212                       "\tldw 28(0,%%r19),%%r10\n"
 213                       "\tldw 32(0,%%r19),%%r11\n"
 214                       "\tldw 36(0,%%r19),%%r12\n"
 215                       "\tldw 40(0,%%r19),%%r13\n"
 216                       "\tldw 44(0,%%r19),%%r14\n"
 217                       "\tldw 48(0,%%r19),%%r15\n"
 218                       "\tldw 52(0,%%r19),%%r16\n"
 219                       "\tldw 56(0,%%r19),%%r17\n"
 220                       "\tldw 60(0,%%r19),%%r18\n"
 221                       "\tldo 80(%%r19),%%r19\n"
 222                       "\tfldds -16(0,%%r19),%%fr12\n"
 223                       "\tfldds  -8(0,%%r19),%%fr13\n"
 224                       "\tfldds   0(0,%%r19),%%fr14\n"
 225                       "\tfldds   8(0,%%r19),%%fr15\n"
 226                       "\tldo 32(%%r19),%%r19\n"
 227                       "\tfldds -16(0,%%r19),%%fr16\n"
 228                       "\tfldds  -8(0,%%r19),%%fr17\n"
 229                       "\tfldds   0(0,%%r19),%%fr18\n"
 230                       "\tfldds   8(0,%%r19),%%fr19\n"
 231                       "\tldo 32(%%r19),%%r19\n"
 232                       "\tfldds -16(0,%%r19),%%fr20\n"
 233                       "\tfldds  -8(0,%%r19),%%fr21\n" : :
 234                       "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
 235                       );
 236
 237     return (StgThreadReturnCode)R1.i;
 238 }
 239
 240 #endif /* hppa1_1_TARGET_ARCH */
 241
 242 #endif /* !USE_MINIINTERPRETER */