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 STGFUN(stopPerformIODirectReturn)
  19 {
  20     FUNBEGIN;
  21     /* The final exit.
  22
  23        The top-top-level closures (e.g., "main") are of type "PrimIO ()".
  24        When entered, they perform an IO action and return a () --
  25        essentially, TagReg is set to 1.  Here, we don't need to do
  26        anything with that.
  27
  28        We just tidy up the register stuff (real regs in *_SAVE, then
  29        *_SAVE -> smInfo locs).
  30     */
  31
  32 #if defined(__STG_GCC_REGS__)
  33     SaveAllStgRegs();   /* inline! */
  34 #else
  35     SAVE_Hp    = Hp;
  36     SAVE_HpLim = HpLim;
  37 #endif
  38
  39     JMP_(miniInterpretEnd);
  40     FUNEND;
  41 }
  42
  43 /*
  44    NB: For direct returns to work properly, the name of the routine must be
  45    the same as the name of the vector table with vtbl_ removed and DirectReturn
  46    appended.  This is all the mangler understands.
  47 */
  48
  49 const W_ vtbl_stopPerformIO[] = {
  50   /* at least "MAX_VECTORED_RTN" elements (see GhcConstants.lh) */
  51   (W_) stopPerformIODirectReturn,
  52   (W_) stopPerformIODirectReturn,
  53   (W_) stopPerformIODirectReturn,
  54   (W_) stopPerformIODirectReturn,
  55   (W_) stopPerformIODirectReturn,
  56   (W_) stopPerformIODirectReturn,
  57   (W_) stopPerformIODirectReturn,
  58   (W_) stopPerformIODirectReturn
  59 };
  60
  61 /* ptr to a closure (should be of type @IO_Int#@) which the C-world
  62    has gotten hold of (hopefully via @MakeStablePtr#@).
  63 */
  64 P_ unstable_Closure;
  65 ED_RO_(WorldStateToken_closure);
  66
  67 STGFUN(startPerformIO)
  68 {
  69     FUNBEGIN;
  70
  71     /* At this point we are in the threaded-code world.
  72
  73        io points to a closure of type IO (), which should be
  74        performed (by applying it to the state of the world).
  75
  76        The main stg register dump is assumed to be up to date, and is
  77        used to load the STG registers.
  78     */
  79
  80 #if defined (DO_SPAT_PROFILING)
  81     SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns */
  82 #endif
  83
  84     /* Load up the real registers from the *_SAVE locns.
  85     */
  86     RestoreAllStgRegs();        /* inline! */
  87
  88     /* ------- STG registers are now valid! -------------------------*/
  89
  90     /* NB: To work properly with concurrent threads (on a uniprocessor,
  91        where stable pointers still make some sense), there must be a
  92        stack overflow check here!  --JSM
  93      */
  94
  95     /* Put a suitable return address on the B stack */
  96     RetReg = (StgRetAddr) UNVEC(stopPerformIODirectReturn,vtbl_stopPerformIO);
  97
  98     /* Put a World State Token on the A stack */
  99     /* This is necessary because we've not unboxed it (to reveal a void) yet */
 100     SpA -= AREL(1);
 101     *SpA = (P_) WorldStateToken_closure;
 102
 103     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 104     ENT_VIA_NODE();
 105     InfoPtr=(D_)(INFO_PTR(Node));
 106     JMP_(ENTRY_CODE(InfoPtr));
 107     FUNEND;
 108 }
 109 \end{code}
 110
 111 \begin{code}
 112 StgInt enterInt_Result;
 113
 114 STGFUN(stopEnterIntDirectReturn)
 115 {
 116     FUNBEGIN;
 117     enterInt_Result = R1.i;
 118
 119 #if defined(__STG_GCC_REGS__)
 120     SaveAllStgRegs();   /* inline! */
 121 #else
 122     SAVE_Hp    = Hp;
 123     SAVE_HpLim = HpLim;
 124 #endif
 125
 126     JMP_(miniInterpretEnd);
 127     FUNEND;
 128 }
 129
 130 /*
 131    NB: For direct returns to work properly, the name of the routine must be
 132    the same as the name of the vector table with vtbl_ removed and DirectReturn
 133    appended.  This is all the mangler understands.
 134 */
 135
 136 const W_ vtbl_stopEnterInt[] = {
 137   (W_) stopEnterIntDirectReturn,
 138   (W_) stopEnterIntDirectReturn,
 139   (W_) stopEnterIntDirectReturn,
 140   (W_) stopEnterIntDirectReturn,
 141   (W_) stopEnterIntDirectReturn,
 142   (W_) stopEnterIntDirectReturn,
 143   (W_) stopEnterIntDirectReturn,
 144   (W_) stopEnterIntDirectReturn
 145 };
 146
 147 STGFUN(startEnterInt)
 148 {
 149     FUNBEGIN;
 150
 151 #if defined (DO_SPAT_PROFILING)
 152     SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */
 153 #endif
 154
 155     /* Load up the real registers from the *_SAVE locns. */
 156 #if defined(__STG_GCC_REGS__)
 157     RestoreAllStgRegs();        /* inline! */
 158 #else
 159     Hp    = SAVE_Hp;
 160     HpLim = SAVE_HpLim;
 161 #endif
 162
 163     /* ------- STG registers are now valid! -------------------------*/
 164
 165     /* Put a suitable return address on the B stack */
 166     SpB  -= BREL(1);    /* Allocate a word for the return address */
 167     *SpB = (W_) UNVEC(stopEnterIntDirectReturn,vtbl_stopEnterInt); /* Push return vector */
 168
 169     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 170     ENT_VIA_NODE();
 171     InfoPtr=(D_)(INFO_PTR(Node));
 172     JMP_(ENTRY_CODE(InfoPtr));
 173     FUNEND;
 174 }
 175 \end{code}
 176
 177
 178 \begin{code}
 179 StgInt enterFloat_Result;
 180
 181 STGFUN(stopEnterFloatDirectReturn)
 182 {
 183     FUNBEGIN;
 184     enterFloat_Result = R1.f;
 185
 186 #if defined(__STG_GCC_REGS__)
 187     SaveAllStgRegs();   /* inline! */
 188 #else
 189     SAVE_Hp    = Hp;
 190     SAVE_HpLim = HpLim;
 191 #endif
 192
 193     JMP_(miniInterpretEnd);
 194     FUNEND;
 195 }
 196
 197 /* usual comment about the mangler (hack...) */
 198
 199 const W_ vtbl_stopEnterFloat[] = {
 200   (W_) stopEnterFloatDirectReturn,
 201   (W_) stopEnterFloatDirectReturn,
 202   (W_) stopEnterFloatDirectReturn,
 203   (W_) stopEnterFloatDirectReturn,
 204   (W_) stopEnterFloatDirectReturn,
 205   (W_) stopEnterFloatDirectReturn,
 206   (W_) stopEnterFloatDirectReturn,
 207   (W_) stopEnterFloatDirectReturn
 208 };
 209
 210 STGFUN(startEnterFloat)
 211 {
 212     FUNBEGIN;
 213
 214 #if defined (DO_SPAT_PROFILING)
 215     SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */
 216 #endif
 217
 218     /* Load up the real registers from the *_SAVE locns. */
 219 #if defined(__STG_GCC_REGS__)
 220     RestoreAllStgRegs();        /* inline! */
 221 #else
 222     Hp    = SAVE_Hp;
 223     HpLim = SAVE_HpLim;
 224 #endif
 225
 226     /* ------- STG registers are now valid! -------------------------*/
 227
 228     /* Put a suitable return address on the B stack */
 229     SpB  -= BREL(1);    /* Allocate a word for the return address */
 230     *SpB = (W_) UNVEC(stopEnterFloatDirectReturn,vtbl_stopEnterFloat); /* Push return vector */
 231
 232     Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
 233     ENT_VIA_NODE();
 234     InfoPtr=(D_)(INFO_PTR(Node));
 235     JMP_(ENTRY_CODE(InfoPtr));
 236     FUNEND;
 237 }
 238 \end{code}
 239
 240
 241 \begin{code}
 242 #endif /* ! PAR */
 243 \end{code}
 244