1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.19 1999/09/14 12:16:36 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
49 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
53 StgClosure *updatee; \
56 updatee = ((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(updatee))); \
63 /* update the updatee with an indirection to the return value */\
64 UPD_IND(updatee,R1.p); \
66 /* reset Su to the next update frame */ \
67 Su = ((StgUpdateFrame *)Sp)->link; \
69 /* remove the update frame from the stack */ \
70 Sp += sizeofW(StgUpdateFrame); \
76 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
77 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
78 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
79 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
80 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
81 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
82 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
83 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
84 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
87 Make sure this table is big enough to handle the maximum vectored
92 #define UPD_FRAME_BITMAP 3
94 #define UPD_FRAME_BITMAP 1
97 /* this bitmap indicates that the first word of an update frame is a
98 * non-pointer - this is the update frame link. (for profiling,
99 * there's a cost-centre-stack in there too).
102 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME,, EF_);
104 /* -----------------------------------------------------------------------------
105 Entry Code for a PAP.
107 The idea is to copy the chunk of stack from the PAP object and then
108 re-enter the function closure that failed it's args check in the
111 In fact, we do a little optimisation too, by performing the updates
112 for any update frames sitting on top of the stack. (ToDo: is this
113 really an optimisation? --SDM)
114 -------------------------------------------------------------------------- */
116 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,,EF_,0,0);
126 pap = (StgPAP *) R1.p;
129 * remove any update frames on the top of the stack, by just
130 * performing the update here.
132 while ((W_)Su - (W_)Sp == 0) {
134 switch (get_itbl(Su)->type) {
137 /* We're sitting on top of an update frame, so let's do the business */
138 UPD_IND(Su->updatee, pap);
140 #if defined(PROFILING)
142 * Restore the Cost Centre too (if required); again see Sansom
143 * thesis p 183. Take the CC out of the update frame if a
147 CCCS = Su->header.prof.ccs;
148 #endif /* PROFILING */
151 Sp += sizeofW(StgUpdateFrame);
155 /* Just pop the seq frame and return to the activation record
156 * underneath us - R1 already contains the address of the PAP.
158 Su = ((StgSeqFrame *)Su)->link;
159 Sp += sizeofW(StgSeqFrame);
160 JMP_(ENTRY_CODE(*Sp));
163 /* can't happen, see stg_update_PAP */
164 barf("PAP_entry: CATCH_FRAME");
167 barf("PAP_entry: strange activation record");
175 * Check for stack overflow.
177 STK_CHK_NP(Words,1,);
182 /* Enter PAP cost centre -- lexical scoping only */
183 ENTER_CCS_PAP_CL(pap);
186 p = (P_)(pap->payload);
188 /* Reload the stack */
189 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
193 JMP_(GET_ENTRY(R1.cl));
197 /* -----------------------------------------------------------------------------
198 stg_update_PAP: Update the current closure with a partial application.
200 This function is called whenever an argument satisfaction check fails.
201 -------------------------------------------------------------------------- */
203 EXTFUN(stg_update_PAP)
207 CostCentreStack *CCS_pap;
210 StgClosure *Fun, *Updatee;
216 /* Save the pointer to the function closure that just failed the
217 * argument satisfaction check
221 #if defined(GRAN_COUNT)
226 /* Just copy the whole block of stack between the stack pointer
227 * and the update frame pointer.
229 Words = (P_)Su - (P_)Sp;
230 ASSERT((int)Words >= 0);
232 #if defined(PROFILING)
233 /* pretend we just entered the function closure */
241 * No arguments, only Node. Skip building the PAP and
242 * just plan to update with an indirection.
245 PapClosure = (StgPAP *)Fun;
250 PapSize = Words + sizeofW(StgPAP);
253 * First we need to do a heap check, which involves saving
254 * everything on the stack. We only have one live pointer:
255 * Fun, the function closure that was passed to us. If the
256 * heap check fails, we push the function closure on the stack
257 * and instruct the scheduler to try entering it again when
258 * the garbage collector has run.
260 * It's done this way because there's a possibility that the
261 * garbage collector might have messed around with the stack,
262 * such as removing the update frame.
264 if ((Hp += PapSize) > HpLim) {
267 JMP_(stg_gc_entertop);
270 TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
272 CCS_ALLOC(CCS_pap, PapSize);
275 PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
277 SET_HDR(PapClosure,&PAP_info,CCS_pap);
278 PapClosure->n_args = Words;
279 PapClosure->fun = Fun;
281 /* Now fill in the closure fields */
284 for (i = Words-1; i >= 0; i--) {
290 * Finished constructing PAP closure; now update the updatee.
293 /* ToDo: we'd like to just jump to the code for PAP_entry here,
294 * which deals with a stack of update frames in one go. What to
295 * do about the special ticky and profiling stuff here?
298 switch (get_itbl(Su)->type) {
301 /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
302 Sp = (P_)Su + sizeofW(StgSeqFrame);
305 Su = ((StgSeqFrame *)Su)->link;
307 /* return to the activation record, with the address of the PAP in R1 */
308 R1.p = (P_)PapClosure;
309 JMP_(ENTRY_CODE(*Sp));
312 /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
313 Sp = (P_)Su + sizeofW(StgCatchFrame);
316 Su = ((StgCatchFrame *)Su)->link;
318 /* restart by entering the PAP */
319 R1.p = (P_)PapClosure;
320 JMP_(GET_ENTRY(R1.cl));
324 * Now we have a standard update frame, so we update the updatee with
325 * either the new PAP or Node.
328 Updatee = Su->updatee;
330 #if defined(PROFILING)
332 UPD_IND(Updatee,PapClosure);
333 TICK_UPD_PAP_IN_NEW(Words+1);
335 /* Lexical scoping requires a *permanent* indirection, and we
336 * also have to set the cost centre for the indirection.
338 UPD_PERM_IND(Updatee,PapClosure);
339 TICK_UPD_PAP_IN_PLACE();
340 Updatee->header.prof.ccs = CCS_pap;
343 UPD_IND(Updatee,PapClosure);
345 TICK_UPD_PAP_IN_NEW(Words+1);
347 TICK_UPD_PAP_IN_PLACE();
351 #if defined(PROFILING)
352 CCCS = Su->header.prof.ccs;
353 ENTER_CCS_PAP(CCS_pap);
354 #endif /* PROFILING */
360 * Squeeze out update frame from stack.
362 for (i = Words-1; i >= 0; i--) {
363 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
365 Sp += sizeofW(StgUpdateFrame);
369 barf("stg_update_PAP: strange activation record");
373 * All done! Restart by re-entering Node
374 * Don't count this entry for ticky-ticky profiling.
376 JMP_(GET_ENTRY(R1.cl));
381 /* -----------------------------------------------------------------------------
382 Entry Code for an AP_UPD.
384 The idea is to copy the chunk of stack from the AP object and then
385 enter the function closure.
387 (This code is a simplified copy of the PAP code - with all the
388 update frame code stripped out.)
389 -------------------------------------------------------------------------- */
392 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,,EF_,0,0);
402 ap = (StgAP_UPD *) R1.p;
407 * Check for stack overflow.
409 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
411 PUSH_UPD_FRAME(R1.p, 0);
412 Sp -= sizeofW(StgUpdateFrame) + Words;
416 /* Enter PAP cost centre -- lexical scoping only */
417 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
420 p = (P_)(ap->payload);
422 /* Reload the stack */
423 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
427 JMP_(GET_ENTRY(R1.cl));
432 /*-----------------------------------------------------------------------------
435 We don't have a primitive seq# operator: it is just a 'case'
436 expression whose scrutinee has either a polymorphic or function type
437 (constructor types can be handled by normal 'case' expressions).
439 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
440 the stack. This is a polymorphic activation record that just pops
441 itself and returns when entered. The purpose of the SEQ_FRAME is to
442 act as a barrier in case the scrutinee is a partial application - in
443 this way it is just like an update frame, except that it doesn't
445 -------------------------------------------------------------------------- */
447 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
451 Su = ((StgSeqFrame *)Sp)->link; \
452 Sp += sizeofW(StgSeqFrame); \
457 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
458 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
459 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
460 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
461 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
462 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
463 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
464 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
465 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
467 VEC_POLY_INFO_TABLE(seq_frame, UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME,, EF_);
469 /* -----------------------------------------------------------------------------
472 * This closure takes one argument, which it evaluates and returns the
473 * result with a direct return (never a vectored return!) in R1. It
474 * does this by pushing a SEQ_FRAME on the stack and
475 * entering its argument.
477 * It is used in deleteThread when reverting blackholes.
478 * -------------------------------------------------------------------------- */
480 INFO_TABLE(seq_info,seq_entry,1,0,FUN,,EF_,0,0);
484 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
485 Sp -= sizeofW(StgSeqFrame);
487 R1.cl = R1.cl->payload[0];
488 JMP_(ENTRY_CODE(*R1.p));
493 /* -----------------------------------------------------------------------------
495 -------------------------------------------------------------------------- */
500 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
505 Su = ((StgCatchFrame *)Sp)->link; \
506 Sp += sizeofW(StgCatchFrame); \
511 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
512 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
513 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
514 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
515 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
516 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
517 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
518 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
519 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
522 #define CATCH_FRAME_BITMAP 3
524 #define CATCH_FRAME_BITMAP 1
527 /* Catch frames are very similar to update frames, but when entering
528 * one we just pop the frame off the stack and perform the correct
529 * kind of return to the activation record underneath us on the stack.
532 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME,, EF_);
534 /* -----------------------------------------------------------------------------
535 * The catch infotable
537 * This should be exactly the same as would be generated by this STG code
539 * catch = {x,h} \n {} -> catch#{x,h}
541 * It is used in deleteThread when reverting blackholes.
542 * -------------------------------------------------------------------------- */
544 INFO_TABLE(catch_info,catch_entry,2,0,FUN,,EF_,0,0);
548 R2.cl = payloadCPtr(R1.cl,1); /* h */
549 R1.cl = payloadCPtr(R1.cl,0); /* x */
559 /* args: R1 = m, R2 = k */
560 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
561 Sp -= sizeofW(StgCatchFrame);
562 fp = (StgCatchFrame *)Sp;
563 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
564 fp -> handler = R2.cl;
566 Su = (StgUpdateFrame *)fp;
567 TICK_CATCHF_PUSHED();
569 JMP_(ENTRY_CODE(*R1.p));
574 /* -----------------------------------------------------------------------------
575 * The raise infotable
577 * This should be exactly the same as would be generated by this STG code
579 * raise = {err} \n {} -> raise#{err}
581 * It is used in raisezh_fast to update thunks on the update list
582 * -------------------------------------------------------------------------- */
584 INFO_TABLE(raise_info,raise_entry,1,0,FUN,,EF_,0,0);
588 R1.cl = R1.cl->payload[0];
597 StgClosure *raise_closure;
599 /* args : R1 = error */
603 /* This closure represents the expression 'raise# E' where E
604 * is the exception raise. It is used to overwrite all the
605 * thunks which are currently under evaluataion.
607 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
608 sizeofW(StgClosure)+1);
609 raise_closure->header.info = &raise_info;
610 raise_closure->payload[0] = R1.cl;
614 switch (get_itbl(p)->type) {
617 UPD_IND(p->updatee,raise_closure);
622 p = ((StgSeqFrame *)p)->link;
630 barf("raisezh_fast: STOP_FRAME");
633 barf("raisezh_fast: weird activation record");
640 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
641 * and including this frame, update Su, push R1, and enter the handler.
643 Su = ((StgCatchFrame *)p)->link;
644 handler = ((StgCatchFrame *)p)->handler;
646 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
651 JMP_(ENTRY_CODE(handler->header.info));