2 /* -----------------------------------------------------------------------------
5 * Copyright (c) 1994-2000.
7 * $RCSfile: Interpreter.c,v $
9 * $Date: 2001/01/03 16:44:30 $
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);
92 StgAP_UPD *ap = (StgAP_UPD*)obj;
93 fprintf(stderr, "home-grown AP_UPD code\n");
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);
109 /* Reload the stack */
110 for (i=0; i<Words; i++) StackWord(i) = (W_)ap->payload[i];
112 iSp--; StackWord(0) = (W_)ap->fun;
118 /* ---------------------------------------------------- */
119 /* Start of the bytecode interpreter */
120 /* ---------------------------------------------------- */
122 register int bciPtr = 1; /* instruction pointer */
123 register StgBCO* bco = (StgBCO*)obj;
124 register UShort* instrs = (UShort*)(&bco->instrs->payload[0]);
125 register StgWord* literals = (StgWord*)(&bco->literals->payload[0]);
126 register StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
127 register StgInfoTable** itbls = (StgInfoTable**)
128 (&bco->itbls->payload[0]);
130 if (doYouWantToGC()) {
131 iSp--; StackWord(0) = (W_)bco;
132 RETURN(HeapOverflow);
137 ASSERT(bciPtr <= instrs[0]);
139 //fprintf(stderr, "\n-- BEGIN stack\n");
140 //printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
141 //fprintf(stderr, "-- END stack\n\n");
142 fprintf(stderr,"iSp = %p iSu = %p pc = %d ", iSp, iSu, bciPtr);
143 disInstr(bco,bciPtr);
145 fprintf(stderr,"\n");
146 for (i = 8; i >= 0; i--)
147 fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i)));
148 fprintf(stderr,"\n");
157 int arg_words_reqd = BCO_NEXT;
158 int arg_words_avail = ((W_*)iSu) - ((W_*)iSp);
159 if (arg_words_avail >= arg_words_reqd) goto nextInsn;
160 /* Handle arg check failure. Copy the spare args
162 fprintf(stderr, "arg check fail %d %d\n", arg_words_reqd, arg_words_avail );
163 pap = (StgPAP*)allocate(PAP_sizeW(arg_words_avail));
164 SET_HDR(pap,&stg_PAP_info,CCS_SYSTEM/*ToDo*/);
165 pap->n_args = arg_words_avail;
167 for (i = 0; i < arg_words_avail; i++)
168 pap->payload[i] = (StgClosure*)StackWord(i);
169 /* Push on the stack and defer to the scheduler. */
172 StackWord(0) = (W_)pap;
173 RETURN(ThreadEnterGHC);
177 ASSERT((W_*)iSp+o1 < (W_*)iSu);
178 StackWord(-1) = StackWord(o1);
185 StackWord(-1) = StackWord(o1);
186 StackWord(-2) = StackWord(o2);
194 StackWord(-1) = StackWord(o1);
195 StackWord(-2) = StackWord(o2);
196 StackWord(-3) = StackWord(o3);
202 StackWord(-1) = BCO_PTR(o1);
207 int o_bco = BCO_NEXT;
208 int o_itbl = BCO_NEXT;
209 StackWord(-1) = BCO_LIT(o_itbl);
210 StackWord(-2) = BCO_PTR(o_bco);
215 int o_lits = BCO_NEXT;
216 int n_words = BCO_NEXT;
217 for (; n_words > 0; n_words--) {
219 StackWord(0) = BCO_LIT(o_lits);
225 W_ tag = (W_)(BCO_NEXT);
233 ASSERT((W_*)iSp+n+by <= (W_*)iSu);
234 /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
236 StackWord(n+by) = StackWord(n);
242 int n_payload = BCO_NEXT - 1;
243 StgAP_UPD* ap = (StgAP_UPD*)allocate(AP_sizeW(n_payload));
244 StackWord(-1) = (W_)ap;
245 ap->n_args = n_payload;
246 SET_HDR(ap, &stg_AP_UPD_info, ??)
252 int stkoff = BCO_NEXT;
253 int n_payload = BCO_NEXT - 1;
254 StgAP_UPD* ap = (StgAP_UPD*)StackWord(stkoff);
255 ASSERT(ap->n_args == n_payload);
256 ap->fun = (StgClosure*)StackWord(0);
257 for (i = 0; i < n_payload; i++)
258 ap->payload[i] = (StgClosure*)StackWord(i+1);
263 /* Unpack N ptr words from t.o.s constructor */
264 /* The common case ! */
266 int n_words = BCO_NEXT;
267 StgClosure* con = (StgClosure*)StackWord(0);
269 for (i = 0; i < n_words; i++)
270 StackWord(i) = (W_)con->payload[i];
274 /* Unpack N (non-ptr) words from offset M in the
275 constructor K words down the stack, and then push
276 N as a tag, on top of it. Slow but general; we
277 hope it will be the rare case. */
279 int n_words = BCO_NEXT;
280 int con_off = BCO_NEXT;
281 int stk_off = BCO_NEXT;
282 StgClosure* con = (StgClosure*)StackWord(stk_off);
284 for (i = 0; i < n_words; i++)
285 StackWord(i) = (W_)con->payload[con_off + i];
287 StackWord(0) = n_words;
292 int o_itbl = BCO_NEXT;
293 int n_words = BCO_NEXT;
294 StgInfoTable* itbl = BCO_ITBL(o_itbl);
295 /* A bit of a kludge since n_words = n_p + n_np */
296 int request = CONSTR_sizeW( n_words, 0 );
297 StgClosure* con = (StgClosure*)allocate(request);
298 SET_HDR(con, itbl, CCS_SYSTEM/*ToDo*/);
299 for (i = 0; i < n_words; i++)
300 con->payload[i] = (StgClosure*)StackWord(i);
303 StackWord(0) = (W_)con;
307 int discr = BCO_NEXT;
308 int failto = BCO_NEXT;
309 StgClosure* con = (StgClosure*)StackWord(0);
310 if (constrTag(con) < discr)
315 int discr = BCO_NEXT;
316 int failto = BCO_NEXT;
317 StgClosure* con = (StgClosure*)StackWord(0);
318 if (constrTag(con) != discr)
323 /* Control-flow ish things */
328 /* Figure out whether returning to interpreted or
330 int o_itoc_itbl = BCO_NEXT;
331 int tag = StackWord(0);
332 StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(tag+1 +1);
333 ASSERT(tag <= 2); /* say ... */
334 if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1_info
335 /* || ret_itbl == stg_ctoi_ret_F1_info
336 || ret_itbl == stg_ctoi_ret_D1_info */) {
337 /* Returning to interpreted code. Interpret the BCO
338 immediately underneath the itbl. */
339 StgBCO* ret_bco = (StgBCO*)StackWord(tag+1 +1+1);
341 StackWord(0) = (W_)ret_bco;
344 /* Returning (unboxed value) to compiled code.
345 Replace tag with a suitable itbl and ask the
346 scheduler to run it. The itbl code will copy
347 the TOS value into R1/F1/D1 and do a standard
348 compiled-code return. */
349 StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl);
350 StackWord(0) = (W_)magic_itbl;
351 RETURN(ThreadRunGHC);
356 barf("interpretBCO: hit a CASEFAIL");
358 /* As yet unimplemented */
368 barf("interpretBCO: unknown or unimplemented opcode");
370 } /* switch on opcode */
372 barf("interpretBCO: fell off end of insn loop");
375 /* ---------------------------------------------------- */
376 /* End of the bytecode interpreter */
377 /* ---------------------------------------------------- */
380 /* Can't handle this object; yield to sched. */
381 fprintf(stderr, "entering unknown closure -- yielding to sched\n");
383 cap->rCurrentTSO->what_next = ThreadEnterGHC;
384 iSp--; StackWord(0) = (W_)obj;
385 RETURN(ThreadYielding);
387 } /* switch on object kind */
389 barf("fallen off end of object-type switch in interpretBCO()");