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 */
23 STGFUN(stopPerformIODirectReturn)
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
34 We just tidy up the register stuff (real regs in *_SAVE, then
35 *_SAVE -> smInfo locs).
39 /* Pop off saved C stack pointer */
40 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
45 #if defined(__STG_GCC_REGS__)
46 SaveAllStgRegs(); /* inline! */
52 /* Grimily restore C stack pointer */
53 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
54 __asm__ volatile ("mov %0,%%esp" : "m=" (SAVE_esp));
57 RESUME_(miniInterpretEnd);
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.
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
79 /* ptr to a closure (should be of type @IO_Int#@) which the C-world
80 has gotten hold of (hopefully via @MakeStablePtr#@).
83 ED_RO_(realWorldZh_closure);
85 STGFUN(startPerformIO)
89 /* At this point we are in the threaded-code world.
91 unstable_Closure points to a closure of type PrimIO (),
92 which should be performed (by applying it to the
95 The main stg register dump is assumed to be up to date,
96 and is used to load the STG registers.
99 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
100 __asm__ volatile ("mov %%esp,%0" : "=m" (SAVE_esp));
103 /* Load up the real registers from the *_SAVE locns. */
104 RestoreAllStgRegs(); /* inline! */
106 /* ------- STG registers are now valid! -------------------------*/
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*/);
112 STK_CHK(LivenessReg,0/*A*/,1, 0, 0, 0/*prim*/, 0/*re-enter*/);
115 /* Put a suitable return address on the B stack */
116 RetReg = (StgRetAddr) UNVEC(stopPerformIODirectReturn,vtbl_stopPerformIO);
118 /* Save away C stack pointer so that we can restore it when we leave
124 /* Put a World State Token on the B stack */
125 /* This is necessary because we've not unboxed it (to reveal a void) yet */
127 *SpB = (W_) realWorldZh_closure;
129 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
131 InfoPtr=(D_)(INFO_PTR(Node));
132 JMP_(ENTRY_CODE(InfoPtr));
138 StgInt enterInt_Result;
140 STGFUN(stopEnterIntDirectReturn)
143 enterInt_Result = R1.i;
145 #if defined(__STG_GCC_REGS__)
146 SaveAllStgRegs(); /* inline! */
152 JMP_(miniInterpretEnd);
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.
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
173 STGFUN(startEnterInt)
177 /* Load up the real registers from the *_SAVE locns. */
178 #if defined(__STG_GCC_REGS__)
179 RestoreAllStgRegs(); /* inline! */
185 /* ------- STG registers are now valid! -------------------------*/
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 */
191 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
193 InfoPtr=(D_)(INFO_PTR(Node));
194 JMP_(ENTRY_CODE(InfoPtr));
201 StgInt enterFloat_Result;
203 STGFUN(stopEnterFloatDirectReturn)
206 enterFloat_Result = R1.f;
208 #if defined(__STG_GCC_REGS__)
209 SaveAllStgRegs(); /* inline! */
215 JMP_(miniInterpretEnd);
219 /* usual comment about the mangler (hack...) */
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
232 STGFUN(startEnterFloat)
236 /* Load up the real registers from the *_SAVE locns. */
237 #if defined(__STG_GCC_REGS__)
238 RestoreAllStgRegs(); /* inline! */
244 /* ------- STG registers are now valid! -------------------------*/
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 */
250 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
252 InfoPtr=(D_)(INFO_PTR(Node));
253 JMP_(ENTRY_CODE(InfoPtr));