1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.15 1999/04/23 09:47:33 simonm Exp $
4 * (c) The GHC Team, 1998-1999
6 * Code to perform updates.
8 * ---------------------------------------------------------------------------*/
12 #include "HeapStackCheck.h"
17 The update frame return address must be *polymorphic*, that means
18 we have to cope with both vectored and non-vectored returns. This
19 is done by putting the return vector right before the info table, and
20 having a standard direct return address after the info table (pointed
21 to by the return address itself, as usual).
23 Each entry in the vector table points to a specialised entry code fragment
24 that knows how to return after doing the update. It would be possible to
25 use a single generic piece of code that simply entered the return value
26 to return, but it's quicker this way. The direct return code of course
27 just does another direct return when it's finished.
29 Why is there necessarily an activation underneath us on the stack?
30 Because if we're returning, that means we've got a constructor in
31 our hands. If there were any arguments to be applied to it, that
32 would be a type error. We don't ever return a PAP to an update frame,
33 the update is handled manually by stg_update_PAP.
36 /* on entry to the update code
37 (1) R1 points to the closure being returned
38 (2) R2 contains the tag (if we returned directly, non-vectored)
39 (3) Sp points to the update frame
42 /* Why updatee is placed in a temporary variable here: this helps
43 gcc's aliasing by indicating that the location of the updatee
44 doesn't change across assignments. Saves one instruction in the
48 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
52 StgClosure *updatee; \
54 /* tick - ToDo: check this is right */ \
55 TICK_UPD_EXISTING(); \
57 updatee = ((StgUpdateFrame *)Sp)->updatee; \
59 /* update the updatee with an indirection to the return value */\
60 UPD_IND(updatee,R1.p); \
62 /* reset Su to the next update frame */ \
63 Su = ((StgUpdateFrame *)Sp)->link; \
65 /* remove the update frame from the stack */ \
66 Sp += sizeofW(StgUpdateFrame); \
72 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
73 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
74 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
75 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
76 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
77 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
78 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
79 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
80 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
83 Make sure this table is big enough to handle the maximum vectored
88 #define UPD_FRAME_BITMAP 3
90 #define UPD_FRAME_BITMAP 1
93 /* this bitmap indicates that the first word of an update frame is a
94 * non-pointer - this is the update frame link. (for profiling,
95 * there's a cost-centre-stack in there too).
98 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
100 /* -----------------------------------------------------------------------------
101 Entry Code for a PAP.
103 The idea is to copy the chunk of stack from the PAP object and then
104 re-enter the function closure that failed it's args check in the
107 In fact, we do a little optimisation too, by performing the updates
108 for any update frames sitting on top of the stack. (ToDo: is this
109 really an optimisation? --SDM)
110 -------------------------------------------------------------------------- */
112 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
122 pap = (StgPAP *) R1.p;
125 * remove any update frames on the top of the stack, by just
126 * performing the update here.
128 while ((W_)Su - (W_)Sp == 0) {
130 switch (get_itbl(Su)->type) {
133 /* We're sitting on top of an update frame, so let's do the business */
134 UPD_IND(Su->updatee, pap);
136 #if defined(PROFILING)
138 * Restore the Cost Centre too (if required); again see Sansom
139 * thesis p 183. Take the CC out of the update frame if a
143 CCCS = Su->header.prof.ccs;
144 #endif /* PROFILING */
147 Sp += sizeofW(StgUpdateFrame);
151 /* Just pop the seq frame and return to the activation record
152 * underneath us - R1 already contains the address of the PAP.
154 Su = ((StgSeqFrame *)Su)->link;
155 Sp += sizeofW(StgSeqFrame);
156 JMP_(ENTRY_CODE(*Sp));
159 /* can't happen, see stg_update_PAP */
160 barf("PAP_entry: CATCH_FRAME");
163 barf("PAP_entry: strange activation record");
171 * Check for stack overflow.
173 STK_CHK_NP(Words,1,);
178 /* Enter PAP cost centre -- lexical scoping only */
179 ENTER_CCS_PAP_CL(pap);
182 p = (P_)(pap->payload);
184 /* Reload the stack */
185 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
189 JMP_(GET_ENTRY(R1.cl));
193 /* -----------------------------------------------------------------------------
194 stg_update_PAP: Update the current closure with a partial application.
196 This function is called whenever an argument satisfaction check fails.
197 -------------------------------------------------------------------------- */
199 EXTFUN(stg_update_PAP)
203 CostCentreStack *CCS_pap;
206 StgClosure *Fun, *Updatee;
212 /* Save the pointer to the function closure that just failed the
213 * argument satisfaction check
217 #if defined(GRAN_COUNT)
222 /* Just copy the whole block of stack between the stack pointer
223 * and the update frame pointer.
225 Words = (P_)Su - (P_)Sp;
226 ASSERT((int)Words >= 0);
228 #if defined(PROFILING)
229 /* pretend we just entered the function closure */
237 * No arguments, only Node. Skip building the PAP and
238 * just plan to update with an indirection.
241 PapClosure = (StgPAP *)Fun;
246 PapSize = Words + sizeofW(StgPAP);
249 * First we need to do a heap check, which involves saving
250 * everything on the stack. We only have one live pointer:
251 * Fun, the function closure that was passed to us. If the
252 * heap check fails, we push the function closure on the stack
253 * and instruct the scheduler to try entering it again when
254 * the garbage collector has run.
256 * It's done this way because there's a possibility that the
257 * garbage collector might have messed around with the stack,
258 * such as removing the update frame.
260 if ((Hp += PapSize) > HpLim) {
263 JMP_(stg_gc_entertop);
266 TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
268 CCS_ALLOC(CCS_pap, PapSize);
271 PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
273 SET_HDR(PapClosure,&PAP_info,CCS_pap);
274 PapClosure->n_args = Words;
275 PapClosure->fun = Fun;
277 /* Now fill in the closure fields */
280 for (i = Words-1; i >= 0; i--) {
286 * Finished constructing PAP closure; now update the updatee.
289 /* ToDo: we'd like to just jump to the code for PAP_entry here,
290 * which deals with a stack of update frames in one go. What to
291 * do about the special ticky and profiling stuff here?
294 switch (get_itbl(Su)->type) {
297 /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
298 Sp = (P_)Su + sizeofW(StgSeqFrame);
301 Su = ((StgSeqFrame *)Su)->link;
303 /* return to the activation record, with the address of the PAP in R1 */
304 R1.p = (P_)PapClosure;
305 JMP_(ENTRY_CODE(*Sp));
308 /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
309 Sp = (P_)Su + sizeofW(StgCatchFrame);
312 Su = ((StgCatchFrame *)Su)->link;
314 /* restart by entering the PAP */
315 R1.p = (P_)PapClosure;
316 JMP_(GET_ENTRY(R1.cl));
320 * Now we have a standard update frame, so we update the updatee with
321 * either the new PAP or Node.
324 Updatee = Su->updatee;
326 #if defined(PROFILING)
328 UPD_IND(Updatee,PapClosure);
329 TICK_UPD_PAP_IN_NEW(Words+1);
331 /* Lexical scoping requires a *permanent* indirection, and we
332 * also have to set the cost centre for the indirection.
334 UPD_PERM_IND(Updatee,PapClosure);
335 TICK_UPD_PAP_IN_PLACE();
336 Updatee->header.prof.ccs = CCS_pap;
339 UPD_IND(Updatee,PapClosure);
341 TICK_UPD_PAP_IN_NEW(Words+1);
343 TICK_UPD_PAP_IN_PLACE();
347 #if defined(PROFILING)
348 CCCS = Su->header.prof.ccs;
349 ENTER_CCS_PAP(CCS_pap);
350 #endif /* PROFILING */
356 * Squeeze out update frame from stack.
358 for (i = Words-1; i >= 0; i--) {
359 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
361 Sp += sizeofW(StgUpdateFrame);
365 barf("stg_update_PAP: strange activation record");
369 * All done! Restart by re-entering Node
370 * Don't count this entry for ticky-ticky profiling.
372 JMP_(GET_ENTRY(R1.cl));
377 /* -----------------------------------------------------------------------------
378 Entry Code for an AP_UPD.
380 The idea is to copy the chunk of stack from the AP object and then
381 enter the function closure.
383 (This code is a simplified copy of the PAP code - with all the
384 update frame code stripped out.)
385 -------------------------------------------------------------------------- */
388 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
398 ap = (StgAP_UPD *) R1.p;
403 * Check for stack overflow.
405 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
407 PUSH_UPD_FRAME(R1.p, 0);
408 Sp -= sizeofW(StgUpdateFrame) + Words;
412 /* Enter PAP cost centre -- lexical scoping only */
413 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
416 p = (P_)(ap->payload);
418 /* Reload the stack */
419 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
423 JMP_(GET_ENTRY(R1.cl));
428 /*-----------------------------------------------------------------------------
431 We don't have a primitive seq# operator: it is just a 'case'
432 expression whose scrutinee has either a polymorphic or function type
433 (constructor types can be handled by normal 'case' expressions).
435 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
436 the stack. This is a polymorphic activation record that just pops
437 itself and returns when entered. The purpose of the SEQ_FRAME is to
438 act as a barrier in case the scrutinee is a partial application - in
439 this way it is just like an update frame, except that it doesn't
441 -------------------------------------------------------------------------- */
443 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
447 Su = ((StgSeqFrame *)Sp)->link; \
448 Sp += sizeofW(StgSeqFrame); \
453 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
454 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
455 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
456 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
457 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
458 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
459 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
460 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
461 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
463 VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
465 /* -----------------------------------------------------------------------------
468 * This closure takes one argument, which it evaluates and returns the
469 * result with a direct return (never a vectored return!) in R1. It
470 * does this by pushing a SEQ_FRAME on the stack and
471 * entering its argument.
473 * It is used in deleteThread when reverting blackholes.
474 * -------------------------------------------------------------------------- */
476 INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
480 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
481 Sp -= sizeofW(StgSeqFrame);
483 R1.cl = R1.cl->payload[0];
484 JMP_(ENTRY_CODE(*R1.p));
489 /* -----------------------------------------------------------------------------
491 -------------------------------------------------------------------------- */
496 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
501 Su = ((StgCatchFrame *)Sp)->link; \
502 Sp += sizeofW(StgCatchFrame); \
507 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
508 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
509 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
510 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
511 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
512 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
513 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
514 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
515 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
518 #define CATCH_FRAME_BITMAP 3
520 #define CATCH_FRAME_BITMAP 1
523 /* Catch frames are very similar to update frames, but when entering
524 * one we just pop the frame off the stack and perform the correct
525 * kind of return to the activation record underneath us on the stack.
528 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
530 /* -----------------------------------------------------------------------------
531 * The catch infotable
533 * This should be exactly the same as would be generated by this STG code
535 * catch = {x,h} \n {} -> catch#{x,h}
537 * It is used in deleteThread when reverting blackholes.
538 * -------------------------------------------------------------------------- */
540 INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
544 R2.cl = payloadCPtr(R1.cl,1); /* h */
545 R1.cl = payloadCPtr(R1.cl,0); /* x */
555 /* args: R1 = m, R2 = k */
556 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
557 Sp -= sizeofW(StgCatchFrame);
558 fp = (StgCatchFrame *)Sp;
559 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
560 fp -> handler = R2.cl;
562 Su = (StgUpdateFrame *)fp;
563 TICK_CATCHF_PUSHED();
565 JMP_(ENTRY_CODE(*R1.p));
570 /* -----------------------------------------------------------------------------
571 * The raise infotable
573 * This should be exactly the same as would be generated by this STG code
575 * raise = {err} \n {} -> raise#{err}
577 * It is used in raisezh_fast to update thunks on the update list
578 * -------------------------------------------------------------------------- */
580 INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
584 R1.cl = R1.cl->payload[0];
593 StgClosure *raise_closure;
595 /* args : R1 = error */
599 /* This closure represents the expression 'raise# E' where E
600 * is the exception raise. It is used to overwrite all the
601 * thunks which are currently under evaluataion.
603 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
604 sizeofW(StgClosure)+1);
605 raise_closure->header.info = &raise_info;
606 raise_closure->payload[0] = R1.cl;
610 switch (get_itbl(p)->type) {
613 UPD_IND(p->updatee,raise_closure);
618 p = ((StgSeqFrame *)p)->link;
626 barf("raisezh_fast: STOP_FRAME");
629 barf("raisezh_fast: weird activation record");
636 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
637 * and including this frame, update Su, push R1, and enter the handler.
639 Su = ((StgCatchFrame *)p)->link;
640 handler = ((StgCatchFrame *)p)->handler;
642 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
647 JMP_(ENTRY_CODE(handler->header.info));