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_(realWorldZh_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,0/*A*/,2/*B*/, 0, 0, 0/*prim*/, 0/*re-enter*/);
 111 #else
 112     STK_CHK(LivenessReg,0/*A*/,1, 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     /* Save away C stack pointer so that we can restore it when we leave
 119        the Haskell world.
 120     */
 121 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
 122     SpB -= BREL(1);
 123     *SpB = (W_)SAVE_esp;
 124 #endif
 125
 126     /* Put a World State Token on the B stack */
 127     /* This is necessary because we've not unboxed it (to reveal a void) yet */
 128     SpB -= BREL(1);
 129     *SpB = (W_) realWorldZh_closure;
 130
 131     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 132     ENT_VIA_NODE();
 133     InfoPtr=(D_)(INFO_PTR(Node));
 134     JMP_(ENTRY_CODE(InfoPtr));
 135     FUNEND;
 136 }
 137 \end{code}
 138
 139 \begin{code}
 140 StgInt enterInt_Result;
 141
 142 STGFUN(stopEnterIntDirectReturn)
 143 {
 144     FUNBEGIN;
 145     enterInt_Result = R1.i;
 146
 147 #if defined(__STG_GCC_REGS__)
 148     SaveAllStgRegs();   /* inline! */
 149 #else
 150     SAVE_Hp    = Hp;
 151     SAVE_HpLim = HpLim;
 152 #endif
 153
 154     JMP_(miniInterpretEnd);
 155     FUNEND;
 156 }
 157
 158 /*
 159    NB: For direct returns to work properly, the name of the routine must be
 160    the same as the name of the vector table with vtbl_ removed and DirectReturn
 161    appended.  This is all the mangler understands.
 162 */
 163
 164 const W_ vtbl_stopEnterInt[] = {
 165   (W_) stopEnterIntDirectReturn,
 166   (W_) stopEnterIntDirectReturn,
 167   (W_) stopEnterIntDirectReturn,
 168   (W_) stopEnterIntDirectReturn,
 169   (W_) stopEnterIntDirectReturn,
 170   (W_) stopEnterIntDirectReturn,
 171   (W_) stopEnterIntDirectReturn,
 172   (W_) stopEnterIntDirectReturn
 173 };
 174
 175 STGFUN(startEnterInt)
 176 {
 177     FUNBEGIN;
 178
 179     /* Load up the real registers from the *_SAVE locns. */
 180 #if defined(__STG_GCC_REGS__)
 181     RestoreAllStgRegs();        /* inline! */
 182 #else
 183     Hp    = SAVE_Hp;
 184     HpLim = SAVE_HpLim;
 185 #endif
 186
 187     /* ------- STG registers are now valid! -------------------------*/
 188
 189     /* Put a suitable return address on the B stack */
 190     SpB  -= BREL(1);    /* Allocate a word for the return address */
 191     *SpB = (W_) UNVEC(stopEnterIntDirectReturn,vtbl_stopEnterInt); /* Push return vector */
 192
 193     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 194     ENT_VIA_NODE();
 195     InfoPtr=(D_)(INFO_PTR(Node));
 196     JMP_(ENTRY_CODE(InfoPtr));
 197     FUNEND;
 198 }
 199 \end{code}
 200
 201
 202 \begin{code}
 203 StgInt enterFloat_Result;
 204
 205 STGFUN(stopEnterFloatDirectReturn)
 206 {
 207     FUNBEGIN;
 208     enterFloat_Result = R1.f;
 209
 210 #if defined(__STG_GCC_REGS__)
 211     SaveAllStgRegs();   /* inline! */
 212 #else
 213     SAVE_Hp    = Hp;
 214     SAVE_HpLim = HpLim;
 215 #endif
 216
 217     JMP_(miniInterpretEnd);
 218     FUNEND;
 219 }
 220
 221 /* usual comment about the mangler (hack...) */
 222
 223 const W_ vtbl_stopEnterFloat[] = {
 224   (W_) stopEnterFloatDirectReturn,
 225   (W_) stopEnterFloatDirectReturn,
 226   (W_) stopEnterFloatDirectReturn,
 227   (W_) stopEnterFloatDirectReturn,
 228   (W_) stopEnterFloatDirectReturn,
 229   (W_) stopEnterFloatDirectReturn,
 230   (W_) stopEnterFloatDirectReturn,
 231   (W_) stopEnterFloatDirectReturn
 232 };
 233
 234 STGFUN(startEnterFloat)
 235 {
 236     FUNBEGIN;
 237
 238     /* Load up the real registers from the *_SAVE locns. */
 239 #if defined(__STG_GCC_REGS__)
 240     RestoreAllStgRegs();        /* inline! */
 241 #else
 242     Hp    = SAVE_Hp;
 243     HpLim = SAVE_HpLim;
 244 #endif
 245
 246     /* ------- STG registers are now valid! -------------------------*/
 247
 248     /* Put a suitable return address on the B stack */
 249     SpB  -= BREL(1);    /* Allocate a word for the return address */
 250     *SpB = (W_) UNVEC(stopEnterFloatDirectReturn,vtbl_stopEnterFloat); /* Push return vector */
 251
 252     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 253     ENT_VIA_NODE();
 254     InfoPtr=(D_)(INFO_PTR(Node));
 255     JMP_(ENTRY_CODE(InfoPtr));
 256     FUNEND;
 257 }
 258 \end{code}
 259
 260
 261 \begin{code}
 262 #endif /* ! PAR */
 263 \end{code}
 264