2 /* -----------------------------------------------------------------------------
5 * Copyright (c) 1994-2000.
7 * $RCSfile: Interpreter.c,v $
9 * $Date: 2001/01/05 15:24:28 $
10 * ---------------------------------------------------------------------------*/
24 #include "Bytecodes.h"
26 #include "Disassembler.h"
27 #include "Interpreter.h"
30 /* --------------------------------------------------------------------------
31 * The new bytecode interpreter
32 * ------------------------------------------------------------------------*/
34 /* Sp points to the lowest live word on the stack. */
36 #define StackWord(n) iSp[n]
37 #define BCO_NEXT instrs[bciPtr++]
38 #define BCO_PTR(n) (W_)ptrs[n]
39 #define BCO_LIT(n) (W_)literals[n]
40 #define BCO_ITBL(n) itbls[n]
42 #define LOAD_STACK_POINTERS \
43 iSp = cap->rCurrentTSO->sp; iSu = cap->rCurrentTSO->su;
45 #define SAVE_STACK_POINTERS \
46 cap->rCurrentTSO->sp = iSp; cap->rCurrentTSO->su = iSu;
48 #define RETURN(retcode) \
49 SAVE_STACK_POINTERS; return retcode;
52 StgThreadReturnCode interpretBCO ( Capability* cap )
54 /* On entry, the closure to interpret is on the top of the
57 /* Use of register here is primarily to make it clear to compilers
58 that these entities are non-aliasable.
60 register W_* iSp; /* local state -- stack pointer */
61 register StgUpdateFrame* iSu; /* local state -- frame pointer */
62 register StgPtr iSpLim; /* local state -- stack lim pointer */
63 register StgClosure* obj;
67 iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
69 /* Main object-entering loop. Object to be entered is on top of
73 obj = (StgClosure*)StackWord(0); iSp++;
77 "\n---------------------------------------------------------------\n");
78 fprintf(stderr,"Entering: "); printObj(obj);
79 fprintf(stderr,"iSp = %p\tiSu = %p\n", iSp, iSu);
80 fprintf(stderr, "\n" );
81 printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
82 fprintf(stderr, "\n\n");
85 switch ( get_itbl(obj)->type ) {
87 barf("Invalid object %p",(StgPtr)obj);
93 StgAP_UPD *ap = (StgAP_UPD*)obj;
96 iSp -= sizeofW(StgUpdateFrame);
99 StgUpdateFrame *__frame;
100 __frame = (StgUpdateFrame *)iSp;
101 SET_INFO(__frame, (StgInfoTable *)&stg_upd_frame_info);
103 __frame->updatee = (StgClosure *)(ap);
107 /* WARNING: do a stack overflow check here ! */
110 /* Reload the stack */
111 for (i=0; i<Words; i++) StackWord(i) = (W_)ap->payload[i];
113 iSp--; StackWord(0) = (W_)ap->fun;
120 /* ---------------------------------------------------- */
121 /* Start of the bytecode interpreter */
122 /* ---------------------------------------------------- */
124 register int bciPtr = 1; /* instruction pointer */
125 register StgBCO* bco = (StgBCO*)obj;
126 register UShort* instrs = (UShort*)(&bco->instrs->payload[0]);
127 register StgWord* literals = (StgWord*)(&bco->literals->payload[0]);
128 register StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
129 register StgInfoTable** itbls = (StgInfoTable**)
130 (&bco->itbls->payload[0]);
132 if (doYouWantToGC()) {
133 iSp--; StackWord(0) = (W_)bco;
134 RETURN(HeapOverflow);
139 ASSERT(bciPtr <= instrs[0]);
141 //fprintf(stderr, "\n-- BEGIN stack\n");
142 //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
143 //fprintf(stderr, "-- END stack\n\n");
144 fprintf(stderr,"iSp = %p iSu = %p pc = %d ", iSp, iSu, bciPtr);
145 disInstr(bco,bciPtr);
147 fprintf(stderr,"\n");
148 for (i = 8; i >= 0; i--)
149 fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i)));
150 fprintf(stderr,"\n");
159 int arg_words_reqd = BCO_NEXT;
160 int arg_words_avail = ((W_*)iSu) - ((W_*)iSp);
161 if (arg_words_avail >= arg_words_reqd) goto nextInsn;
162 /* Handle arg check failure. Copy the spare args
164 /* fprintf(stderr, "arg check fail %d %d\n", arg_words_reqd, arg_words_avail ); */
165 pap = (StgPAP*)allocate(PAP_sizeW(arg_words_avail));
166 SET_HDR(pap,&stg_PAP_info,CCS_SYSTEM/*ToDo*/);
167 pap->n_args = arg_words_avail;
169 for (i = 0; i < arg_words_avail; i++)
170 pap->payload[i] = (StgClosure*)StackWord(i);
171 /* Push on the stack and defer to the scheduler. */
174 StackWord(0) = (W_)pap;
175 RETURN(ThreadEnterGHC);
179 ASSERT((W_*)iSp+o1 < (W_*)iSu);
180 StackWord(-1) = StackWord(o1);
187 StackWord(-1) = StackWord(o1);
188 StackWord(-2) = StackWord(o2);
196 StackWord(-1) = StackWord(o1);
197 StackWord(-2) = StackWord(o2);
198 StackWord(-3) = StackWord(o3);
204 StackWord(-1) = BCO_PTR(o1);
209 int o_bco = BCO_NEXT;
210 int o_itbl = BCO_NEXT;
211 StackWord(-2) = BCO_LIT(o_itbl);
212 StackWord(-1) = BCO_PTR(o_bco);
217 int o_lits = BCO_NEXT;
218 int n_words = BCO_NEXT;
219 for (; n_words > 0; n_words--) {
221 StackWord(0) = BCO_LIT(o_lits);
227 W_ tag = (W_)(BCO_NEXT);
235 ASSERT((W_*)iSp+n+by <= (W_*)iSu);
236 /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
238 StackWord(n+by) = StackWord(n);
244 int n_payload = BCO_NEXT - 1;
245 StgAP_UPD* ap = (StgAP_UPD*)allocate(AP_sizeW(n_payload));
246 StackWord(-1) = (W_)ap;
247 ap->n_args = n_payload;
248 SET_HDR(ap, &stg_AP_UPD_info, ??)
254 int stkoff = BCO_NEXT;
255 int n_payload = BCO_NEXT - 1;
256 StgAP_UPD* ap = (StgAP_UPD*)StackWord(stkoff);
257 ASSERT((int)ap->n_args == n_payload);
258 ap->fun = (StgClosure*)StackWord(0);
259 for (i = 0; i < n_payload; i++)
260 ap->payload[i] = (StgClosure*)StackWord(i+1);
265 /* Unpack N ptr words from t.o.s constructor */
266 /* The common case ! */
268 int n_words = BCO_NEXT;
269 StgClosure* con = (StgClosure*)StackWord(0);
271 for (i = 0; i < n_words; i++)
272 StackWord(i) = (W_)con->payload[i];
276 /* Unpack N (non-ptr) words from offset M in the
277 constructor K words down the stack, and then push
278 N as a tag, on top of it. Slow but general; we
279 hope it will be the rare case. */
281 int n_words = BCO_NEXT;
282 int con_off = BCO_NEXT;
283 int stk_off = BCO_NEXT;
284 StgClosure* con = (StgClosure*)StackWord(stk_off);
286 for (i = 0; i < n_words; i++)
287 StackWord(i) = (W_)con->payload[con_off + i];
289 StackWord(0) = n_words;
294 int o_itbl = BCO_NEXT;
295 int n_words = BCO_NEXT;
296 StgInfoTable* itbl = BCO_ITBL(o_itbl);
297 /* A bit of a kludge since n_words = n_p + n_np */
298 int request = CONSTR_sizeW( n_words, 0 );
299 StgClosure* con = (StgClosure*)allocate(request);
300 SET_HDR(con, itbl, CCS_SYSTEM/*ToDo*/);
301 for (i = 0; i < n_words; i++)
302 con->payload[i] = (StgClosure*)StackWord(i);
305 StackWord(0) = (W_)con;
309 int discr = BCO_NEXT;
310 int failto = BCO_NEXT;
311 StgClosure* con = (StgClosure*)StackWord(0);
312 if (constrTag(con) >= discr)
317 int discr = BCO_NEXT;
318 int failto = BCO_NEXT;
319 StgClosure* con = (StgClosure*)StackWord(0);
320 if (constrTag(con) != discr)
325 /* Control-flow ish things */
330 /* Figure out whether returning to interpreted or
332 int o_itoc_itbl = BCO_NEXT;
333 int tag = StackWord(0);
334 StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(tag+1 +1);
335 ASSERT(tag <= 2); /* say ... */
336 if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1_info
337 /* || ret_itbl == stg_ctoi_ret_F1_info
338 || ret_itbl == stg_ctoi_ret_D1_info */) {
339 /* Returning to interpreted code. Interpret the BCO
340 immediately underneath the itbl. */
341 StgBCO* ret_bco = (StgBCO*)StackWord(tag+1 +1+1);
343 StackWord(0) = (W_)ret_bco;
346 /* Returning (unboxed value) to compiled code.
347 Replace tag with a suitable itbl and ask the
348 scheduler to run it. The itbl code will copy
349 the TOS value into R1/F1/D1 and do a standard
350 compiled-code return. */
351 StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl);
352 StackWord(0) = (W_)magic_itbl;
353 RETURN(ThreadRunGHC);
358 barf("interpretBCO: hit a CASEFAIL");
360 /* As yet unimplemented */
370 barf("interpretBCO: unknown or unimplemented opcode");
372 } /* switch on opcode */
374 barf("interpretBCO: fell off end of insn loop");
377 /* ---------------------------------------------------- */
378 /* End of the bytecode interpreter */
379 /* ---------------------------------------------------- */
382 /* Can't handle this object; yield to sched. */
384 fprintf(stderr, "entering unknown closure -- yielding to sched\n");
387 cap->rCurrentTSO->what_next = ThreadEnterGHC;
388 iSp--; StackWord(0) = (W_)obj;
389 RETURN(ThreadYielding);
391 } /* switch on object kind */
393 barf("fallen off end of object-type switch in interpretBCO()");