1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.18 1999/07/06 16:40:28 sewardj Exp $
4 * (c) The GHC Team, 1998-1999
6 * Code to perform updates.
8 * ---------------------------------------------------------------------------*/
13 #include "HeapStackCheck.h"
18 The update frame return address must be *polymorphic*, that means
19 we have to cope with both vectored and non-vectored returns. This
20 is done by putting the return vector right before the info table, and
21 having a standard direct return address after the info table (pointed
22 to by the return address itself, as usual).
24 Each entry in the vector table points to a specialised entry code fragment
25 that knows how to return after doing the update. It would be possible to
26 use a single generic piece of code that simply entered the return value
27 to return, but it's quicker this way. The direct return code of course
28 just does another direct return when it's finished.
30 Why is there necessarily an activation underneath us on the stack?
31 Because if we're returning, that means we've got a constructor in
32 our hands. If there were any arguments to be applied to it, that
33 would be a type error. We don't ever return a PAP to an update frame,
34 the update is handled manually by stg_update_PAP.
37 /* on entry to the update code
38 (1) R1 points to the closure being returned
39 (2) R2 contains the tag (if we returned directly, non-vectored)
40 (3) Sp points to the update frame
43 /* Why updatee is placed in a temporary variable here: this helps
44 gcc's aliasing by indicating that the location of the updatee
45 doesn't change across assignments. Saves one instruction in the
49 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
53 StgClosure *updatee; \
55 /* tick - ToDo: check this is right */ \
56 TICK_UPD_EXISTING(); \
58 updatee = ((StgUpdateFrame *)Sp)->updatee; \
60 /* update the updatee with an indirection to the return value */\
61 UPD_IND(updatee,R1.p); \
63 /* reset Su to the next update frame */ \
64 Su = ((StgUpdateFrame *)Sp)->link; \
66 /* remove the update frame from the stack */ \
67 Sp += sizeofW(StgUpdateFrame); \
73 //UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
74 STGFUN(Upd_frame_entry);
75 STGFUN(Upd_frame_entry)
79 /* tick - ToDo: check this is right */
82 updatee = ((StgUpdateFrame *)Sp)->updatee;
84 /* update the updatee with an indirection to the return value */
85 UPD_IND(updatee,R1.p);
87 /* reset Su to the next update frame */
88 Su = ((StgUpdateFrame *)Sp)->link;
90 /* remove the update frame from the stack */
91 Sp += sizeofW(StgUpdateFrame);
93 JMP_(ENTRY_CODE(Sp[0]));
98 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
99 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
100 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
101 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
102 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
103 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
104 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
105 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
108 Make sure this table is big enough to handle the maximum vectored
113 #define UPD_FRAME_BITMAP 3
115 #define UPD_FRAME_BITMAP 1
118 /* this bitmap indicates that the first word of an update frame is a
119 * non-pointer - this is the update frame link. (for profiling,
120 * there's a cost-centre-stack in there too).
123 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
125 /* -----------------------------------------------------------------------------
126 Entry Code for a PAP.
128 The idea is to copy the chunk of stack from the PAP object and then
129 re-enter the function closure that failed it's args check in the
132 In fact, we do a little optimisation too, by performing the updates
133 for any update frames sitting on top of the stack. (ToDo: is this
134 really an optimisation? --SDM)
135 -------------------------------------------------------------------------- */
137 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,,EF_,0,0);
147 pap = (StgPAP *) R1.p;
150 * remove any update frames on the top of the stack, by just
151 * performing the update here.
153 while ((W_)Su - (W_)Sp == 0) {
155 switch (get_itbl(Su)->type) {
158 /* We're sitting on top of an update frame, so let's do the business */
159 UPD_IND(Su->updatee, pap);
161 #if defined(PROFILING)
163 * Restore the Cost Centre too (if required); again see Sansom
164 * thesis p 183. Take the CC out of the update frame if a
168 CCCS = Su->header.prof.ccs;
169 #endif /* PROFILING */
172 Sp += sizeofW(StgUpdateFrame);
176 /* Just pop the seq frame and return to the activation record
177 * underneath us - R1 already contains the address of the PAP.
179 Su = ((StgSeqFrame *)Su)->link;
180 Sp += sizeofW(StgSeqFrame);
181 JMP_(ENTRY_CODE(*Sp));
184 /* can't happen, see stg_update_PAP */
185 barf("PAP_entry: CATCH_FRAME");
188 barf("PAP_entry: strange activation record");
196 * Check for stack overflow.
198 STK_CHK_NP(Words,1,);
203 /* Enter PAP cost centre -- lexical scoping only */
204 ENTER_CCS_PAP_CL(pap);
207 p = (P_)(pap->payload);
209 /* Reload the stack */
210 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
214 JMP_(GET_ENTRY(R1.cl));
218 /* -----------------------------------------------------------------------------
219 stg_update_PAP: Update the current closure with a partial application.
221 This function is called whenever an argument satisfaction check fails.
222 -------------------------------------------------------------------------- */
224 EXTFUN(stg_update_PAP)
228 CostCentreStack *CCS_pap;
231 StgClosure *Fun, *Updatee;
237 /* Save the pointer to the function closure that just failed the
238 * argument satisfaction check
242 #if defined(GRAN_COUNT)
247 /* Just copy the whole block of stack between the stack pointer
248 * and the update frame pointer.
250 Words = (P_)Su - (P_)Sp;
251 ASSERT((int)Words >= 0);
253 #if defined(PROFILING)
254 /* pretend we just entered the function closure */
262 * No arguments, only Node. Skip building the PAP and
263 * just plan to update with an indirection.
266 PapClosure = (StgPAP *)Fun;
271 PapSize = Words + sizeofW(StgPAP);
274 * First we need to do a heap check, which involves saving
275 * everything on the stack. We only have one live pointer:
276 * Fun, the function closure that was passed to us. If the
277 * heap check fails, we push the function closure on the stack
278 * and instruct the scheduler to try entering it again when
279 * the garbage collector has run.
281 * It's done this way because there's a possibility that the
282 * garbage collector might have messed around with the stack,
283 * such as removing the update frame.
285 if ((Hp += PapSize) > HpLim) {
288 JMP_(stg_gc_entertop);
291 TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
293 CCS_ALLOC(CCS_pap, PapSize);
296 PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
298 SET_HDR(PapClosure,&PAP_info,CCS_pap);
299 PapClosure->n_args = Words;
300 PapClosure->fun = Fun;
302 /* Now fill in the closure fields */
305 for (i = Words-1; i >= 0; i--) {
311 * Finished constructing PAP closure; now update the updatee.
314 /* ToDo: we'd like to just jump to the code for PAP_entry here,
315 * which deals with a stack of update frames in one go. What to
316 * do about the special ticky and profiling stuff here?
319 switch (get_itbl(Su)->type) {
322 /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
323 Sp = (P_)Su + sizeofW(StgSeqFrame);
326 Su = ((StgSeqFrame *)Su)->link;
328 /* return to the activation record, with the address of the PAP in R1 */
329 R1.p = (P_)PapClosure;
330 JMP_(ENTRY_CODE(*Sp));
333 /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
334 Sp = (P_)Su + sizeofW(StgCatchFrame);
337 Su = ((StgCatchFrame *)Su)->link;
339 /* restart by entering the PAP */
340 R1.p = (P_)PapClosure;
341 JMP_(GET_ENTRY(R1.cl));
345 * Now we have a standard update frame, so we update the updatee with
346 * either the new PAP or Node.
349 Updatee = Su->updatee;
351 #if defined(PROFILING)
353 UPD_IND(Updatee,PapClosure);
354 TICK_UPD_PAP_IN_NEW(Words+1);
356 /* Lexical scoping requires a *permanent* indirection, and we
357 * also have to set the cost centre for the indirection.
359 UPD_PERM_IND(Updatee,PapClosure);
360 TICK_UPD_PAP_IN_PLACE();
361 Updatee->header.prof.ccs = CCS_pap;
364 UPD_IND(Updatee,PapClosure);
366 TICK_UPD_PAP_IN_NEW(Words+1);
368 TICK_UPD_PAP_IN_PLACE();
372 #if defined(PROFILING)
373 CCCS = Su->header.prof.ccs;
374 ENTER_CCS_PAP(CCS_pap);
375 #endif /* PROFILING */
381 * Squeeze out update frame from stack.
383 for (i = Words-1; i >= 0; i--) {
384 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
386 Sp += sizeofW(StgUpdateFrame);
390 barf("stg_update_PAP: strange activation record");
394 * All done! Restart by re-entering Node
395 * Don't count this entry for ticky-ticky profiling.
397 JMP_(GET_ENTRY(R1.cl));
402 /* -----------------------------------------------------------------------------
403 Entry Code for an AP_UPD.
405 The idea is to copy the chunk of stack from the AP object and then
406 enter the function closure.
408 (This code is a simplified copy of the PAP code - with all the
409 update frame code stripped out.)
410 -------------------------------------------------------------------------- */
413 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,0,0);
423 ap = (StgAP_UPD *) R1.p;
428 * Check for stack overflow.
430 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
432 PUSH_UPD_FRAME(R1.p, 0);
433 Sp -= sizeofW(StgUpdateFrame) + Words;
437 /* Enter PAP cost centre -- lexical scoping only */
438 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
441 p = (P_)(ap->payload);
443 /* Reload the stack */
444 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
448 JMP_(GET_ENTRY(R1.cl));
453 /*-----------------------------------------------------------------------------
456 We don't have a primitive seq# operator: it is just a 'case'
457 expression whose scrutinee has either a polymorphic or function type
458 (constructor types can be handled by normal 'case' expressions).
460 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
461 the stack. This is a polymorphic activation record that just pops
462 itself and returns when entered. The purpose of the SEQ_FRAME is to
463 act as a barrier in case the scrutinee is a partial application - in
464 this way it is just like an update frame, except that it doesn't
466 -------------------------------------------------------------------------- */
468 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
472 Su = ((StgSeqFrame *)Sp)->link; \
473 Sp += sizeofW(StgSeqFrame); \
478 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
479 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
480 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
481 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
482 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
483 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
484 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
485 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
486 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
488 VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
490 /* -----------------------------------------------------------------------------
493 * This closure takes one argument, which it evaluates and returns the
494 * result with a direct return (never a vectored return!) in R1. It
495 * does this by pushing a SEQ_FRAME on the stack and
496 * entering its argument.
498 * It is used in deleteThread when reverting blackholes.
499 * -------------------------------------------------------------------------- */
501 INFO_TABLE(seq_info,seq_entry,1,0,FUN,,EF_,0,0);
505 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
506 Sp -= sizeofW(StgSeqFrame);
508 R1.cl = R1.cl->payload[0];
509 JMP_(ENTRY_CODE(*R1.p));
514 /* -----------------------------------------------------------------------------
516 -------------------------------------------------------------------------- */
521 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
526 Su = ((StgCatchFrame *)Sp)->link; \
527 Sp += sizeofW(StgCatchFrame); \
532 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
533 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
534 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
535 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
536 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
537 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
538 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
539 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
540 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
543 #define CATCH_FRAME_BITMAP 3
545 #define CATCH_FRAME_BITMAP 1
548 /* Catch frames are very similar to update frames, but when entering
549 * one we just pop the frame off the stack and perform the correct
550 * kind of return to the activation record underneath us on the stack.
553 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
555 /* -----------------------------------------------------------------------------
556 * The catch infotable
558 * This should be exactly the same as would be generated by this STG code
560 * catch = {x,h} \n {} -> catch#{x,h}
562 * It is used in deleteThread when reverting blackholes.
563 * -------------------------------------------------------------------------- */
565 INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
569 R2.cl = payloadCPtr(R1.cl,1); /* h */
570 R1.cl = payloadCPtr(R1.cl,0); /* x */
580 /* args: R1 = m, R2 = k */
581 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
582 Sp -= sizeofW(StgCatchFrame);
583 fp = (StgCatchFrame *)Sp;
584 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
585 fp -> handler = R2.cl;
587 Su = (StgUpdateFrame *)fp;
588 TICK_CATCHF_PUSHED();
590 JMP_(ENTRY_CODE(*R1.p));
595 /* -----------------------------------------------------------------------------
596 * The raise infotable
598 * This should be exactly the same as would be generated by this STG code
600 * raise = {err} \n {} -> raise#{err}
602 * It is used in raisezh_fast to update thunks on the update list
603 * -------------------------------------------------------------------------- */
605 INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
609 R1.cl = R1.cl->payload[0];
618 StgClosure *raise_closure;
620 /* args : R1 = error */
624 /* This closure represents the expression 'raise# E' where E
625 * is the exception raise. It is used to overwrite all the
626 * thunks which are currently under evaluataion.
628 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
629 sizeofW(StgClosure)+1);
630 raise_closure->header.info = &raise_info;
631 raise_closure->payload[0] = R1.cl;
635 switch (get_itbl(p)->type) {
638 UPD_IND(p->updatee,raise_closure);
643 p = ((StgSeqFrame *)p)->link;
651 barf("raisezh_fast: STOP_FRAME");
654 barf("raisezh_fast: weird activation record");
661 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
662 * and including this frame, update Su, push R1, and enter the handler.
664 Su = ((StgCatchFrame *)p)->link;
665 handler = ((StgCatchFrame *)p)->handler;
667 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
672 JMP_(ENTRY_CODE(handler->header.info));