[project @ 1999-02-05 16:02:18 by simonm]
[ghc-hetmet.git] / ghc / rts / Updates.hc
1 /* -----------------------------------------------------------------------------
2  * $Id: Updates.hc,v 1.9 1999/02/05 16:03:03 simonm Exp $
3  *
4  * (c) The GHC Team, 1998-1999
5  *
6  * Code to perform updates.
7  *
8  * ---------------------------------------------------------------------------*/
9
10 #include "Rts.h"
11 #include "RtsUtils.h"
12 #include "HeapStackCheck.h"
13 #include "Storage.h"
14
15 /*
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).
21
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.
27
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.
33 */
34
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
39    */
40
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
44    update code. 
45    */
46
47 #define UPD_FRAME_ENTRY_TEMPLATE(label,ret)                             \
48         STGFUN(label);                                                  \
49         STGFUN(label)                                                   \
50         {                                                               \
51           StgClosure *updatee;                                          \
52           FB_                                                           \
53           /* tick - ToDo: check this is right */                        \
54           TICK_UPD_EXISTING();                                          \
55                                                                         \
56           updatee = ((StgUpdateFrame *)Sp)->updatee;                    \
57                                                 \
58           /* update the updatee with an indirection to the return value */\
59           UPD_IND(updatee,R1.p);                                        \
60                                                                         \
61           /* reset Su to the next update frame */                       \
62           Su = ((StgUpdateFrame *)Sp)->link;                            \
63                                                                         \
64           /* remove the update frame from the stack */                  \
65           Sp += sizeofW(StgUpdateFrame);                                \
66                                                                         \
67           JMP_(ret);                                                    \
68           FE_                                                           \
69         }
70
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));
80
81 /*
82   Make sure this table is big enough to handle the maximum vectored
83   return size!
84   */
85
86 #ifdef PROFILING
87 #define UPD_FRAME_BITMAP 3
88 #else
89 #define UPD_FRAME_BITMAP 1
90 #endif
91
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).
95  */
96
97 VEC_POLY_INFO_TABLE(Upd_frame,UPD_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, UPDATE_FRAME);
98
99 /* -----------------------------------------------------------------------------
100    Entry Code for a PAP.
101
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
104    first place.
105
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    -------------------------------------------------------------------------- */
110
111 INFO_TABLE(PAP_info,PAP_entry,/*special layout*/0,0,PAP,const,EF_,0,0);
112 STGFUN(PAP_entry)
113 {
114   nat Words;
115 #ifdef PROFILING
116   CostCentreStack *CCS_pap;
117 #endif
118   P_ p;
119   nat i;
120   StgPAP *pap;
121
122   FB_
123     
124   pap = (StgPAP *) R1.p;
125   
126   /*
127    * remove any update frames on the top of the stack, by just
128    * performing the update here.
129    */
130   while ((W_)Su - (W_)Sp == 0) {
131
132     switch (get_itbl(Su)->type) {
133
134     case UPDATE_FRAME:
135       /* We're sitting on top of an update frame, so let's do the business */
136       UPD_IND(Su->updatee, pap);
137
138 #if defined(PROFILING)
139       /* 
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
142        * CAF/DICT.
143        */
144       
145       CCS_pap = pap->header.prof.ccs;
146       CCCS = (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)) 
147                 ? Su->header.prof.ccs 
148                 : CCS_pap;
149 #endif /* PROFILING */
150       
151       Su = Su->link;
152       Sp += sizeofW(StgUpdateFrame);
153       continue;
154
155     case SEQ_FRAME:
156       /* Just pop the seq frame and return to the activation record
157        * underneath us - R1 already contains the address of the PAP.
158        */
159       Su = ((StgSeqFrame *)Su)->link;
160       Sp += sizeofW(StgSeqFrame);
161       JMP_(ENTRY_CODE(*Sp));
162
163     case CATCH_FRAME:
164       /* can't happen, see stg_update_PAP */
165       barf("PAP_entry: CATCH_FRAME");
166
167     default:
168       barf("PAP_entry: strange activation record");
169     }
170
171   }
172
173   Words = pap->n_args;
174
175   /* 
176    * Check for stack overflow.
177    */
178   STK_CHK_NP(Words,1,);
179   Sp -= Words;
180
181   TICK_ENT_PAP(pap);
182
183   /* Enter PAP cost centre -- lexical scoping only */
184   ENTER_CCS_PAP_CL(pap);
185
186   R1.cl = pap->fun;
187   p = (P_)(pap->payload);
188
189   /* Reload the stack */
190   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
191
192   /* Off we go! */
193   TICK_ENT_VIA_NODE();
194   JMP_(GET_ENTRY(R1.cl));
195   FE_
196 }
197
198 /* -----------------------------------------------------------------------------
199    stg_update_PAP: Update the current closure with a partial application.
200
201    This function is called whenever an argument satisfaction check fails.
202    -------------------------------------------------------------------------- */
203
204 EXTFUN(stg_update_PAP)
205 {
206   nat Words, PapSize;
207 #ifdef PROFILING
208   CostCentreStack *CCS_pap;
209 #endif
210   StgPAP* PapClosure;
211   StgClosure *Fun, *Updatee;
212   P_ p;
213   I_ i;
214   
215   FB_
216
217     /* Save the pointer to the function closure that just failed the
218        argument satisfaction check
219        */
220     Fun = R1.cl;
221
222 #if defined(GRAN_COUNT)
223 #error Fixme.
224       ++nPAPs;
225 #endif
226
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
231      * and non-pointers.
232      */
233
234     Words    = (P_)Su - (P_)Sp;
235     ASSERT((int)Words >= 0);
236
237 #if defined(PROFILING)
238     /* set "CC_pap" to go in the updatee (see Sansom thesis, p 183) */
239
240     CCS_pap = (CostCentreStack *) Fun->header.prof.ccs;
241     if (IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)) {
242         CCS_pap = CCCS;
243     }
244 #endif
245
246     if (Words == 0) { 
247
248         /* 
249          * No arguments, only Node.  Skip building the PAP and
250          * just plan to update with an indirection.
251          */
252
253         PapClosure = (StgPAP *)Fun;
254
255     } else {
256            /* Build the PAP */
257
258         PapSize = Words + sizeofW(StgPAP);
259     
260         /*
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.
267          *
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.
271          */
272         if ((Hp += PapSize) > HpLim) {
273           Sp -= 1;
274           Sp[0] = (W_)Fun;          
275           JMP_(stg_gc_entertop);
276         }
277
278         TICK_ALLOC_UPD_PAP(1/*fun*/ + Words, 0);
279 #ifdef PROFILING
280         CCS_ALLOC(CCS_pap, PapSize);
281 #endif
282
283         PapClosure = (StgPAP *)(Hp + 1 - PapSize); /* The new PapClosure */
284
285         SET_HDR(PapClosure,&PAP_info,CCS_pap);
286         PapClosure->n_args = Words;
287         PapClosure->fun = Fun;
288
289         /* Now fill in the closure fields */
290
291         p = Hp;
292         for (i = Words-1; i >= 0; i--) {
293            *p-- = (W_) Sp[i];
294         }
295     }
296
297     /* 
298      * Finished constructing PAP closure; now update the updatee. 
299      */
300
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?
304      */
305
306     switch (get_itbl(Su)->type) {
307
308     case SEQ_FRAME:
309       /* Set Sp to just above the SEQ frame (should be an activation rec.)*/
310       Sp = (P_)Su + sizeofW(StgSeqFrame);
311
312       /* restore Su */
313       Su = ((StgSeqFrame *)Su)->link;
314         
315       /* return to the activation record, with the address of the PAP in R1 */
316       R1.p = (P_)PapClosure;
317       JMP_(ENTRY_CODE(*Sp));
318       
319     case CATCH_FRAME:
320       /* Set Sp to just above the CATCH frame (should be an activation rec.)*/
321       Sp = (P_)Su + sizeofW(StgCatchFrame);
322
323       /* restore Su */
324       Su = ((StgCatchFrame *)Su)->link;
325         
326       /* restart by entering the PAP */
327       R1.p = (P_)PapClosure;
328       JMP_(GET_ENTRY(R1.cl));
329       
330     case UPDATE_FRAME:
331       /* 
332        * Now we have a standard update frame, so we update the updatee with 
333        * either the new PAP or Node.
334        */
335       
336       Updatee = Su->updatee; 
337       UPD_IND(Updatee,PapClosure);
338       
339       if (Words != 0) {
340         TICK_UPD_PAP_IN_NEW(Words+1);
341         
342       } else {
343         TICK_UPD_PAP_IN_PLACE();
344         
345 #if defined(PROFILING)
346         /* 
347          * Lexical scoping requires a *permanent* indirection, and we
348          * also have to set the cost centre for the indirection.
349          */
350         SET_INFO(Updatee, &IND_PERM_info);
351         Updatee->header.prof.ccs = CCS_pap;
352 #endif /* PROFILING */
353       }
354       
355 #if defined(PROFILING)
356       /* 
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.
359        */
360       CCCS = IS_CAF_OR_DICT_OR_SUB_CCS(CCS_pap)
361                 ? Su->header.prof.ccs 
362                 : CCS_pap;
363 #endif /* PROFILING */
364       
365       /* Restore Su */
366       Su = Su->link;
367       
368       /* 
369        * Squeeze out update frame from stack.
370        */
371       for (i = Words-1; i >= 0; i--) {
372         Sp[i+(sizeofW(StgUpdateFrame))] = Sp[i];
373       }
374       Sp += sizeofW(StgUpdateFrame);
375       break;
376       
377     default:
378       barf("stg_update_PAP: strange activation record");
379     }   
380
381     /* 
382      * All done!  Restart by re-entering Node
383      * Don't count this entry for ticky-ticky profiling. 
384      */
385     JMP_(GET_ENTRY(R1.cl));
386     FE_
387
388
389
390 /* -----------------------------------------------------------------------------
391    Entry Code for an AP_UPD.
392
393    The idea is to copy the chunk of stack from the AP object and then
394    enter the function closure.
395
396    (This code is a simplified copy of the PAP code - with all the 
397     update frame code stripped out.)
398    -------------------------------------------------------------------------- */
399
400
401 INFO_TABLE(AP_UPD_info,AP_UPD_entry,/*special layout*/0,0,AP_UPD,const,EF_,0,0);
402 STGFUN(AP_UPD_entry)
403 {
404   nat Words;
405   P_ p;
406   nat i;
407   StgAP_UPD *ap;
408
409   FB_
410     
411   ap = (StgAP_UPD *) R1.p;
412   
413   Words = ap->n_args;
414
415   /* 
416    * Check for stack overflow.
417    */
418   STK_CHK(Words+sizeofW(StgUpdateFrame),AP_UPD_entry,R2.p,1,);
419
420   PUSH_UPD_FRAME(R1.p, 0);
421   Sp -= sizeofW(StgUpdateFrame) + Words;
422
423   TICK_ENT_AP_UPD(ap);
424
425   /* Enter PAP cost centre -- lexical scoping only */
426   ENTER_CCS_PAP_CL(ap);   /* ToDo: ENTER_CC_AP_UPD_CL */
427
428   R1.cl = ap->fun;
429   p = (P_)(ap->payload);
430
431   /* Reload the stack */
432   for (i=0; i<Words; i++) Sp[i] = (W_) *p++;
433
434   /* Off we go! */
435   TICK_ENT_VIA_NODE();
436   JMP_(GET_ENTRY(R1.cl));
437   FE_
438 }
439
440
441 /*-----------------------------------------------------------------------------
442   Seq frames 
443
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).
447
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
453   update anything.
454   -------------------------------------------------------------------------- */
455
456 #define SEQ_FRAME_ENTRY_TEMPLATE(label,ret)     \
457    IFN_(label)                                  \
458    {                                            \
459       FB_                                       \
460       Su = ((StgSeqFrame *)Sp)->link;   \
461       Sp += sizeofW(StgSeqFrame);               \
462       JMP_(ret);                                \
463       FE_                                       \
464    }
465
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]));
475
476 VEC_POLY_INFO_TABLE(seq_frame,1, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, SEQ_FRAME);
477
478 /* -----------------------------------------------------------------------------
479  * The seq infotable
480  *
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.
485  *
486  * It is used in deleteThread when reverting blackholes.
487  * -------------------------------------------------------------------------- */
488
489 INFO_TABLE(seq_info,seq_entry,1,0,FUN,const,EF_,0,0);
490 STGFUN(seq_entry)
491 {
492   FB_
493   STK_CHK_GEN(sizeofW(StgSeqFrame), NO_PTRS, seq_entry, );
494   Sp -= sizeof(StgSeqFrame);
495   PUSH_SEQ_FRAME(Sp);
496   R1.cl = R1.cl->payload[0];
497   JMP_(ENTRY_CODE(*R1.p));         
498   FE_
499 }
500
501
502 /* -----------------------------------------------------------------------------
503    Exception Primitives
504    -------------------------------------------------------------------------- */
505
506 FN_(catchzh_fast);
507 FN_(raisezh_fast);
508
509 #define CATCH_FRAME_ENTRY_TEMPLATE(label,ret)   \
510    FN_(label);                                  \
511    FN_(label)                                   \
512    {                                            \
513       FB_                                       \
514       Su = ((StgCatchFrame *)Sp)->link;         \
515       Sp += sizeofW(StgCatchFrame);             \
516       JMP_(ret);                                \
517       FE_                                       \
518    }
519
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));
529
530 #ifdef PROFILING
531 #define CATCH_FRAME_BITMAP 3
532 #else
533 #define CATCH_FRAME_BITMAP 1
534 #endif
535
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.
539  */
540
541 VEC_POLY_INFO_TABLE(catch_frame, CATCH_FRAME_BITMAP, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, CATCH_FRAME);
542
543 /* -----------------------------------------------------------------------------
544  * The catch infotable
545  *
546  * This should be exactly the same as would be generated by this STG code
547  *
548  * catch = {x,h} \n {} -> catch#{x,h}
549  *
550  * It is used in deleteThread when reverting blackholes.
551  * -------------------------------------------------------------------------- */
552
553 INFO_TABLE(catch_info,catch_entry,2,0,FUN,const,EF_,0,0);
554 STGFUN(catch_entry)
555 {
556   FB_
557   R2.cl = payloadCPtr(R1.cl,1); /* h */
558   R1.cl = payloadCPtr(R1.cl,0); /* x */
559   JMP_(catchzh_fast);
560   FE_
561 }
562
563 FN_(catchzh_fast)
564 {
565   StgCatchFrame *fp;
566   FB_
567
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;
574     fp -> link = Su;
575     Su = (StgUpdateFrame *)fp;
576     TICK_CATCHF_PUSHED();
577     TICK_ENT_VIA_NODE();
578     JMP_(ENTRY_CODE(*R1.p));         
579     
580   FE_
581 }      
582
583 /* -----------------------------------------------------------------------------
584  * The raise infotable
585  * 
586  * This should be exactly the same as would be generated by this STG code
587  *
588  *   raise = {err} \n {} -> raise#{err}
589  *
590  * It is used in raisezh_fast to update thunks on the update list
591  * -------------------------------------------------------------------------- */
592
593 INFO_TABLE(raise_info,raise_entry,1,0,FUN,const,EF_,0,0);
594 STGFUN(raise_entry)
595 {
596   FB_
597   R1.cl = R1.cl->payload[0];
598   JMP_(raisezh_fast);
599   FE_
600 }
601
602 FN_(raisezh_fast)
603 {
604   StgClosure *handler;
605   StgUpdateFrame *p;
606   StgClosure *raise_closure;
607   FB_
608     /* args : R1 = error */
609
610     p = Su;
611
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.
615      */
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;
620
621     while (1) {
622
623       switch (get_itbl(p)->type) {
624
625       case UPDATE_FRAME:
626         UPD_IND(p->updatee,raise_closure);
627         p = p->link;
628         continue;
629
630       case SEQ_FRAME:
631         p = ((StgSeqFrame *)p)->link;
632         continue;
633
634       case CATCH_FRAME:
635         /* found it! */
636         break;
637
638       case STOP_FRAME:
639         barf("raisezh_fast: STOP_FRAME");
640
641       default:
642         barf("raisezh_fast: weird activation record");
643       }
644       
645       break;
646
647     }
648     
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.
651      */
652     Su = ((StgCatchFrame *)p)->link; 
653     handler = ((StgCatchFrame *)p)->handler;
654     
655     Sp = (P_)p + sizeofW(StgCatchFrame) - 1;
656     *Sp = R1.w;
657
658     TICK_ENT_VIA_NODE();
659     R1.cl = handler;
660     JMP_(ENTRY_CODE(handler->header.info));
661     
662   FE_
663 }
664