1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.9 1999/02/05 16:03:03 simonm Exp $
4 * (c) The GHC Team, 1998-1999
6 * Code to perform updates.
8 * ---------------------------------------------------------------------------*/
12 #include "HeapStackCheck.h"
16 The update frame return address must be *polymorphic*, that means
17 we have to cope with both vectored and non-vectored returns. This
18 is done by putting the return vector right before the info table, and
19 having a standard direct return address after the info table (pointed
20 to by the return address itself, as usual).
22 Each entry in the vector table points to a specialised entry code fragment
23 that knows how to return after doing the update. It would be possible to
24 use a single generic piece of code that simply entered the return value
25 to return, but it's quicker this way. The direct return code of course
26 just does another direct return when it's finished.
28 Why is there necessarily an activation underneath us on the stack?
29 Because if we're returning, that means we've got a constructor in
30 our hands. If there were any arguments to be applied to it, that
31 would be a type error. We don't ever return a PAP to an update frame,
32 the update is handled manually by stg_update_PAP.
35 /* on entry to the update code
36 (1) R1 points to the closure being returned
37 (2) R2 contains the tag (if we returned directly, non-vectored)
38 (3) Sp points to the update frame
41 /* Why updatee is placed in a temporary variable here: this helps
42 gcc's aliasing by indicating that the location of the updatee
43 doesn't change across assignments. Saves one instruction in the
47 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret) \
51 StgClosure *updatee; \
53 /* tick - ToDo: check this is right */ \
54 TICK_UPD_EXISTING(); \
56 updatee = ((StgUpdateFrame *)Sp)->updatee; \
58 /* update the updatee with an indirection to the return value */\
59 UPD_IND(updatee,R1.p); \
61 /* reset Su to the next update frame */ \
62 Su = ((StgUpdateFrame *)Sp)->link; \
64 /* remove the update frame from the stack */ \
65 Sp += sizeofW(StgUpdateFrame); \
71 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_entry,ENTRY_CODE(Sp[0]));
72 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_0_entry,RET_VEC(Sp[0],0));
73 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_1_entry,RET_VEC(Sp[0],1));
74 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_2_entry,RET_VEC(Sp[0],2));
75 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_3_entry,RET_VEC(Sp[0],3));
76 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_4_entry,RET_VEC(Sp[0],4));
77 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_5_entry,RET_VEC(Sp[0],5));
78 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_6_entry,RET_VEC(Sp[0],6));
79 UPD_FRAME_ENTRY_TEMPLATE(Upd_frame_7_entry,RET_VEC(Sp[0],7));
82 Make sure this table is big enough to handle the maximum vectored
87 #define UPD_FRAME_BITMAP 3
89 #define UPD_FRAME_BITMAP 1
92 /* this bitmap indicates that the first word of an update frame is a
93 * non-pointer - this is the update frame link. (for profiling,
94 * there's a cost-centre-stack in there too).
97 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
99 /* -----------------------------------------------------------------------------
100 Entry Code for a PAP.
102 The idea is to copy the chunk of stack from the PAP object and then
103 re-enter the function closure that failed it's args check in the
106 In fact, we do a little optimisation too, by performing the updates
107 for any update frames sitting on top of the stack. (ToDo: is this
108 really an optimisation? --SDM)
109 -------------------------------------------------------------------------- */
111 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
116 CostCentreStack *CCS_pap;
124 pap = (StgPAP *) R1.p;
127 * remove any update frames on the top of the stack, by just
128 * performing the update here.
130 while ((W_)Su - (W_)Sp == 0) {
132 switch (get_itbl(Su)->type) {
135 /* We're sitting on top of an update frame, so let's do the business */
136 UPD_IND(Su->updatee, pap);
138 #if defined(PROFILING)
140 * Restore the Cost Centre too (if required); again see Sansom
141 * thesis p 183. Take the CC out of the update frame if a
145 CCS_pap = pap->header.prof.ccs;
146 CCCS = (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap))
147 ? Su->header.prof.ccs
149 #endif /* PROFILING */
152 Sp += sizeofW(StgUpdateFrame);
156 /* Just pop the seq frame and return to the activation record
157 * underneath us - R1 already contains the address of the PAP.
159 Su = ((StgSeqFrame *)Su)->link;
160 Sp += sizeofW(StgSeqFrame);
161 JMP_(ENTRY_CODE(*Sp));
164 /* can't happen, see stg_update_PAP */
165 barf("PAP_entry: CATCH_FRAME");
168 barf("PAP_entry: strange activation record");
176 * Check for stack overflow.
178 STK_CHK_NP(Words,1,);
183 /* Enter PAP cost centre -- lexical scoping only */
184 ENTER_CCS_PAP_CL(pap);
187 p = (P_)(pap->payload);
189 /* Reload the stack */
190 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
194 JMP_(GET_ENTRY(R1.cl));
198 /* -----------------------------------------------------------------------------
199 stg_update_PAP: Update the current closure with a partial application.
201 This function is called whenever an argument satisfaction check fails.
202 -------------------------------------------------------------------------- */
204 EXTFUN(stg_update_PAP)
208 CostCentreStack *CCS_pap;
211 StgClosure *Fun, *Updatee;
217 /* Save the pointer to the function closure that just failed the
218 argument satisfaction check
222 #if defined(GRAN_COUNT)
227 /* Just copy the whole block of stack between the stack pointer
228 * and the update frame pointer for now. This might include some
229 * tagging, which the garbage collector will have to pay attention
230 * to, but it's much easier than sorting the words into pointers
234 Words = (P_)Su - (P_)Sp;
235 ASSERT((int)Words >= 0);
237 #if defined(PROFILING)
238 /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
240 CCS_pap = (CostCentreStack *) Fun->header.prof.ccs;
241 if (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)) {
249 * No arguments, only Node. Skip building the PAP and
250 * just plan to update with an indirection.
253 PapClosure = (StgPAP *)Fun;
258 PapSize = Words + sizeofW(StgPAP);
261 * First we need to do a heap check, which involves saving
262 * everything on the stack. We only have one live pointer:
263 * Fun, the function closure that was passed to us. If the
264 * heap check fails, we push the function closure on the stack
265 * and instruct the scheduler to try entering it again when
266 * the garbage collector has run.
268 * It's done this way because there's a possibility that the
269 * garbage collector might have messed around with the stack,
270 * such as removing the update frame.
272 if ((Hp += PapSize) > HpLim) {
275 JMP_(stg_gc_entertop);
278 TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
280 CCS_ALLOC(CCS_pap, PapSize);
283 PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
285 SET_HDR(PapClosure,&PAP_info,CCS_pap);
286 PapClosure->n_args = Words;
287 PapClosure->fun = Fun;
289 /* Now fill in the closure fields */
292 for (i = Words-1; i >= 0; i--) {
298 * Finished constructing PAP closure; now update the updatee.
301 /* ToDo: we'd like to just jump to the code for PAP_entry here,
302 * which deals with a stack of update frames in one go. What to
303 * do about the special ticky and profiling stuff here?
306 switch (get_itbl(Su)->type) {
309 /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
310 Sp = (P_)Su + sizeofW(StgSeqFrame);
313 Su = ((StgSeqFrame *)Su)->link;
315 /* return to the activation record, with the address of the PAP in R1 */
316 R1.p = (P_)PapClosure;
317 JMP_(ENTRY_CODE(*Sp));
320 /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
321 Sp = (P_)Su + sizeofW(StgCatchFrame);
324 Su = ((StgCatchFrame *)Su)->link;
326 /* restart by entering the PAP */
327 R1.p = (P_)PapClosure;
328 JMP_(GET_ENTRY(R1.cl));
332 * Now we have a standard update frame, so we update the updatee with
333 * either the new PAP or Node.
336 Updatee = Su->updatee;
337 UPD_IND(Updatee,PapClosure);
340 TICK_UPD_PAP_IN_NEW(Words+1);
343 TICK_UPD_PAP_IN_PLACE();
345 #if defined(PROFILING)
347 * Lexical scoping requires a *permanent* indirection, and we
348 * also have to set the cost centre for the indirection.
350 SET_INFO(Updatee, &IND_PERM_info);
351 Updatee->header.prof.ccs = CCS_pap;
352 #endif /* PROFILING */
355 #if defined(PROFILING)
357 * Restore the Cost Centre too (if required); again see Sansom
358 * thesis p 183. Take the CC out of the update frame if a CAF/DICT.
360 CCCS = IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)
361 ? Su->header.prof.ccs
363 #endif /* PROFILING */
369 * Squeeze out update frame from stack.
371 for (i = Words-1; i >= 0; i--) {
372 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
374 Sp += sizeofW(StgUpdateFrame);
378 barf("stg_update_PAP: strange activation record");
382 * All done! Restart by re-entering Node
383 * Don't count this entry for ticky-ticky profiling.
385 JMP_(GET_ENTRY(R1.cl));
390 /* -----------------------------------------------------------------------------
391 Entry Code for an AP_UPD.
393 The idea is to copy the chunk of stack from the AP object and then
394 enter the function closure.
396 (This code is a simplified copy of the PAP code - with all the
397 update frame code stripped out.)
398 -------------------------------------------------------------------------- */
401 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
411 ap = (StgAP_UPD *) R1.p;
416 * Check for stack overflow.
418 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
420 PUSH_UPD_FRAME(R1.p, 0);
421 Sp -= sizeofW(StgUpdateFrame) + Words;
425 /* Enter PAP cost centre -- lexical scoping only */
426 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
429 p = (P_)(ap->payload);
431 /* Reload the stack */
432 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
436 JMP_(GET_ENTRY(R1.cl));
441 /*-----------------------------------------------------------------------------
444 We don't have a primitive seq# operator: it is just a 'case'
445 expression whose scrutinee has either a polymorphic or function type
446 (constructor types can be handled by normal 'case' expressions).
448 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
449 the stack. This is a polymorphic activation record that just pops
450 itself and returns when entered. The purpose of the SEQ_FRAME is to
451 act as a barrier in case the scrutinee is a partial application - in
452 this way it is just like an update frame, except that it doesn't
454 -------------------------------------------------------------------------- */
456 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
460 Su = ((StgSeqFrame *)Sp)->link; \
461 Sp += sizeofW(StgSeqFrame); \
466 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
467 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
468 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
469 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
470 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
471 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
472 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
473 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
474 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
476 VEC_POLY_INFO_TABLE(seq_frame,1, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
478 /* -----------------------------------------------------------------------------
481 * This closure takes one argument, which it evaluates and returns the
482 * result with a direct return (never a vectored return!) in R1. It
483 * does this by pushing a SEQ_FRAME on the stack and
484 * entering its argument.
486 * It is used in deleteThread when reverting blackholes.
487 * -------------------------------------------------------------------------- */
489 INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
493 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
494 Sp -= sizeof(StgSeqFrame);
496 R1.cl = R1.cl->payload[0];
497 JMP_(ENTRY_CODE(*R1.p));
502 /* -----------------------------------------------------------------------------
504 -------------------------------------------------------------------------- */
509 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
514 Su = ((StgCatchFrame *)Sp)->link; \
515 Sp += sizeofW(StgCatchFrame); \
520 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
521 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
522 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
523 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
524 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
525 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
526 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
527 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
528 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
531 #define CATCH_FRAME_BITMAP 3
533 #define CATCH_FRAME_BITMAP 1
536 /* Catch frames are very similar to update frames, but when entering
537 * one we just pop the frame off the stack and perform the correct
538 * kind of return to the activation record underneath us on the stack.
541 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
543 /* -----------------------------------------------------------------------------
544 * The catch infotable
546 * This should be exactly the same as would be generated by this STG code
548 * catch = {x,h} \n {} -> catch#{x,h}
550 * It is used in deleteThread when reverting blackholes.
551 * -------------------------------------------------------------------------- */
553 INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
557 R2.cl = payloadCPtr(R1.cl,1); /* h */
558 R1.cl = payloadCPtr(R1.cl,0); /* x */
568 /* args: R1 = m, R2 = k */
569 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
570 Sp -= sizeofW(StgCatchFrame);
571 fp = (StgCatchFrame *)Sp;
572 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
573 fp -> handler = R2.cl;
575 Su = (StgUpdateFrame *)fp;
576 TICK_CATCHF_PUSHED();
578 JMP_(ENTRY_CODE(*R1.p));
583 /* -----------------------------------------------------------------------------
584 * The raise infotable
586 * This should be exactly the same as would be generated by this STG code
588 * raise = {err} \n {} -> raise#{err}
590 * It is used in raisezh_fast to update thunks on the update list
591 * -------------------------------------------------------------------------- */
593 INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
597 R1.cl = R1.cl->payload[0];
606 StgClosure *raise_closure;
608 /* args : R1 = error */
612 /* This closure represents the expression 'raise# E' where E
613 * is the exception raise. It is used to overwrite all the
614 * thunks which are currently under evaluataion.
616 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
617 sizeofW(StgClosure)+1);
618 raise_closure->header.info = &raise_info;
619 raise_closure->payload[0] = R1.cl;
623 switch (get_itbl(p)->type) {
626 UPD_IND(p->updatee,raise_closure);
631 p = ((StgSeqFrame *)p)->link;
639 barf("raisezh_fast: STOP_FRAME");
642 barf("raisezh_fast: weird activation record");
649 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
650 * and including this frame, update Su, push R1, and enter the handler.
652 Su = ((StgCatchFrame *)p)->link;
653 handler = ((StgCatchFrame *)p)->handler;
655 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
660 JMP_(ENTRY_CODE(handler->header.info));