ghc/rts/StgCRun.c

   1 /* -----------------------------------------------------------------------------
   2  * $Id: StgCRun.c,v 1.9 1999/12/01 14:20:11 simonmar 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 extern StgThreadReturnCode StgRun(StgFunPtr f, StgRegTable *basereg)
  72 {
  73     char* nm;
  74     while ( f ) {
  75
  76 #if 0
  77       //IF_DEBUG(evaluator,
  78                 fprintf(stderr,"Jumping to ");
  79                 nm = nameOfObjSym ( f );
  80                 if (nm)
  81                    fprintf(stderr, "%s (%p)", nm, f); else
  82                    printPtr((P_)f);
  83                 fprintf(stderr,"\n");
  84                 //         );
  85 if (0&& MainRegTable.rSp) {
  86    int i;
  87    StgWord* p = MainRegTable.rSp;
  88 fprintf(stderr, "SP = %p\n", p);
  89    p += (8-1);
  90    for (i = 0; i < 8; i++, p--)
  91       fprintf (stderr, "-- %p: %p\n", p, *p );
  92 }
  93 #endif
  94
  95        f = (StgFunPtr) (f)();
  96     }
  97
  98     return (StgThreadReturnCode)R1.i;
  99 }
 100
 101 EXTFUN(StgReturn)
 102 {
 103    return 0;
 104 }
 105 #endif
 106
 107
 108
 109 #else /* !USE_MINIINTERPRETER */
 110
 111 #ifdef LEADING_UNDERSCORE
 112 #define STG_RETURN "_StgReturn"
 113 #else
 114 #define STG_RETURN "StgReturn"
 115 #endif
 116
 117 /* -----------------------------------------------------------------------------
 118    sparc architecture
 119    -------------------------------------------------------------------------- */
 120
 121 #ifdef sparc_TARGET_ARCH
 122
 123 StgThreadReturnCode
 124 StgRun(StgFunPtr f, StgRegTable *basereg) {
 125
 126     StgChar space[RESERVED_C_STACK_BYTES+sizeof(void *)];
 127     register void *i7 __asm__("%i7");
 128     ((void **)(space))[100] = i7;
 129     f();
 130     __asm__ volatile (".align 4\n"
 131             ".global " STG_RETURN "\n"
 132             STG_RETURN ":\n"
 133             "\tld %1,%0" : "=r" (i7) : "m" (((void **)(space))[100]));
 134     return (StgThreadReturnCode)R1.i;
 135 }
 136
 137 #endif
 138
 139 /* -----------------------------------------------------------------------------
 140    alpha architecture
 141    -------------------------------------------------------------------------- */
 142
 143 #ifdef alpha_TARGET_ARCH
 144
 145 StgThreadReturnCode
 146 StgRun(StgFunPtr f, StgRegTable *basereg)
 147 {
 148     StgThreadReturnCode ret;
 149
 150     __asm__ volatile ("stq $9,-8($30)\n\t"
 151                       "stq $10,-16($30)\n\t"
 152                       "stq $11,-24($30)\n\t"
 153                       "stq $12,-32($30)\n\t"
 154                       "stq $13,-40($30)\n\t"
 155                       "stq $14,-48($30)\n\t"
 156                       "stq $15,-56($30)\n\t"
 157                       "stt $f2,-64($30)\n\t"
 158                       "stt $f3,-72($30)\n\t"
 159                       "stt $f4,-80($30)\n\t"
 160                       "stt $f5,-88($30)\n\t"
 161                       "stt $f6,-96($30)\n\t"
 162                       "stt $f7,-104($30)\n\t"
 163                       "stt $f8,-112($30)\n\t"
 164                       "stt $f9,-120($30)\n\t"
 165                       "lda $30,-%0($30)" : :
 166                       "K" (RESERVED_C_STACK_BYTES+
 167                            8*sizeof(double)+8*sizeof(long)));
 168
 169     f();
 170
 171     __asm__ volatile (".align 3\n"
 172                       ".globl " STG_RETURN "\n"
 173                       STG_RETURN ":\n\t"
 174                       "lda %0,($14)\n\t"  /* save R1 */
 175                       "lda $30,%0($30)\n\t"
 176                       "ldq $9,-8($30)\n\t"
 177                       "ldq $10,-16($30)\n\t"
 178                       "ldq $11,-24($30)\n\t"
 179                       "ldq $12,-32($30)\n\t"
 180                       "ldq $13,-40($30)\n\t"
 181                       "ldq $14,-48($30)\n\t"
 182                       "ldq $15,-56($30)\n\t"
 183                       "ldt $f2,-64($30)\n\t"
 184                       "ldt $f3,-72($30)\n\t"
 185                       "ldt $f4,-80($30)\n\t"
 186                       "ldt $f5,-88($30)\n\t"
 187                       "ldt $f6,-96($30)\n\t"
 188                       "ldt $f7,-104($30)\n\t"
 189                       "ldt $f8,-112($30)\n\t"
 190                       "ldt $f9,-120($30)"
 191                       : "=r" (ret)
 192                       : "K" (RESERVED_C_STACK_BYTES+
 193                            8*sizeof(double)+8*sizeof(long)));
 194
 195     return ret;
 196 }
 197
 198 #endif /* alpha_TARGET_ARCH */
 199
 200 /* -----------------------------------------------------------------------------
 201    HP-PA architecture
 202    -------------------------------------------------------------------------- */
 203
 204 #ifdef hppa1_1_TARGET_ARCH
 205
 206 StgThreadReturnCode
 207 StgRun(StgFunPtr f, StgRegTable *basereg)
 208 {
 209     StgChar space[RESERVED_C_STACK_BYTES+16*sizeof(long)+10*sizeof(double)];
 210     StgThreadReturnCode ret;
 211
 212     __asm__ volatile ("ldo %0(%%r30),%%r19\n"
 213                       "\tstw %%r3, 0(0,%%r19)\n"
 214                       "\tstw %%r4, 4(0,%%r19)\n"
 215                       "\tstw %%r5, 8(0,%%r19)\n"
 216                       "\tstw %%r6,12(0,%%r19)\n"
 217                       "\tstw %%r7,16(0,%%r19)\n"
 218                       "\tstw %%r8,20(0,%%r19)\n"
 219                       "\tstw %%r9,24(0,%%r19)\n"
 220                       "\tstw %%r10,28(0,%%r19)\n"
 221                       "\tstw %%r11,32(0,%%r19)\n"
 222                       "\tstw %%r12,36(0,%%r19)\n"
 223                       "\tstw %%r13,40(0,%%r19)\n"
 224                       "\tstw %%r14,44(0,%%r19)\n"
 225                       "\tstw %%r15,48(0,%%r19)\n"
 226                       "\tstw %%r16,52(0,%%r19)\n"
 227                       "\tstw %%r17,56(0,%%r19)\n"
 228                       "\tstw %%r18,60(0,%%r19)\n"
 229                       "\tldo 80(%%r19),%%r19\n"
 230                       "\tfstds %%fr12,-16(0,%%r19)\n"
 231                       "\tfstds %%fr13, -8(0,%%r19)\n"
 232                       "\tfstds %%fr14,  0(0,%%r19)\n"
 233                       "\tfstds %%fr15,  8(0,%%r19)\n"
 234                       "\tldo 32(%%r19),%%r19\n"
 235                       "\tfstds %%fr16,-16(0,%%r19)\n"
 236                       "\tfstds %%fr17, -8(0,%%r19)\n"
 237                       "\tfstds %%fr18,  0(0,%%r19)\n"
 238                       "\tfstds %%fr19,  8(0,%%r19)\n"
 239                       "\tldo 32(%%r19),%%r19\n"
 240                       "\tfstds %%fr20,-16(0,%%r19)\n"
 241                       "\tfstds %%fr21, -8(0,%%r19)\n" : :
 242                       "n" (-(116 * sizeof(long) + 10 * sizeof(double))) : "%r19"
 243                       );
 244
 245     f();
 246
 247     __asm__ volatile (".align 4\n"
 248                       "\t.EXPORT " STG_RETURN ",CODE\n"
 249                       "\t.EXPORT " STG_RETURN ",ENTRY,PRIV_LEV=3\n"
 250                       STG_RETURN "\n"
 251                       /* "\tldo %0(%%r3),%%r19\n" */
 252                       "\tldo %1(%%r30),%%r19\n"
 253                       "\tcopy %%r11, %0\n"  /* save R1 */
 254                       "\tldw  0(0,%%r19),%%r3\n"
 255                       "\tldw  4(0,%%r19),%%r4\n"
 256                       "\tldw  8(0,%%r19),%%r5\n"
 257                       "\tldw 12(0,%%r19),%%r6\n"
 258                       "\tldw 16(0,%%r19),%%r7\n"
 259                       "\tldw 20(0,%%r19),%%r8\n"
 260                       "\tldw 24(0,%%r19),%%r9\n"
 261                       "\tldw 28(0,%%r19),%%r10\n"
 262                       "\tldw 32(0,%%r19),%%r11\n"
 263                       "\tldw 36(0,%%r19),%%r12\n"
 264                       "\tldw 40(0,%%r19),%%r13\n"
 265                       "\tldw 44(0,%%r19),%%r14\n"
 266                       "\tldw 48(0,%%r19),%%r15\n"
 267                       "\tldw 52(0,%%r19),%%r16\n"
 268                       "\tldw 56(0,%%r19),%%r17\n"
 269                       "\tldw 60(0,%%r19),%%r18\n"
 270                       "\tldo 80(%%r19),%%r19\n"
 271                       "\tfldds -16(0,%%r19),%%fr12\n"
 272                       "\tfldds  -8(0,%%r19),%%fr13\n"
 273                       "\tfldds   0(0,%%r19),%%fr14\n"
 274                       "\tfldds   8(0,%%r19),%%fr15\n"
 275                       "\tldo 32(%%r19),%%r19\n"
 276                       "\tfldds -16(0,%%r19),%%fr16\n"
 277                       "\tfldds  -8(0,%%r19),%%fr17\n"
 278                       "\tfldds   0(0,%%r19),%%fr18\n"
 279                       "\tfldds   8(0,%%r19),%%fr19\n"
 280                       "\tldo 32(%%r19),%%r19\n"
 281                       "\tfldds -16(0,%%r19),%%fr20\n"
 282                       "\tfldds  -8(0,%%r19),%%fr21\n"
 283                          : "=r" (ret)
 284                          : "n" (-(116 * sizeof(long) + 10 * sizeof(double)))
 285                          : "%r19"
 286                       );
 287
 288     return ret;
 289 }
 290
 291 #endif /* hppa1_1_TARGET_ARCH */
 292
 293 #endif /* !USE_MINIINTERPRETER */