1 /* ----------------------------------------------------------------------------
2 * $Id: RtsAPI.c,v 1.3 1999/01/27 14:51:21 simonpj Exp $
4 * API for invoking Haskell functions via the RTS
6 * --------------------------------------------------------------------------*/
14 /* ----------------------------------------------------------------------------
15 Building Haskell objects from C datatypes.
16 ------------------------------------------------------------------------- */
20 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
21 p->header.info = &Czh_con_info;
22 p->payload[0] = (StgClosure *)((StgInt)c);
29 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
30 p->header.info = &Izh_con_info;
31 p->payload[0] = (StgClosure *)(StgInt)i;
38 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
39 /* This is a 'cheat', using the static info table for Ints,
40 instead of the one for Int8, but the types have identical
43 p->header.info = &Izh_con_info;
44 /* Make sure we mask out the bits above the lowest 8 */
45 p->payload[0] = (StgClosure *)(StgInt)((unsigned)i & 0xff);
52 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
53 /* This is a 'cheat', using the static info table for Ints,
54 instead of the one for Int8, but the types have identical
57 p->header.info = &Izh_con_info;
58 /* Make sure we mask out the relevant bits */
59 p->payload[0] = (StgClosure *)(StgInt)((unsigned)i & 0xffff);
66 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
67 /* see mk_Int8 comment */
68 p->header.info = &Izh_con_info;
69 p->payload[0] = (StgClosure *)(StgInt)i;
74 rts_mkInt64 (long long int i)
77 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2));
78 /* see mk_Int8 comment */
79 p->header.info = &I64zh_con_info;
80 tmp = (long long*)&(p->payload[0]);
86 rts_mkWord (unsigned int i)
88 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
89 p->header.info = &Wzh_con_info;
90 p->payload[0] = (StgClosure *)(StgWord)i;
95 rts_mkWord8 (unsigned int w)
97 /* see rts_mkInt* comments */
98 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
99 p->header.info = &Wzh_con_info;
100 p->payload[0] = (StgClosure *)(StgWord)(w & 0xff);
105 rts_mkWord16 (unsigned int w)
107 /* see rts_mkInt* comments */
108 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
109 p->header.info = &Wzh_con_info;
110 p->payload[0] = (StgClosure *)(StgWord)(w & 0xffff);
115 rts_mkWord32 (unsigned int w)
117 /* see rts_mkInt* comments */
118 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
119 p->header.info = &Wzh_con_info;
120 p->payload[0] = (StgClosure *)(StgWord)w;
125 rts_mkWord64 (unsigned long long w)
127 unsigned long long *tmp;
128 extern StgInfoTable W64zh_con_info;
130 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,2));
131 /* see mk_Int8 comment */
132 p->header.info = &W64zh_con_info;
133 tmp = (unsigned long long*)&(p->payload[0]);
139 rts_mkFloat (float f)
141 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,1));
142 p->header.info = &Fzh_con_info;
143 ASSIGN_FLT((P_)p->payload, (StgFloat)f);
148 rts_mkDouble (double d)
150 StgClosure *p = (StgClosure *)allocate(CONSTR_sizeW(0,sizeofW(StgDouble)));
151 p->header.info = &Dzh_con_info;
152 ASSIGN_DBL((P_)p->payload, (StgDouble)d);
157 rts_mkStablePtr (StgStablePtr s)
159 StgClosure *p = (StgClosure *)allocate(sizeofW(StgHeader)+1);
160 p->header.info = &StablePtr_con_info;
161 p->payload[0] = (StgClosure *)s;
168 StgClosure *p = (StgClosure *)allocate(sizeofW(StgHeader)+1);
169 p->header.info = &Azh_con_info;
170 p->payload[0] = (StgClosure *)a;
174 #ifdef COMPILER /* GHC has em, Hugs doesn't */
179 return (StgClosure *)&True_closure;
181 return (StgClosure *)&False_closure;
186 rts_mkString (char *s)
188 return rts_apply((StgClosure *)&unpackCString_closure, rts_mkAddr(s));
192 rts_apply (HaskellObj f, HaskellObj arg)
194 StgAP_UPD *ap = (StgAP_UPD *)allocate(AP_sizeW(1));
195 ap->header.info = &AP_UPD_info;
198 ap->payload[0] = (P_)arg;
199 return (StgClosure *)ap;
201 #endif /* COMPILER */
203 /* ----------------------------------------------------------------------------
204 Deconstructing Haskell objects
205 ------------------------------------------------------------------------- */
208 rts_getChar (HaskellObj p)
210 if (p->header.info == &Czh_con_info || p->header.info == &Czh_static_info) {
211 return (char)(StgWord)(p->payload[0]);
213 barf("getChar: not a Char");
218 rts_getInt (HaskellObj p)
220 if (p->header.info == &Izh_con_info || p->header.info == &Izh_static_info) {
221 return (int)(p->payload[0]);
223 barf("getInt: not an Int");
228 rts_getWord (HaskellObj p)
230 if (p->header.info == &Wzh_con_info || p->header.info == &Wzh_static_info) {
231 return (unsigned int)(p->payload[0]);
233 barf("getWord: not a Word");
238 rts_getFloat (HaskellObj p)
240 if (p->header.info == &Fzh_con_info || p->header.info == &Fzh_static_info) {
241 return (float)(PK_FLT((P_)p->payload));
243 barf("getFloat: not a Float");
248 rts_getDouble (HaskellObj p)
250 if (p->header.info == &Dzh_con_info || p->header.info == &Dzh_static_info) {
251 return (double)(PK_DBL((P_)p->payload));
253 barf("getDouble: not a Double");
258 rts_getStablePtr (HaskellObj p)
260 if (p->header.info == &StablePtr_con_info ||
261 p->header.info == &StablePtr_static_info) {
262 return (StgStablePtr)(p->payload[0]);
264 barf("getStablePtr: not a StablePtr");
269 rts_getAddr (HaskellObj p)
271 if (p->header.info == &Azh_con_info || p->header.info == &Azh_static_info) {
272 return (void *)(p->payload[0]);
274 barf("getAddr: not an Addr");
278 #ifdef COMPILER /* GHC has em, Hugs doesn't */
280 rts_getBool (HaskellObj p)
282 if (p == &True_closure) {
284 } else if (p == &False_closure) {
287 barf("getBool: not a Bool");
290 #endif /* COMPILER */
292 /* ----------------------------------------------------------------------------
293 Evaluating Haskell expressions
294 ------------------------------------------------------------------------- */
296 rts_eval (HaskellObj p, /*out*/HaskellObj *ret)
298 StgTSO *tso = createGenThread(RtsFlags.GcFlags.initialStkSize, p);
299 return schedule(tso, ret);
303 rts_eval_ (HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret)
305 StgTSO *tso = createGenThread(stack_size, p);
306 return schedule(tso, ret);
310 rts_evalIO (HaskellObj p, /*out*/HaskellObj *ret)
312 StgTSO *tso = createIOThread(RtsFlags.GcFlags.initialStkSize, p);
313 return schedule(tso, ret);
317 rts_evalIO_ (HaskellObj p, unsigned int stack_size, /*out*/HaskellObj *ret)
319 StgTSO *tso = createIOThread(stack_size, p);
320 return schedule(tso, ret);
323 /* Convenience function for decoding the returned status. */
325 void rts_checkSchedStatus ( char* site, SchedulerStatus rc )
327 if ( rc == Success ) {
330 barf("%s: Return code (%d) not ok",(site),(rc));