1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.8 1999/01/27 14:51:23 simonpj Exp $
4 * Code to perform updates.
6 * ---------------------------------------------------------------------------*/
10 #include "HeapStackCheck.h"
14 The update frame return address must be *polymorphic*, that means
15 we have to cope with both vectored and non-vectored returns. This
16 is done by putting the return vector right before the info table, and
17 having a standard direct return address after the info table (pointed
18 to by the return address itself, as usual).
20 Each entry in the vector table points to a specialised entry code fragment
21 that knows how to return after doing the update. It would be possible to
22 use a single generic piece of code that simply entered the return value
23 to return, but it's quicker this way. The direct return code of course
24 just does another direct return when it's finished.
26 Why is there necessarily an activation underneath us on the stack?
27 Because if we're returning, that means we've got a constructor in
28 our hands. If there were any arguments to be applied to it, that
29 would be a type error. We don't ever return a PAP to an update frame,
30 the update is handled manually by stg_update_PAP.
33 /* on entry to the update code
34 (1) R1 points to the closure being returned
35 (2) R2 contains the tag (if we returned directly, non-vectored)
36 (3) Sp points to the update frame
39 /* Why updatee is placed in a temporary variable here: this helps
40 gcc's aliasing by indicating that the location of the updatee
41 doesn't change across assignments. Saves one instruction in the
45 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
49 StgClosure *updatee; \
51 /* tick - ToDo: check this is right */ \
52 TICK_UPD_EXISTING(); \
54 updatee = ((StgUpdateFrame *)Sp)->updatee; \
56 /* update the updatee with an indirection to the return value */\
57 UPD_IND(updatee,R1.p); \
59 /* reset Su to the next update frame */ \
60 Su = ((StgUpdateFrame *)Sp)->link; \
62 /* remove the update frame from the stack */ \
63 Sp += sizeofW(StgUpdateFrame); \
69 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
70 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
71 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
72 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
73 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
74 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
75 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
76 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
77 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
80 Make sure this table is big enough to handle the maximum vectored
85 #define UPD_FRAME_BITMAP 3
87 #define UPD_FRAME_BITMAP 1
90 /* this bitmap indicates that the first word of an update frame is a
91 * non-pointer - this is the update frame link. (for profiling,
92 * there's a cost-centre-stack in there too).
95 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
97 /* -----------------------------------------------------------------------------
100 The idea is to copy the chunk of stack from the PAP object and then
101 re-enter the function closure that failed it's args check in the
104 In fact, we do a little optimisation too, by performing the updates
105 for any update frames sitting on top of the stack. (ToDo: is this
106 really an optimisation? --SDM)
107 -------------------------------------------------------------------------- */
109 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
114 CostCentreStack *CCS_pap;
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 CCS_pap = pap->header.prof.ccs;
144 CCCS = (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap))
145 ? Su->header.prof.ccs
147 #endif /* PROFILING */
150 Sp += sizeofW(StgUpdateFrame);
154 /* Just pop the seq frame and return to the activation record
155 * underneath us - R1 already contains the address of the PAP.
157 Su = ((StgSeqFrame *)Su)->link;
158 Sp += sizeofW(StgSeqFrame);
159 JMP_(ENTRY_CODE(*Sp));
162 /* can't happen, see stg_update_PAP */
163 barf("PAP_entry: CATCH_FRAME");
166 barf("PAP_entry: strange activation record");
174 * Check for stack overflow.
176 STK_CHK_NP(Words,1,);
181 /* Enter PAP cost centre -- lexical scoping only */
182 ENTER_CCS_PAP_CL(pap);
185 p = (P_)(pap->payload);
187 /* Reload the stack */
188 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
192 JMP_(GET_ENTRY(R1.cl));
196 /* -----------------------------------------------------------------------------
197 stg_update_PAP: Update the current closure with a partial application.
199 This function is called whenever an argument satisfaction check fails.
200 -------------------------------------------------------------------------- */
202 EXTFUN(stg_update_PAP)
206 CostCentreStack *CCS_pap;
209 StgClosure *Fun, *Updatee;
215 /* Save the pointer to the function closure that just failed the
216 argument satisfaction check
220 #if defined(GRAN_COUNT)
225 /* Just copy the whole block of stack between the stack pointer
226 * and the update frame pointer for now. This might include some
227 * tagging, which the garbage collector will have to pay attention
228 * to, but it's much easier than sorting the words into pointers
232 Words = (P_)Su - (P_)Sp;
233 ASSERT((int)Words >= 0);
235 #if defined(PROFILING)
236 /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
238 CCS_pap = (CostCentreStack *) Fun->header.prof.ccs;
239 if (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)) {
247 * No arguments, only Node. Skip building the PAP and
248 * just plan to update with an indirection.
251 PapClosure = (StgPAP *)Fun;
256 PapSize = Words + sizeofW(StgPAP);
259 * First we need to do a heap check, which involves saving
260 * everything on the stack. We only have one live pointer:
261 * Fun, the function closure that was passed to us. If the
262 * heap check fails, we push the function closure on the stack
263 * and instruct the scheduler to try entering it again when
264 * the garbage collector has run.
266 * It's done this way because there's a possibility that the
267 * garbage collector might have messed around with the stack,
268 * such as removing the update frame.
270 if ((Hp += PapSize) > HpLim) {
273 JMP_(stg_gc_entertop);
276 TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
278 CCS_ALLOC(CCS_pap, PapSize);
281 PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
283 SET_HDR(PapClosure,&PAP_info,CCS_pap);
284 PapClosure->n_args = Words;
285 PapClosure->fun = Fun;
287 /* Now fill in the closure fields */
290 for (i = Words-1; i >= 0; i--) {
296 * Finished constructing PAP closure; now update the updatee.
299 /* ToDo: we'd like to just jump to the code for PAP_entry here,
300 * which deals with a stack of update frames in one go. What to
301 * do about the special ticky and profiling stuff here?
304 switch (get_itbl(Su)->type) {
307 /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
308 Sp = (P_)Su + sizeofW(StgSeqFrame);
311 Su = ((StgSeqFrame *)Su)->link;
313 /* return to the activation record, with the address of the PAP in R1 */
314 R1.p = (P_)PapClosure;
315 JMP_(ENTRY_CODE(*Sp));
318 /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
319 Sp = (P_)Su + sizeofW(StgCatchFrame);
322 Su = ((StgCatchFrame *)Su)->link;
324 /* restart by entering the PAP */
325 R1.p = (P_)PapClosure;
326 JMP_(GET_ENTRY(R1.cl));
330 * Now we have a standard update frame, so we update the updatee with
331 * either the new PAP or Node.
334 Updatee = Su->updatee;
335 UPD_IND(Updatee,PapClosure);
338 TICK_UPD_PAP_IN_NEW(Words+1);
341 TICK_UPD_PAP_IN_PLACE();
343 #if defined(PROFILING)
345 * Lexical scoping requires a *permanent* indirection, and we
346 * also have to set the cost centre for the indirection.
348 SET_INFO(Updatee, &IND_PERM_info);
349 Updatee->header.prof.ccs = CCS_pap;
350 #endif /* PROFILING */
353 #if defined(PROFILING)
355 * Restore the Cost Centre too (if required); again see Sansom
356 * thesis p 183. Take the CC out of the update frame if a CAF/DICT.
358 CCCS = IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)
359 ? Su->header.prof.ccs
361 #endif /* PROFILING */
367 * Squeeze out update frame from stack.
369 for (i = Words-1; i >= 0; i--) {
370 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
372 Sp += sizeofW(StgUpdateFrame);
376 barf("stg_update_PAP: strange activation record");
380 * All done! Restart by re-entering Node
381 * Don't count this entry for ticky-ticky profiling.
383 JMP_(GET_ENTRY(R1.cl));
388 /* -----------------------------------------------------------------------------
389 Entry Code for an AP_UPD.
391 The idea is to copy the chunk of stack from the AP object and then
392 enter the function closure.
394 (This code is a simplified copy of the PAP code - with all the
395 update frame code stripped out.)
396 -------------------------------------------------------------------------- */
399 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
409 ap = (StgAP_UPD *) R1.p;
414 * Check for stack overflow.
416 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
418 PUSH_UPD_FRAME(R1.p, 0);
419 Sp -= sizeofW(StgUpdateFrame) + Words;
423 /* Enter PAP cost centre -- lexical scoping only */
424 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
427 p = (P_)(ap->payload);
429 /* Reload the stack */
430 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
434 JMP_(GET_ENTRY(R1.cl));
439 /*-----------------------------------------------------------------------------
442 We don't have a primitive seq# operator: it is just a 'case'
443 expression whose scrutinee has either a polymorphic or function type
444 (constructor types can be handled by normal 'case' expressions).
446 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
447 the stack. This is a polymorphic activation record that just pops
448 itself and returns when entered. The purpose of the SEQ_FRAME is to
449 act as a barrier in case the scrutinee is a partial application - in
450 this way it is just like an update frame, except that it doesn't
452 -------------------------------------------------------------------------- */
454 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
458 Su = ((StgSeqFrame *)Sp)->link; \
459 Sp += sizeofW(StgSeqFrame); \
464 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
465 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
466 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
467 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
468 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
469 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
470 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
471 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
472 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
474 VEC_POLY_INFO_TABLE(seq_frame,1, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
476 /* -----------------------------------------------------------------------------
479 * This closure takes one argument, which it evaluates and returns the
480 * result with a direct return (never a vectored return!) in R1. It
481 * does this by pushing a SEQ_FRAME on the stack and
482 * entering its argument.
484 * It is used in deleteThread when reverting blackholes.
485 * -------------------------------------------------------------------------- */
487 INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
491 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
492 Sp -= sizeof(StgSeqFrame);
494 R1.cl = R1.cl->payload[0];
495 JMP_(ENTRY_CODE(*R1.p));
500 /* -----------------------------------------------------------------------------
502 -------------------------------------------------------------------------- */
507 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
512 Su = ((StgCatchFrame *)Sp)->link; \
513 Sp += sizeofW(StgCatchFrame); \
518 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
519 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
520 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
521 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
522 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
523 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
524 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
525 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
526 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
529 #define CATCH_FRAME_BITMAP 3
531 #define CATCH_FRAME_BITMAP 1
534 /* Catch frames are very similar to update frames, but when entering
535 * one we just pop the frame off the stack and perform the correct
536 * kind of return to the activation record underneath us on the stack.
539 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
541 /* -----------------------------------------------------------------------------
542 * The catch infotable
544 * This should be exactly the same as would be generated by this STG code
546 * catch = {x,h} \n {} -> catch#{x,h}
548 * It is used in deleteThread when reverting blackholes.
549 * -------------------------------------------------------------------------- */
551 INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
555 R2.cl = payloadCPtr(R1.cl,1); /* h */
556 R1.cl = payloadCPtr(R1.cl,0); /* x */
566 /* args: R1 = m, R2 = k */
567 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
568 Sp -= sizeofW(StgCatchFrame);
569 fp = (StgCatchFrame *)Sp;
570 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
571 fp -> handler = R2.cl;
573 Su = (StgUpdateFrame *)fp;
574 TICK_CATCHF_PUSHED();
576 JMP_(ENTRY_CODE(*R1.p));
581 /* -----------------------------------------------------------------------------
582 * The raise infotable
584 * This should be exactly the same as would be generated by this STG code
586 * raise = {err} \n {} -> raise#{err}
588 * It is used in raisezh_fast to update thunks on the update list
589 * -------------------------------------------------------------------------- */
591 INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
595 R1.cl = R1.cl->payload[0];
604 StgClosure *raise_closure;
606 /* args : R1 = error */
610 /* This closure represents the expression 'raise# E' where E
611 * is the exception raise. It is used to overwrite all the
612 * thunks which are currently under evaluataion.
614 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
615 sizeofW(StgClosure)+1);
616 raise_closure->header.info = &raise_info;
617 raise_closure->payload[0] = R1.cl;
621 switch (get_itbl(p)->type) {
624 UPD_IND(p->updatee,raise_closure);
629 p = ((StgSeqFrame *)p)->link;
637 barf("raisezh_fast: STOP_FRAME");
640 barf("raisezh_fast: weird activation record");
647 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
648 * and including this frame, update Su, push R1, and enter the handler.
650 Su = ((StgCatchFrame *)p)->link;
651 handler = ((StgCatchFrame *)p)->handler;
653 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
658 JMP_(ENTRY_CODE(handler->header.info));