1 /* -----------------------------------------------------------------------------
2 * $Id: Updates.hc,v 1.11 1999/03/22 11:26: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;
338 #if defined(PROFILING)
340 UPD_IND(Updatee,PapClosure);
341 TICK_UPD_PAP_IN_NEW(Words+1);
343 /* Lexical scoping requires a *permanent* indirection, and we
344 * also have to set the cost centre for the indirection.
346 UPD_PERM_IND(Updatee,PapClosure);
347 TICK_UPD_PAP_IN_PLACE();
348 Updatee->header.prof.ccs = CCS_pap;
351 UPD_IND(Updatee,PapClosure);
353 TICK_UPD_PAP_IN_NEW(Words+1);
355 TICK_UPD_PAP_IN_PLACE();
359 #if defined(PROFILING)
361 * Restore the Cost Centre too (if required); again see Sansom
362 * thesis p 183. Take the CC out of the update frame if a CAF/DICT.
364 CCCS = IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)
365 ? Su->header.prof.ccs
367 #endif /* PROFILING */
373 * Squeeze out update frame from stack.
375 for (i = Words-1; i >= 0; i--) {
376 Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
378 Sp += sizeofW(StgUpdateFrame);
382 barf("stg_update_PAP: strange activation record");
386 * All done! Restart by re-entering Node
387 * Don't count this entry for ticky-ticky profiling.
389 JMP_(GET_ENTRY(R1.cl));
394 /* -----------------------------------------------------------------------------
395 Entry Code for an AP_UPD.
397 The idea is to copy the chunk of stack from the AP object and then
398 enter the function closure.
400 (This code is a simplified copy of the PAP code - with all the
401 update frame code stripped out.)
402 -------------------------------------------------------------------------- */
405 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
415 ap = (StgAP_UPD *) R1.p;
420 * Check for stack overflow.
422 STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
424 PUSH_UPD_FRAME(R1.p, 0);
425 Sp -= sizeofW(StgUpdateFrame) + Words;
429 /* Enter PAP cost centre -- lexical scoping only */
430 ENTER_CCS_PAP_CL(ap); /* ToDo: ENTER_CC_AP_UPD_CL */
433 p = (P_)(ap->payload);
435 /* Reload the stack */
436 for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
440 JMP_(GET_ENTRY(R1.cl));
445 /*-----------------------------------------------------------------------------
448 We don't have a primitive seq# operator: it is just a 'case'
449 expression whose scrutinee has either a polymorphic or function type
450 (constructor types can be handled by normal 'case' expressions).
452 To handle a polymorphic/function typed seq, we push a SEQ_FRAME on
453 the stack. This is a polymorphic activation record that just pops
454 itself and returns when entered. The purpose of the SEQ_FRAME is to
455 act as a barrier in case the scrutinee is a partial application - in
456 this way it is just like an update frame, except that it doesn't
458 -------------------------------------------------------------------------- */
460 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret) \
464 Su = ((StgSeqFrame *)Sp)->link; \
465 Sp += sizeofW(StgSeqFrame); \
470 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_entry, ENTRY_CODE(Sp[0]));
471 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_0_entry,ENTRY_CODE(Sp[0]));
472 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_1_entry,ENTRY_CODE(Sp[0]));
473 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_2_entry,ENTRY_CODE(Sp[0]));
474 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_3_entry,ENTRY_CODE(Sp[0]));
475 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_4_entry,ENTRY_CODE(Sp[0]));
476 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_5_entry,ENTRY_CODE(Sp[0]));
477 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_6_entry,ENTRY_CODE(Sp[0]));
478 SEQ_FRAME_ENTRY_TEMPLATE(seq_frame_7_entry,ENTRY_CODE(Sp[0]));
480 VEC_POLY_INFO_TABLE(seq_frame,1, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
482 /* -----------------------------------------------------------------------------
485 * This closure takes one argument, which it evaluates and returns the
486 * result with a direct return (never a vectored return!) in R1. It
487 * does this by pushing a SEQ_FRAME on the stack and
488 * entering its argument.
490 * It is used in deleteThread when reverting blackholes.
491 * -------------------------------------------------------------------------- */
493 INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
497 STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
498 Sp -= sizeof(StgSeqFrame);
500 R1.cl = R1.cl->payload[0];
501 JMP_(ENTRY_CODE(*R1.p));
506 /* -----------------------------------------------------------------------------
508 -------------------------------------------------------------------------- */
513 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret) \
518 Su = ((StgCatchFrame *)Sp)->link; \
519 Sp += sizeofW(StgCatchFrame); \
524 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_entry,ENTRY_CODE(Sp[0]));
525 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_0_entry,RET_VEC(Sp[0],0));
526 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_1_entry,RET_VEC(Sp[0],1));
527 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_2_entry,RET_VEC(Sp[0],2));
528 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_3_entry,RET_VEC(Sp[0],3));
529 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_4_entry,RET_VEC(Sp[0],4));
530 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_5_entry,RET_VEC(Sp[0],5));
531 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_6_entry,RET_VEC(Sp[0],6));
532 CATCH_FRAME_ENTRY_TEMPLATE(catch_frame_7_entry,RET_VEC(Sp[0],7));
535 #define CATCH_FRAME_BITMAP 3
537 #define CATCH_FRAME_BITMAP 1
540 /* Catch frames are very similar to update frames, but when entering
541 * one we just pop the frame off the stack and perform the correct
542 * kind of return to the activation record underneath us on the stack.
545 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
547 /* -----------------------------------------------------------------------------
548 * The catch infotable
550 * This should be exactly the same as would be generated by this STG code
552 * catch = {x,h} \n {} -> catch#{x,h}
554 * It is used in deleteThread when reverting blackholes.
555 * -------------------------------------------------------------------------- */
557 INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
561 R2.cl = payloadCPtr(R1.cl,1); /* h */
562 R1.cl = payloadCPtr(R1.cl,0); /* x */
572 /* args: R1 = m, R2 = k */
573 STK_CHK_GEN(sizeofW(StgCatchFrame), R1_PTR | R2_PTR, catchzh_fast, );
574 Sp -= sizeofW(StgCatchFrame);
575 fp = (StgCatchFrame *)Sp;
576 SET_HDR(fp,(StgInfoTable *)&catch_frame_info,CCCS);
577 fp -> handler = R2.cl;
579 Su = (StgUpdateFrame *)fp;
580 TICK_CATCHF_PUSHED();
582 JMP_(ENTRY_CODE(*R1.p));
587 /* -----------------------------------------------------------------------------
588 * The raise infotable
590 * This should be exactly the same as would be generated by this STG code
592 * raise = {err} \n {} -> raise#{err}
594 * It is used in raisezh_fast to update thunks on the update list
595 * -------------------------------------------------------------------------- */
597 INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
601 R1.cl = R1.cl->payload[0];
610 StgClosure *raise_closure;
612 /* args : R1 = error */
616 /* This closure represents the expression 'raise# E' where E
617 * is the exception raise. It is used to overwrite all the
618 * thunks which are currently under evaluataion.
620 raise_closure = (StgClosure *)RET_STGCALL1(P_,allocate,
621 sizeofW(StgClosure)+1);
622 raise_closure->header.info = &raise_info;
623 raise_closure->payload[0] = R1.cl;
627 switch (get_itbl(p)->type) {
630 UPD_IND(p->updatee,raise_closure);
635 p = ((StgSeqFrame *)p)->link;
643 barf("uncaught exception");
646 barf("raisezh_fast: weird activation record");
653 /* Ok, p points to the enclosing CATCH_FRAME. Pop everything down to
654 * and including this frame, update Su, push R1, and enter the handler.
656 Su = ((StgCatchFrame *)p)->link;
657 handler = ((StgCatchFrame *)p)->handler;
659 Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
664 JMP_(ENTRY_CODE(handler->header.info));