2 /* -----------------------------------------------------------------------------
5 * Copyright (c) 1994-2000.
7 * $RCSfile: Interpreter.c,v $
9 * $Date: 2001/01/03 15:30:48 $
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 StgThreadReturnCode interpretBCO ( Capability* cap )
44 /* On entry, the closure to interpret is on the top of the
47 /* Use of register here is primarily to make it clear to compilers
48 that these entities are non-aliasable.
50 register W_* iSp; /* local state -- stack pointer */
51 register StgUpdateFrame* iSu; /* local state -- frame pointer */
52 register StgPtr iSpLim; /* local state -- stack lim pointer */
53 register StgClosure* obj;
55 iSp = cap->rCurrentTSO->sp;
56 iSu = cap->rCurrentTSO->su;
57 iSpLim = cap->rCurrentTSO->stack + RESERVED_STACK_WORDS;
61 "\n---------------------------------------------------------------\n");
62 fprintf(stderr,"Entering: "); printObj((StgClosure*)StackWord(0));
63 fprintf(stderr,"iSp = %p\tiSu = %p\n", iSp, iSu);
64 fprintf(stderr, "\n" );
65 printStack(iSp,cap->rCurrentTSO->stack+cap->rCurrentTSO->stack_size,iSu);
66 fprintf(stderr, "\n\n");
69 /* Main object-entering loop. Object to be entered is on top of
73 obj = (StgClosure*)StackWord(0); iSp++;
75 switch ( get_itbl(obj)->type ) {
77 barf("Invalid object %p",(StgPtr)obj);
81 /* ---------------------------------------------------- */
82 /* Start of the bytecode interpreter */
83 /* ---------------------------------------------------- */
85 register int bciPtr = 1; /* instruction pointer */
86 register StgBCO* bco = (StgBCO*)obj;
87 register UShort* instrs = (UShort*)(&bco->instrs->payload[0]);
88 register StgWord* literals = (StgWord*)(&bco->literals->payload[0]);
89 register StgPtr* ptrs = (StgPtr*)(&bco->ptrs->payload[0]);
90 register StgInfoTable** itbls = (StgInfoTable**)
91 (&bco->itbls->payload[0]);
93 if (doYouWantToGC()) {
94 iSp--; StackWord(0) = (W_)bco;
100 ASSERT(bciPtr <= instrs[0]);
102 fprintf(stderr,"iSp = %p\tiSu = %p\tpc = %d\t", iSp, iSu, bciPtr);
103 disInstr(bco,bciPtr);
105 fprintf(stderr,"\n");
106 for (i = 8; i >= 0; i--)
107 fprintf(stderr, "%d %p\n", i, (StgPtr)(*(iSp+i)));
109 fprintf(stderr,"\n");
117 int arg_words_reqd = BCO_NEXT;
118 int arg_words_avail = ((W_*)iSu) - ((W_*)iSp);
119 if (arg_words_avail >= arg_words_reqd) goto nextInsn;
120 /* Handle arg check failure. Copy the spare args
122 pap = (StgPAP*)allocate(PAP_sizeW(arg_words_avail));
123 SET_HDR(pap,&stg_PAP_info,CCS_SYSTEM/*ToDo*/);
124 pap->n_args = arg_words_avail;
125 for (i = 0; i < arg_words_avail; i++)
126 pap->payload[i] = (StgClosure*)StackWord(i);
127 /* Push on the stack and defer to the scheduler. */
130 StackWord(0) = (W_)pap;
131 return ThreadEnterGHC;
135 StackWord(-1) = StackWord(o1);
142 StackWord(-1) = StackWord(o1);
143 StackWord(-2) = StackWord(o2);
151 StackWord(-1) = StackWord(o1);
152 StackWord(-2) = StackWord(o2);
153 StackWord(-3) = StackWord(o3);
159 StackWord(-1) = BCO_PTR(o1);
164 int o_bco = BCO_NEXT;
165 int o_itbl = BCO_NEXT;
166 StackWord(-1) = BCO_LIT(o_itbl);
167 StackWord(-2) = BCO_PTR(o_bco);
172 int o_lits = BCO_NEXT;
173 int n_words = BCO_NEXT;
174 for (; n_words > 0; n_words--) {
176 StackWord(0) = BCO_LIT(o_lits);
182 W_ tag = (W_)(BCO_NEXT);
190 ASSERT(iSp+n+by <= (W_*)iSu);
191 /* a_1, .. a_n, b_1, .. b_by, s => a_1, .. a_n, s */
193 StackWord(n+by) = StackWord(n);
199 int n_payload = BCO_NEXT;
200 P_ p = allocate(AP_sizeW(n_payload));
201 StackWord(-1) = (W_)p;
207 int stkoff = BCO_NEXT;
208 int n_payload = BCO_NEXT - 1;
209 StgAP_UPD* ap = (StgAP_UPD*)StackWord(stkoff);
210 ap->n_args = n_payload;
211 ap->fun = (StgClosure*)StackWord(0);
212 for (i = 0; i < n_payload; i++)
213 ap->payload[i] = (StgClosure*)StackWord(i+1);
218 /* Unpack N ptr words from t.o.s constructor */
219 /* The common case ! */
221 int n_words = BCO_NEXT;
222 StgClosure* con = (StgClosure*)StackWord(0);
224 for (i = 0; i < n_words; i++)
225 StackWord(i) = (W_)con->payload[i];
229 /* Unpack N (non-ptr) words from offset M in the
230 constructor K words down the stack, and then push
231 N as a tag, on top of it. Slow but general; we
232 hope it will be the rare case. */
234 int n_words = BCO_NEXT;
235 int con_off = BCO_NEXT;
236 int stk_off = BCO_NEXT;
237 StgClosure* con = (StgClosure*)StackWord(stk_off);
239 for (i = 0; i < n_words; i++)
240 StackWord(i) = (W_)con->payload[con_off + i];
242 StackWord(0) = n_words;
247 int o_itbl = BCO_NEXT;
248 int n_words = BCO_NEXT;
249 StgInfoTable* itbl = BCO_ITBL(o_itbl);
250 /* A bit of a kludge since n_words = n_p + n_np */
251 int request = CONSTR_sizeW( n_words, 0 );
252 StgClosure* con = (StgClosure*)allocate(request);
253 SET_HDR(con, itbl, CCS_SYSTEM/*ToDo*/);
254 for (i = 0; i < n_words; i++)
255 con->payload[i] = (StgClosure*)StackWord(i);
258 StackWord(0) = (W_)con;
262 int discr = BCO_NEXT;
263 int failto = BCO_NEXT;
264 StgClosure* con = (StgClosure*)StackWord(0);
265 if (constrTag(con) < discr)
270 int discr = BCO_NEXT;
271 int failto = BCO_NEXT;
272 StgClosure* con = (StgClosure*)StackWord(0);
273 if (constrTag(con) != discr)
278 /* Control-flow ish things */
283 /* Figure out whether returning to interpreted or
285 int o_itoc_itbl = BCO_NEXT;
286 int tag = StackWord(0);
287 StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(tag+1 +1);
288 ASSERT(tag <= 2); /* say ... */
289 if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1_info
290 /* || ret_itbl == stg_ctoi_ret_F1_info
291 || ret_itbl == stg_ctoi_ret_D1_info */) {
292 /* Returning to interpreted code. Interpret the BCO
293 immediately underneath the itbl. */
294 StgBCO* ret_bco = (StgBCO*)StackWord(tag+1 +1+1);
296 StackWord(0) = (W_)ret_bco;
299 /* Returning (unboxed value) to compiled code.
300 Replace tag with a suitable itbl and ask the
301 scheduler to run it. The itbl code will copy
302 the TOS value into R1/F1/D1 and do a standard
303 compiled-code return. */
304 StgInfoTable* magic_itbl = BCO_ITBL(o_itoc_itbl);
305 StackWord(0) = (W_)magic_itbl;
311 barf("interpretBCO: hit a CASEFAIL");
313 /* As yet unimplemented */
323 barf("interpretBCO: unknown or unimplemented opcode");
325 } /* switch on opcode */
327 barf("interpretBCO: fell off end of insn loop");
330 /* ---------------------------------------------------- */
331 /* End of the bytecode interpreter */
332 /* ---------------------------------------------------- */
335 /* Can't handle this object; yield to sched. */
336 fprintf(stderr, "entering unknown closure -- yielding to sched\n");
338 cap->rCurrentTSO->what_next = ThreadEnterGHC;
339 iSp--; StackWord(0) = (W_)obj;
340 return ThreadYielding;
342 } /* switch on object kind */
344 barf("fallen off end of object-type switch in interpretBCO()");