ghc/runtime/c-as-asm/PerformIO.lhc

   1 %/****************************************************************
   2 %*                                                              *
   3 \section[adr-performIO]{PerformIO --- part of the Foreign Language Extension}
   4 %*                                                              *
   5 %****************************************************************/
   6
   7 The following is heavily based on code in
   8 @runtime/main/StgStartup.lhc@.
   9
  10 \begin{code}
  11 #ifndef PAR
  12
  13 #define MAIN_REG_MAP        /* STG world */
  14 #include "rtsdefs.h"
  15 \end{code}
  16
  17 \begin{code}
  18 #if 0
  19 I_ CStackDelta;
  20 #endif
  21 W_ SAVE_esp;
  22
  23 STGFUN(stopPerformIODirectReturn)
  24 {
  25     FUNBEGIN;
  26
  27     /* The final exit.
  28
  29        The top-top-level closures (e.g., "main") are of type "PrimIO ()".
  30        When entered, they perform an IO action and return a () --
  31        essentially, TagReg is set to 1.  Here, we don't need to do
  32        anything with that.
  33
  34        We just tidy up the register stuff (real regs in *_SAVE, then
  35        *_SAVE -> smInfo locs).
  36
  37     */
  38
  39     /* Pop off saved C stack pointer */
  40 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
  41     SAVE_esp = (W_)*SpB;
  42     SpB = SpB - 1;
  43 #endif
  44
  45 #if defined(__STG_GCC_REGS__)
  46     SaveAllStgRegs();   /* inline! */
  47 #else
  48     SAVE_Hp    = Hp;
  49     SAVE_HpLim = HpLim;
  50 #endif
  51
  52     /* Grimily restore C stack pointer */
  53 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
  54     __asm__ volatile ("mov %0,%%esp" : "m=" (SAVE_esp));
  55 #endif
  56
  57     RESUME_(miniInterpretEnd);
  58     FUNEND;
  59 }
  60
  61 /*
  62    NB: For direct returns to work properly, the name of the routine must be
  63    the same as the name of the vector table with vtbl_ removed and DirectReturn
  64    appended.  This is all the mangler understands.
  65 */
  66
  67 const W_ vtbl_stopPerformIO[] = {
  68   /* at least "MAX_VECTORED_RTN" elements (see GhcConstants.lh) */
  69   (W_) stopPerformIODirectReturn,
  70   (W_) stopPerformIODirectReturn,
  71   (W_) stopPerformIODirectReturn,
  72   (W_) stopPerformIODirectReturn,
  73   (W_) stopPerformIODirectReturn,
  74   (W_) stopPerformIODirectReturn,
  75   (W_) stopPerformIODirectReturn,
  76   (W_) stopPerformIODirectReturn
  77 };
  78
  79 /* ptr to a closure (should be of type @IO_Int#@) which the C-world
  80    has gotten hold of (hopefully via @MakeStablePtr#@).
  81 */
  82 P_ unstable_Closure;
  83 ED_RO_(WorldStateToken_closure);
  84
  85 STGFUN(startPerformIO)
  86 {
  87     FUNBEGIN;
  88
  89     /* At this point we are in the threaded-code world.
  90
  91        unstable_Closure points to a closure of type PrimIO (),
  92        which should be performed (by applying it to the
  93        state of the world).
  94
  95        The main stg register dump is assumed to be up to date,
  96        and is used to load the STG registers.
  97     */
  98
  99 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
 100     __asm__ volatile ("mov %%esp,%0" : "=m" (SAVE_esp));
 101 #endif
 102
 103     /* Load up the real registers from the *_SAVE locns. */
 104     RestoreAllStgRegs();        /* inline! */
 105
 106     /* ------- STG registers are now valid! -------------------------*/
 107
 108     /* first off, check for stk space.. */
 109 #if defined(CONCURRENT) || !defined(STACK_CHECK_BY_PAGE_FAULT)
 110     STK_CHK(LivenessReg,1/*A*/,1/*B*/, 0, 0, 0/*prim*/, 0/*re-enter*/);
 111 #else
 112     STK_CHK(LivenessReg,1/*A*/,0, 0, 0, 0/*prim*/, 0/*re-enter*/);
 113 #endif
 114
 115     /* Put a suitable return address on the B stack */
 116     RetReg = (StgRetAddr) UNVEC(stopPerformIODirectReturn,vtbl_stopPerformIO);
 117
 118     /* Put a World State Token on the A stack */
 119     /* This is necessary because we've not unboxed it (to reveal a void) yet */
 120     SpA -= AREL(1);
 121     *SpA = (P_) WorldStateToken_closure;
 122
 123     /* Save away C stack pointer so that we can restore it when we leave
 124        the Haskell world.
 125     */
 126     SpB[1] = (W_)SAVE_esp;
 127     SpB    = SpB + 1;
 128
 129     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 130     ENT_VIA_NODE();
 131     InfoPtr=(D_)(INFO_PTR(Node));
 132     JMP_(ENTRY_CODE(InfoPtr));
 133     FUNEND;
 134 }
 135 \end{code}
 136
 137 \begin{code}
 138 StgInt enterInt_Result;
 139
 140 STGFUN(stopEnterIntDirectReturn)
 141 {
 142     FUNBEGIN;
 143     enterInt_Result = R1.i;
 144
 145 #if defined(__STG_GCC_REGS__)
 146     SaveAllStgRegs();   /* inline! */
 147 #else
 148     SAVE_Hp    = Hp;
 149     SAVE_HpLim = HpLim;
 150 #endif
 151
 152     JMP_(miniInterpretEnd);
 153     FUNEND;
 154 }
 155
 156 /*
 157    NB: For direct returns to work properly, the name of the routine must be
 158    the same as the name of the vector table with vtbl_ removed and DirectReturn
 159    appended.  This is all the mangler understands.
 160 */
 161
 162 const W_ vtbl_stopEnterInt[] = {
 163   (W_) stopEnterIntDirectReturn,
 164   (W_) stopEnterIntDirectReturn,
 165   (W_) stopEnterIntDirectReturn,
 166   (W_) stopEnterIntDirectReturn,
 167   (W_) stopEnterIntDirectReturn,
 168   (W_) stopEnterIntDirectReturn,
 169   (W_) stopEnterIntDirectReturn,
 170   (W_) stopEnterIntDirectReturn
 171 };
 172
 173 STGFUN(startEnterInt)
 174 {
 175     FUNBEGIN;
 176
 177     /* Load up the real registers from the *_SAVE locns. */
 178 #if defined(__STG_GCC_REGS__)
 179     RestoreAllStgRegs();        /* inline! */
 180 #else
 181     Hp    = SAVE_Hp;
 182     HpLim = SAVE_HpLim;
 183 #endif
 184
 185     /* ------- STG registers are now valid! -------------------------*/
 186
 187     /* Put a suitable return address on the B stack */
 188     SpB  -= BREL(1);    /* Allocate a word for the return address */
 189     *SpB = (W_) UNVEC(stopEnterIntDirectReturn,vtbl_stopEnterInt); /* Push return vector */
 190
 191     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 192     ENT_VIA_NODE();
 193     InfoPtr=(D_)(INFO_PTR(Node));
 194     JMP_(ENTRY_CODE(InfoPtr));
 195     FUNEND;
 196 }
 197 \end{code}
 198
 199
 200 \begin{code}
 201 StgInt enterFloat_Result;
 202
 203 STGFUN(stopEnterFloatDirectReturn)
 204 {
 205     FUNBEGIN;
 206     enterFloat_Result = R1.f;
 207
 208 #if defined(__STG_GCC_REGS__)
 209     SaveAllStgRegs();   /* inline! */
 210 #else
 211     SAVE_Hp    = Hp;
 212     SAVE_HpLim = HpLim;
 213 #endif
 214
 215     JMP_(miniInterpretEnd);
 216     FUNEND;
 217 }
 218
 219 /* usual comment about the mangler (hack...) */
 220
 221 const W_ vtbl_stopEnterFloat[] = {
 222   (W_) stopEnterFloatDirectReturn,
 223   (W_) stopEnterFloatDirectReturn,
 224   (W_) stopEnterFloatDirectReturn,
 225   (W_) stopEnterFloatDirectReturn,
 226   (W_) stopEnterFloatDirectReturn,
 227   (W_) stopEnterFloatDirectReturn,
 228   (W_) stopEnterFloatDirectReturn,
 229   (W_) stopEnterFloatDirectReturn
 230 };
 231
 232 STGFUN(startEnterFloat)
 233 {
 234     FUNBEGIN;
 235
 236     /* Load up the real registers from the *_SAVE locns. */
 237 #if defined(__STG_GCC_REGS__)
 238     RestoreAllStgRegs();        /* inline! */
 239 #else
 240     Hp    = SAVE_Hp;
 241     HpLim = SAVE_HpLim;
 242 #endif
 243
 244     /* ------- STG registers are now valid! -------------------------*/
 245
 246     /* Put a suitable return address on the B stack */
 247     SpB  -= BREL(1);    /* Allocate a word for the return address */
 248     *SpB = (W_) UNVEC(stopEnterFloatDirectReturn,vtbl_stopEnterFloat); /* Push return vector */
 249
 250     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 251     ENT_VIA_NODE();
 252     InfoPtr=(D_)(INFO_PTR(Node));
 253     JMP_(ENTRY_CODE(InfoPtr));
 254     FUNEND;
 255 }
 256 \end{code}
 257
 258
 259 \begin{code}
 260 #endif /* ! PAR */
 261 \end{code}
 262