1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.21 1999/11/09 15:47:00 simonmar 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
50 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
56 Su = (StgUpdateFrame *)((StgUpdateFrame *)Sp)->updatee; \
58 /* Tick - it must be a con, all the paps are handled \
59 * in stg_upd_PAP and PAP_entry below \
61 TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(Su))); \
63 if (Bdescr(updatee)->back != BaseReg) { \
67 UPD_IND_NOLOCK(Su,R1.p); \
69 /* update the updatee with an indirection \
70 * to the return value \
73 /* reset Su to the next update frame */ \
74 Su = ((StgUpdateFrame *)Sp)->link; \
76 /* remove the update frame from the stack */ \
77 Sp += sizeofW(StgUpdateFrame); \
84 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
88 StgClosure *updatee; \
91 updatee = ((StgUpdateFrame *)Sp)->updatee; \
93 /* Tick - it must be a con, all the paps are handled \
94 * in stg_upd_PAP and PAP_entry below \
96 TICK_UPD_CON_IN_NEW(sizeW_fromITBL(get_itbl(updatee))); \
98 UPD_IND(updatee, R1.cl); \
100 /* reset Su to the next update frame */ \
101 Su = ((StgUpdateFrame *)Sp)->link; \
103 /* remove the update frame from the stack */ \
104 Sp += sizeofW(StgUpdateFrame); \
111 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
112 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
113 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
114 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
115 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
116 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
117 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
118 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
119 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
122 Make sure this table is big enough to handle the maximum vectored
127 #define UPD_FRAME_BITMAP 3
129 #define UPD_FRAME_BITMAP 1
132 /* this bitmap indicates that the first word of an update frame is a
133 * non-pointer - this is the update frame link. (for profiling,
134 * there's a cost-centre-stack in there too).
137 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
139 /* -----------------------------------------------------------------------------
140 Entry Code for a PAP.
142 The idea is to copy the chunk of stack from the PAP object and then
143 re-enter the function closure that failed it's args check in the
146 In fact, we do a little optimisation too, by performing the updates
147 for any update frames sitting on top of the stack. (ToDo: is this
148 really an optimisation? --SDM)
149 -------------------------------------------------------------------------- */
151 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,,EF_,0,0);
161 pap = (StgPAP *) R1.p;
164 * remove any update frames on the top of the stack, by just
165 * performing the update here.
167 while ((W_)Su - (W_)Sp == 0) {
169 switch (get_itbl(Su)->type) {
172 /* We're sitting on top of an update frame, so let's do the business */
173 UPD_IND(Su->updatee, pap);
175 #if defined(PROFILING)
177 * Restore the Cost Centre too (if required); again see Sansom
178 * thesis p 183. Take the CC out of the update frame if a
182 CCCS = Su->header.prof.ccs;
183 #endif /* PROFILING */
186 Sp += sizeofW(StgUpdateFrame);
190 /* Just pop the seq frame and return to the activation record
191 * underneath us - R1 already contains the address of the PAP.
193 Su = ((StgSeqFrame *)Su)->link;
194 Sp += sizeofW(StgSeqFrame);
195 JMP_(ENTRY_CODE(*Sp));
198 /* can't happen, see stg_update_PAP */
199 barf("PAP_entry: CATCH_FRAME");
202 barf("PAP_entry: strange activation record");
210 * Check for stack overflow.
212 STK_CHK_NP(Words,1,);
217 /* Enter PAP cost centre -- lexical scoping only */
218 ENTER_CCS_PAP_CL(pap);
221 p = (P_)(pap->payload);
223 /* Reload the stack */
224 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
228 JMP_(GET_ENTRY(R1.cl));
232 /* -----------------------------------------------------------------------------
233 stg_update_PAP: Update the current closure with a partial application.
235 This function is called whenever an argument satisfaction check fails.
236 -------------------------------------------------------------------------- */
238 EXTFUN(stg_update_PAP)
242 CostCentreStack *CCS_pap;
245 StgClosure *Fun, *Updatee;
251 /* Save the pointer to the function closure that just failed the
252 * argument satisfaction check
256 #if defined(GRAN_COUNT)
261 /* Just copy the whole block of stack between the stack pointer
262 * and the update frame pointer.
264 Words = (P_)Su - (P_)Sp;
265 ASSERT((int)Words >= 0);
267 #if defined(PROFILING)
268 /* pretend we just entered the function closure */
276 * No arguments, only Node. Skip building the PAP and
277 * just plan to update with an indirection.
280 PapClosure = (StgPAP *)Fun;
285 PapSize = Words + sizeofW(StgPAP);
288 * First we need to do a heap check, which involves saving
289 * everything on the stack. We only have one live pointer:
290 * Fun, the function closure that was passed to us. If the
291 * heap check fails, we push the function closure on the stack
292 * and instruct the scheduler to try entering it again when
293 * the garbage collector has run.
295 * It's done this way because there's a possibility that the
296 * garbage collector might have messed around with the stack,
297 * such as removing the update frame.
299 if ((Hp += PapSize) > HpLim) {
302 JMP_(stg_gc_entertop);
305 TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
307 CCS_ALLOC(CCS_pap, PapSize);
310 PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
312 SET_HDR(PapClosure,&PAP_info,CCS_pap);
313 PapClosure->n_args = Words;
314 PapClosure->fun = Fun;
316 /* Now fill in the closure fields */
319 for (i = Words-1; i >= 0; i--) {
325 * Finished constructing PAP closure; now update the updatee.
328 /* ToDo: we'd like to just jump to the code for PAP_entry here,
329 * which deals with a stack of update frames in one go. What to
330 * do about the special ticky and profiling stuff here?
333 switch (get_itbl(Su)->type) {
336 /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
337 Sp = (P_)Su + sizeofW(StgSeqFrame);
340 Su = ((StgSeqFrame *)Su)->link;
342 /* return to the activation record, with the address of the PAP in R1 */
343 R1.p = (P_)PapClosure;
344 JMP_(ENTRY_CODE(*Sp));
347 /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
348 Sp = (P_)Su + sizeofW(StgCatchFrame);
351 Su = ((StgCatchFrame *)Su)->link;
353 /* restart by entering the PAP */
354 R1.p = (P_)PapClosure;
355 JMP_(GET_ENTRY(R1.cl));
359 * Now we have a standard update frame, so we update the updatee with
360 * either the new PAP or Node.
363 Updatee = Su->updatee;
365 #if defined(PROFILING)
367 UPD_IND(Updatee,PapClosure);
368 TICK_UPD_PAP_IN_NEW(Words+1);
370 /* Lexical scoping requires a *permanent* indirection, and we
371 * also have to set the cost centre for the indirection.
373 UPD_PERM_IND(Updatee,PapClosure);
374 TICK_UPD_PAP_IN_PLACE();
375 Updatee->header.prof.ccs = CCS_pap;
378 UPD_IND(Updatee,PapClosure);
380 TICK_UPD_PAP_IN_NEW(Words+1);
382 TICK_UPD_PAP_IN_PLACE();
386 #if defined(PROFILING)
387 CCCS = Su->header.prof.ccs;
388 ENTER_CCS_PAP(CCS_pap);
389 #endif /* PROFILING */
395 * Squeeze out update frame from stack.
397 for (i = Words-1; i >= 0; i--) {
398 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
400 Sp += sizeofW(StgUpdateFrame);
404 barf("stg_update_PAP: strange activation record");
408 * All done! Restart by re-entering Node
409 * Don't count this entry for ticky-ticky profiling.
411 JMP_(GET_ENTRY(R1.cl));
416 /* -----------------------------------------------------------------------------
417 Entry Code for an AP_UPD.
419 The idea is to copy the chunk of stack from the AP object and then
420 enter the function closure.
422 (This code is a simplified copy of the PAP code - with all the
423 update frame code stripped out.)
424 -------------------------------------------------------------------------- */
427 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,0,0);
437 ap = (StgAP_UPD *) R1.p;
442 * Check for stack overflow.
444 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
446 PUSH_UPD_FRAME(R1.p, 0);
447 Sp -= sizeofW(StgUpdateFrame) + Words;
451 /* Enter PAP cost centre -- lexical scoping only */
452 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
455 p = (P_)(ap->payload);
457 /* Reload the stack */
458 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
462 JMP_(GET_ENTRY(R1.cl));
467 /*-----------------------------------------------------------------------------
470 We don't have a primitive seq# operator: it is just a 'case'
471 expression whose scrutinee has either a polymorphic or function type
472 (constructor types can be handled by normal 'case' expressions).
474 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
475 the stack. This is a polymorphic activation record that just pops
476 itself and returns when entered. The purpose of the SEQ_FRAME is to
477 act as a barrier in case the scrutinee is a partial application - in
478 this way it is just like an update frame, except that it doesn't
480 -------------------------------------------------------------------------- */
482 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
486 Su = ((StgSeqFrame *)Sp)->link; \
487 Sp += sizeofW(StgSeqFrame); \
492 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
493 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
494 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
495 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
496 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
497 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
498 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
499 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
500 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
502 VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
504 /* -----------------------------------------------------------------------------
507 * This closure takes one argument, which it evaluates and returns the
508 * result with a direct return (never a vectored return!) in R1. It
509 * does this by pushing a SEQ_FRAME on the stack and
510 * entering its argument.
512 * It is used in deleteThread when reverting blackholes.
513 * -------------------------------------------------------------------------- */
515 INFO_TABLE(seq_info,seq_entry,1,0,FUN,,EF_,0,0);
519 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
520 Sp -= sizeofW(StgSeqFrame);
522 R1.cl = R1.cl->payload[0];
523 JMP_(ENTRY_CODE(*R1.p));
528 /* -----------------------------------------------------------------------------
530 -------------------------------------------------------------------------- */
535 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
540 Su = ((StgCatchFrame *)Sp)->link; \
541 Sp += sizeofW(StgCatchFrame); \
546 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
547 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
548 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
549 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
550 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
551 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
552 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
553 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
554 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
557 #define CATCH_FRAME_BITMAP 3
559 #define CATCH_FRAME_BITMAP 1
562 /* Catch frames are very similar to update frames, but when entering
563 * one we just pop the frame off the stack and perform the correct
564 * kind of return to the activation record underneath us on the stack.
567 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
569 /* -----------------------------------------------------------------------------
570 * The catch infotable
572 * This should be exactly the same as would be generated by this STG code
574 * catch = {x,h} \n {} -> catch#{x,h}
576 * It is used in deleteThread when reverting blackholes.
577 * -------------------------------------------------------------------------- */
579 INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
583 R2.cl = payloadCPtr(R1.cl,1); /* h */
584 R1.cl = payloadCPtr(R1.cl,0); /* x */
594 /* args: R1 = m, R2 = k */
595 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
596 Sp -= sizeofW(StgCatchFrame);
597 fp = (StgCatchFrame *)Sp;
598 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
599 fp -> handler = R2.cl;
601 Su = (StgUpdateFrame *)fp;
602 TICK_CATCHF_PUSHED();
604 JMP_(ENTRY_CODE(*R1.p));
609 /* -----------------------------------------------------------------------------
610 * The raise infotable
612 * This should be exactly the same as would be generated by this STG code
614 * raise = {err} \n {} -> raise#{err}
616 * It is used in raisezh_fast to update thunks on the update list
617 * -------------------------------------------------------------------------- */
619 INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
623 R1.cl = R1.cl->payload[0];
632 StgClosure *raise_closure;
634 /* args : R1 = error */
638 /* This closure represents the expression 'raise# E' where E
639 * is the exception raise. It is used to overwrite all the
640 * thunks which are currently under evaluataion.
642 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
643 sizeofW(StgClosure)+1);
644 raise_closure->header.info = &raise_info;
645 raise_closure->payload[0] = R1.cl;
649 switch (get_itbl(p)->type) {
652 UPD_IND(p->updatee,raise_closure);
657 p = ((StgSeqFrame *)p)->link;
665 barf("raisezh_fast: STOP_FRAME");
668 barf("raisezh_fast: weird activation record");
675 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
676 * and including this frame, update Su, push R1, and enter the handler.
678 Su = ((StgCatchFrame *)p)->link;
679 handler = ((StgCatchFrame *)p)->handler;
681 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
686 JMP_(ENTRY_CODE(handler->header.info));