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
121 #if defined(CONCURRENT) && defined(i386_TARGET_ARCH)
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 */
129 *SpB = (W_) realWorldZh_closure;
131 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
133 InfoPtr=(D_)(INFO_PTR(Node));
134 JMP_(ENTRY_CODE(InfoPtr));
140 StgInt enterInt_Result;
142 STGFUN(stopEnterIntDirectReturn)
145 enterInt_Result = R1.i;
147 #if defined(__STG_GCC_REGS__)
148 SaveAllStgRegs(); /* inline! */
154 JMP_(miniInterpretEnd);
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.
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
175 STGFUN(startEnterInt)
179 /* Load up the real registers from the *_SAVE locns. */
180 #if defined(__STG_GCC_REGS__)
181 RestoreAllStgRegs(); /* inline! */
187 /* ------- STG registers are now valid! -------------------------*/
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 */
193 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
195 InfoPtr=(D_)(INFO_PTR(Node));
196 JMP_(ENTRY_CODE(InfoPtr));
203 StgInt enterFloat_Result;
205 STGFUN(stopEnterFloatDirectReturn)
208 enterFloat_Result = R1.f;
210 #if defined(__STG_GCC_REGS__)
211 SaveAllStgRegs(); /* inline! */
217 JMP_(miniInterpretEnd);
221 /* usual comment about the mangler (hack...) */
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
234 STGFUN(startEnterFloat)
238 /* Load up the real registers from the *_SAVE locns. */
239 #if defined(__STG_GCC_REGS__)
240 RestoreAllStgRegs(); /* inline! */
246 /* ------- STG registers are now valid! -------------------------*/
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 */
252 Node = unstable_Closure; /* Point to the closure for main/errorIO-arg */
254 InfoPtr=(D_)(INFO_PTR(Node));
255 JMP_(ENTRY_CODE(InfoPtr));