1 %/****************************************************************
3 \section[adr-performIO]{PerformIO --- part of the Foreign Language Extension}
5 %****************************************************************/
7 The following is heavily based on code in
8 @runtime/main/StgStartup.lhc@.
13 #define MAIN_REG_MAP /* STG world */
18 STGFUN(stopPerformIODirectReturn)
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
28 We just tidy up the register stuff (real regs in *_SAVE, then
29 *_SAVE -> smInfo locs).
32 #if defined(__STG_GCC_REGS__)
33 SaveAllStgRegs(); /* inline! */
39 JMP_(miniInterpretEnd);
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.
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
61 /* ptr to a closure (should be of type @IO_Int#@) which the C-world
62 has gotten hold of (hopefully via @MakeStablePtr#@).
65 ED_RO_(WorldStateToken_closure);
67 STGFUN(startPerformIO)
71 /* At this point we are in the threaded-code world.
73 io points to a closure of type IO (), which should be
74 performed (by applying it to the state of the world).
76 The main stg register dump is assumed to be up to date, and is
77 used to load the STG registers.
80 #if defined (DO_SPAT_PROFILING)
81 SET_ACTIVITY(ACT_REDN); /* init: do this first, so we count the restore insns */
84 /* Load up the real registers from the *_SAVE locns.
86 RestoreAllStgRegs(); /* inline! */
88 /* ------- STG registers are now valid! -------------------------*/
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
95 /* Put a suitable return address on the B stack */
96 RetReg = (StgRetAddr) UNVEC(stopPerformIODirectReturn,vtbl_stopPerformIO);
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 */
101 *SpA = (P_) WorldStateToken_closure;
103 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
105 InfoPtr=(D_)(INFO_PTR(Node));
106 JMP_(ENTRY_CODE(InfoPtr));
112 StgInt enterInt_Result;
114 STGFUN(stopEnterIntDirectReturn)
117 enterInt_Result = R1.i;
119 #if defined(__STG_GCC_REGS__)
120 SaveAllStgRegs(); /* inline! */
126 JMP_(miniInterpretEnd);
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.
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
147 STGFUN(startEnterInt)
151 #if defined (DO_SPAT_PROFILING)
152 SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */
155 /* Load up the real registers from the *_SAVE locns. */
156 #if defined(__STG_GCC_REGS__)
157 RestoreAllStgRegs(); /* inline! */
163 /* ------- STG registers are now valid! -------------------------*/
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 */
169 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
171 InfoPtr=(D_)(INFO_PTR(Node));
172 JMP_(ENTRY_CODE(InfoPtr));
179 StgInt enterFloat_Result;
181 STGFUN(stopEnterFloatDirectReturn)
184 enterFloat_Result = R1.f;
186 #if defined(__STG_GCC_REGS__)
187 SaveAllStgRegs(); /* inline! */
193 JMP_(miniInterpretEnd);
197 /* usual comment about the mangler (hack...) */
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
210 STGFUN(startEnterFloat)
214 #if defined (DO_SPAT_PROFILING)
215 SET_ACTIVITY(ACT_REDN); /* init: do this first so we count restore insns */
218 /* Load up the real registers from the *_SAVE locns. */
219 #if defined(__STG_GCC_REGS__)
220 RestoreAllStgRegs(); /* inline! */
226 /* ------- STG registers are now valid! -------------------------*/
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 */
232 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
234 InfoPtr=(D_)(INFO_PTR(Node));
235 JMP_(ENTRY_CODE(InfoPtr));