2 % (c) The Parade/AQUA Projects, Glasgow University, 1995
3 % Kevin Hammond, February 15th. 1995
5 % This is for GUM only.
7 %************************************************************************
9 \section[Pack.lc]{Packing closures for export to remote processors}
11 %************************************************************************
13 This module defines routines for packing closures in the parallel runtime
17 #ifdef PAR /* whole file */
22 Static data and code declarations.
25 static W_ PackBuffer[PACK_BUFFER_SIZE+PACK_HDR_SIZE];
26 static W_ packlocn, clqsize, clqpos;
27 static W_ unpackedsize;
28 static W_ reservedPAsize; /*Space reserved for primitive arrays*/
29 static rtsBool RoomInBuffer;
32 static void InitPacking(STG_NO_ARGS), DonePacking(STG_NO_ARGS);
33 static rtsBool NotYetPacking PROTO((int offset)),
34 RoomToPack PROTO((W_ size, W_ ptrs));
35 static void AmPacking PROTO((P_ closure));
37 static void PackClosure PROTO((P_ closure));
38 static void Pack PROTO((W_ data)),
39 PackPLC PROTO((P_ addr)),
40 PackOffset PROTO((int offset)),
41 GlobaliseAndPackGA PROTO((P_ closure));
43 static int OffsetFor PROTO((P_ closure));
46 %************************************************************************
48 \subsection[PackNearbyGraph]{Packing Sections of Nearby Graph}
50 %************************************************************************
52 @PackNearbyGraph@ packs a closure and associated graph into a static
53 buffer (@PackBuffer@). It returns the address of this buffer and the
54 size of the data packed into the buffer (in its second parameter,
55 @packbuffersize@). The associated graph is packed in a depth first
56 manner, hence it uses an explicit queue of closures to be packed
57 rather than simply using a recursive algorithm. Once the packet is
58 full, closures (other than primitive arrays) are packed as FetchMes,
59 and their children are not queued for packing.
63 PackNearbyGraph(closure, packbuffersize)
67 /* Ensure enough heap for all possible RBH_Save closures */
69 if (SAVE_Hp + PACK_HEAP_REQUIRED > SAVE_HpLim)
74 QueueClosure(closure);
76 PackClosure(DeQueueClosure());
77 } while (!QueueEmpty());
79 /* Record how much space is needed to unpack the graph */
80 PackBuffer[0] = unpackedsize;
82 /* Set the size parameter */
83 ASSERT(packlocn <= PACK_BUFFER_SIZE);
84 *packbuffersize = packlocn;
92 @PackTSO@ and @PackStkO@ are entry points for two special kinds of
93 closure which are used in the parallel RTS. Compared with other
94 closures they are rather awkward to pack because they don't follow the
95 normal closure layout (where all pointers occur before all non-pointers).
96 Luckily, they're only needed when migrating threads between processors.
100 PackTSO(tso,packbuffersize)
105 PackBuffer[0] = PackBuffer[1] = 0;
110 PackStkO(stko,packbuffersize)
115 PackBuffer[0] = PackBuffer[1] = 0;
121 %************************************************************************
123 \subsection[PackClosure]{Packing Closures}
125 %************************************************************************
127 @PackClosure@ is the heart of the normal packing code. It packs a
128 single closure into the pack buffer, skipping over any indirections
129 and globalising it as necessary, queues any child pointers for further
130 packing, and turns it into a @FetchMe@ or revertible black hole
131 (@RBH@) locally if it was a thunk. Before the actual closure is
132 packed, a suitable global address (GA) is inserted in the pack buffer.
133 There is always room to pack a fetch-me to the closure (guaranteed by
134 the RoomToPack calculation), and this is packed if there is no room
135 for the entire closure.
137 Space is allocated for any primitive array children of a closure, and
138 hence a primitive array can always be packed along with it's parent
146 W_ size, ptrs, nonptrs, vhs;
149 while ((P_) INFO_PTR(closure) == Ind_info) { /* Don't pack indirection
152 fprintf(stderr, "Shorted an indirection at %x", closure);
154 closure = (P_) IND_CLOSURE_PTR(closure);
157 clpacklocn = OffsetFor(closure);
159 /* If the closure's not already being packed */
160 if (NotYetPacking(clpacklocn)) {
164 * PLCs reside on all of the PEs already. Just pack the address as a GA (a
165 * bit of a kludge, since an address may not fit in *any* of the individual
166 * GA fields). Const, charlike and small intlike closures are converted into
169 switch (INFO_TYPE(INFO_PTR(closure))) {
171 case INFO_CHARLIKE_TYPE:
173 fprintf(stderr, "Packing a charlike %s\n", CHARLIKE_VALUE(closure));
175 PackPLC((P_) CHARLIKE_CLOSURE(CHARLIKE_VALUE(closure)));
178 case INFO_CONST_TYPE:
180 fprintf(stderr, "Packing a const %s\n", CONST_STATIC_CLOSURE(INFO_PTR(closure)));
182 PackPLC(CONST_STATIC_CLOSURE(INFO_PTR(closure)));
185 case INFO_STATIC_TYPE:
186 case INFO_CAF_TYPE: /* For now we ship indirections to CAFs: They are
187 * evaluated on each PE if needed */
189 fprintf(stderr, "Packing a PLC %x\n", closure);
194 case INFO_INTLIKE_TYPE:
196 I_ val = INTLIKE_VALUE(closure);
198 if ((val <= MAX_INTLIKE) && (val >= MIN_INTLIKE)) {
200 fprintf(stderr, "Packing a small intlike %d as a PLC\n", val);
202 PackPLC(INTLIKE_CLOSURE(val));
206 fprintf(stderr, "Packing a big intlike %d as a normal closure\n", val);
213 fprintf(stderr, "Not a PLC: ");
217 /* Otherwise it's not Fixed */
219 info = get_closure_info(closure, &size, &ptrs, &nonptrs, &vhs);
221 if (INFO_TYPE(info) == INFO_FETCHME_TYPE || IS_BLACK_HOLE(info))
222 size = ptrs = nonptrs = vhs = 0;
225 * Now peek ahead to see whether the closure has any primitive array
228 for (i = 0; i < ptrs; ++i) {
230 W_ childSize, childPtrs, childNonPtrs, childVhs;
232 childInfo = get_closure_info(((PP_) (closure))[i + FIXED_HS + vhs],
233 &childSize, &childPtrs, &childNonPtrs, &childVhs);
234 if (IS_BIG_MOTHER(childInfo)) {
235 reservedPAsize += PACK_GA_SIZE + FIXED_HS + childVhs + childNonPtrs
236 + childPtrs * PACK_FETCHME_SIZE;
240 /* Record the location of the GA */
243 /* Pack the global address */
244 GlobaliseAndPackGA(closure);
247 * Pack a fetchme to the closure if it's a black hole, or the buffer is full
248 * and it isn't a primitive array. N.B. Primitive arrays are always packed
249 * (because their parents index into them directly)
252 if (IS_BLACK_HOLE(info) ||
253 !(RoomToPack(PACK_GA_SIZE + FIXED_HS + vhs + nonptrs, ptrs)
254 || IS_BIG_MOTHER(info))) {
256 ASSERT(packlocn > PACK_HDR_SIZE);
258 /* Just pack as a FetchMe */
260 for (i = 0; i < FIXED_HS; ++i) {
261 if (i == INFO_HDR_POSN)
262 Pack((W_) FetchMe_info);
267 unpackedsize += FIXED_HS + FETCHME_CLOSURE_SIZE(dummy);
270 /* At last! A closure we can actually pack! */
272 if (IS_MUTABLE(info) && (INFO_TYPE(info) != INFO_FETCHME_TYPE))
273 fprintf(stderr, "Warning: Replicated a Mutable closure!\n");
275 for (i = 0; i < FIXED_HS + vhs; ++i)
278 for (i = 0; i < ptrs; ++i)
279 QueueClosure(((PP_) (closure))[i + FIXED_HS + vhs]);
281 for (i = 0; i < nonptrs; ++i)
282 Pack(closure[i + FIXED_HS + vhs + ptrs]);
284 unpackedsize += FIXED_HS + (size < MIN_UPD_SIZE ? MIN_UPD_SIZE : size);
287 * Record that this is a revertable black hole so that we can fill in
288 * its address from the fetch reply. Problem: unshared thunks may cause
289 * space leaks this way, their GAs should be deallocated following an
293 if (IS_THUNK(info) && IS_UPDATABLE(info)) {
295 P_ rbh = convertToRBH(closure);
301 /* Pack an indirection to the original closure! */
303 PackOffset(clpacklocn);
307 %************************************************************************
309 \subsection[simple-pack-routines]{Simple Packing Routines}
311 %************************************************************************
313 @Pack@ is the basic packing routine. It just writes a word of
314 data into the pack buffer and increments the pack location.
321 ASSERT(packlocn < PACK_BUFFER_SIZE);
322 PackBuffer[packlocn++] = data;
326 If a closure is local, make it global. Then, divide its weight for export.
327 The GA is then packed into the pack buffer.
331 GlobaliseAndPackGA(closure)
337 if ((ga = LAGAlookup(closure)) == NULL)
338 ga = MakeGlobal(closure, rtsTrue);
339 splitWeight(&packGA, ga);
340 ASSERT(packGA.weight > 0);
343 fprintf(stderr, "Packing (%x, %d, %x)\n",
344 packGA.loc.gc.gtid, packGA.loc.gc.slot, packGA.weight);
346 Pack((W_) packGA.weight);
347 Pack((W_) packGA.loc.gc.gtid);
348 Pack((W_) packGA.loc.gc.slot);
352 @PackPLC@ makes up a bogus GA for a PLC. Weight 0 implies that a PLC
353 address follows instead of PE, slot.
360 Pack(0L); /* weight */
361 Pack((W_) addr); /* address */
365 @PackOffset@ packs a special GA value that will be interpreted as
366 an offset to a closure in the pack buffer. This is used to avoid
367 unfolding the graph structure into a tree.
375 fprintf(stderr,"Packing Offset %d at pack location %u\n",offset,packlocn);
377 Pack(1L); /* weight */
379 Pack(offset); /* slot/offset */
383 %************************************************************************
385 \subsection[pack-offsets]{Offsets into the Pack Buffer}
387 %************************************************************************
389 The offset hash table is used during packing to record the location in
390 the pack buffer of each closure which is packed.
393 static HashTable *offsettable;
396 @InitPacking@ initialises the packing buffer etc.
400 InitPacking(STG_NO_ARGS)
402 packlocn = PACK_HDR_SIZE;
405 RoomInBuffer = rtsTrue;
407 offsettable = allocHashTable();
411 @DonePacking@ is called when we've finished packing. It releases memory
416 DonePacking(STG_NO_ARGS)
418 freeHashTable(offsettable,NULL);
423 @AmPacking@ records that the closure is being packed. Note the abuse
424 of the data field in the hash table -- this saves calling @malloc@!
432 fprintf(stderr, "Packing %#lx (IP %#lx) at %u\n",
433 closure, INFO_PTR(closure), packlocn);
435 insertHashTable(offsettable, (W_) closure, (void *) (W_) packlocn);
439 @OffsetFor@ returns an offset for a closure which is already being
447 return (int) (W_) lookupHashTable(offsettable, (W_) closure);
451 @NotYetPacking@ determines whether the closure's already being packed.
452 Offsets $<$ @PACK_HDR_SIZE@ (e.g. 0) mean no.
456 NotYetPacking(offset)
459 return(offset < PACK_HDR_SIZE);
463 @RoomToPack@ determines whether there's room to pack the closure into
464 the pack buffer based on
466 o how full the buffer is already,
467 o the closures' size and number of pointers (which must be packed as GAs),
468 o the size and number of pointers held by any primitive arrays that it points to
470 It has a *side-effect* in assigning RoomInBuffer to False.
474 RoomToPack(size, ptrs)
478 (packlocn + reservedPAsize + size +
479 ((clqsize - clqpos) + ptrs) * PACK_FETCHME_SIZE >= PACK_BUFFER_SIZE)) {
481 fprintf(stderr, "Buffer full\n");
483 RoomInBuffer = rtsFalse;
485 return (RoomInBuffer);
489 %************************************************************************
491 \subsection[pack-closure-queue]{Closure Queues}
493 %************************************************************************
495 These routines manage the closure queue.
498 static W_ clqpos, clqsize;
499 static P_ ClosureQueue[PACK_BUFFER_SIZE];
502 @InitClosureQueue@ initialises the closure queue.
506 InitClosureQueue(STG_NO_ARGS)
508 clqpos = clqsize = 0;
512 @QueueEmpty@ returns @rtsTrue@ if the closure queue is empty;
513 @rtsFalse@ otherwise.
517 QueueEmpty(STG_NO_ARGS)
519 return(clqpos >= clqsize);
523 @QueueClosure@ adds its argument to the closure queue.
527 QueueClosure(closure)
530 if(clqsize < PACK_BUFFER_SIZE)
531 ClosureQueue[clqsize++] = closure;
534 fprintf(stderr,"Closure Queue Overflow (EnQueueing %lx)\n", (W_)closure);
540 @DeQueueClosure@ returns the head of the closure queue.
544 DeQueueClosure(STG_NO_ARGS)
547 return(ClosureQueue[clqpos++]);
553 %************************************************************************
555 \subsection[pack-ga-types]{Types of Global Addresses}
557 %************************************************************************
559 These routines determine whether a GA is one of a number of special types
567 return (ga->weight == 1 && ga->loc.gc.gtid == 0);
574 return (ga->weight == 0);
578 %************************************************************************
580 \subsection[pack-print-packet]{Printing Packet Contents}
582 %************************************************************************
590 W_ size, ptrs, nonptrs, vhs;
596 W_ pptr = 0, pptrs = 0, pvhs;
598 W_ unpacklocn = PACK_HDR_SIZE;
599 W_ gastart = unpacklocn;
600 W_ closurestart = unpacklocn;
608 /* Unpack the header */
611 fprintf(stderr, "Packed Packet size %u\n\n--- Begin ---\n", bufsize);
614 gastart = unpacklocn;
615 ga.weight = buffer[unpacklocn++];
617 ga.loc.gc.gtid = buffer[unpacklocn++];
618 ga.loc.gc.slot = buffer[unpacklocn++];
620 ga.loc.plc = (P_) buffer[unpacklocn++];
621 closurestart = unpacklocn;
624 fprintf(stderr, "[%u]: PLC @ %#lx\n", gastart, ga.loc.plc);
625 } else if (isOffset(&ga)) {
626 fprintf(stderr, "[%u]: OFFSET TO [%d]\n", gastart, ga.loc.gc.slot);
628 /* Print normal closures */
630 fprintf(stderr, "[%u]: (%x, %d, %x) ", gastart,
631 ga.loc.gc.gtid, ga.loc.gc.slot, ga.weight);
633 info = get_closure_info((P_) (buffer + closurestart), &size, &ptrs, &nonptrs, &vhs);
635 if (INFO_TYPE(info) == INFO_FETCHME_TYPE || IS_BLACK_HOLE(info))
636 size = ptrs = nonptrs = vhs = 0;
638 if (IS_THUNK(info)) {
639 if (IS_UPDATABLE(info))
640 fputs("SHARED ", stderr);
642 fputs("UNSHARED ", stderr);
644 if (IS_BLACK_HOLE(info)) {
645 fputs("BLACK HOLE\n", stderr);
648 fprintf(stderr, "FH [%#lx", buffer[unpacklocn++]);
649 for (i = 1; i < FIXED_HS; i++)
650 fprintf(stderr, " %#lx", buffer[unpacklocn++]);
652 /* Variable header */
654 fprintf(stderr, "] VH [%#lx", buffer[unpacklocn++]);
656 for (i = 1; i < vhs; i++)
657 fprintf(stderr, " %#lx", buffer[unpacklocn++]);
660 fprintf(stderr, "] PTRS %u", ptrs);
664 fprintf(stderr, " NPTRS [%#lx", buffer[unpacklocn++]);
666 for (i = 1; i < nonptrs; i++)
667 fprintf(stderr, " %#lx", buffer[unpacklocn++]);
674 /* Add to queue for processing */
675 QueueClosure((P_) (buffer + closurestart));
678 /* Locate next parent pointer */
680 while (pptr + 1 > pptrs) {
681 parent = DeQueueClosure();
686 (void) get_closure_info(parent, &size, &pptrs, &nonptrs, &pvhs);
690 } while (parent != NULL);
692 fprintf(stderr, "--- End ---\n\n");
697 %************************************************************************
699 \subsection[pack-get-closure-info]{Closure Info}
701 %************************************************************************
703 @get_closure_info@ determines the size, number of pointers etc. for this
704 type of closure -- see @SMInfoTables.lh@ for the legal info. types etc.
706 [Can someone please keep this function up to date. I keep needing it
707 (or something similar) for interpretive code, and it keeps
708 bit-rotting. {\em It really belongs somewhere else too}. KH @@ 17/2/95]
712 get_closure_info(closure, size, ptrs, nonptrs, vhs)
714 W_ *size, *ptrs, *nonptrs, *vhs;
716 P_ ip = (P_) INFO_PTR(closure);
718 switch (INFO_TYPE(ip)) {
719 case INFO_SPEC_U_TYPE:
720 case INFO_SPEC_S_TYPE:
721 case INFO_SPEC_N_TYPE:
722 *size = SPEC_CLOSURE_SIZE(closure);
723 *ptrs = SPEC_CLOSURE_NoPTRS(closure);
724 *nonptrs = SPEC_CLOSURE_NoNONPTRS(closure);
725 *vhs = 0 /*SPEC_VHS*/;
728 case INFO_GEN_U_TYPE:
729 case INFO_GEN_S_TYPE:
730 case INFO_GEN_N_TYPE:
731 *size = GEN_CLOSURE_SIZE(closure);
732 *ptrs = GEN_CLOSURE_NoPTRS(closure);
733 *nonptrs = GEN_CLOSURE_NoNONPTRS(closure);
738 *size = DYN_CLOSURE_SIZE(closure);
739 *ptrs = DYN_CLOSURE_NoPTRS(closure);
740 *nonptrs = DYN_CLOSURE_NoNONPTRS(closure);
744 case INFO_TUPLE_TYPE:
745 *size = TUPLE_CLOSURE_SIZE(closure);
746 *ptrs = TUPLE_CLOSURE_NoPTRS(closure);
747 *nonptrs = TUPLE_CLOSURE_NoNONPTRS(closure);
752 *size = DATA_CLOSURE_SIZE(closure);
753 *ptrs = DATA_CLOSURE_NoPTRS(closure);
754 *nonptrs = DATA_CLOSURE_NoNONPTRS(closure);
758 case INFO_IMMUTUPLE_TYPE:
759 case INFO_MUTUPLE_TYPE:
760 *size = MUTUPLE_CLOSURE_SIZE(closure);
761 *ptrs = MUTUPLE_CLOSURE_NoPTRS(closure);
762 *nonptrs = MUTUPLE_CLOSURE_NoNONPTRS(closure);
766 case INFO_STATIC_TYPE:
767 *size = STATIC_CLOSURE_SIZE(closure);
768 *ptrs = STATIC_CLOSURE_NoPTRS(closure);
769 *nonptrs = STATIC_CLOSURE_NoNONPTRS(closure);
775 *size = IND_CLOSURE_SIZE(closure);
776 *ptrs = IND_CLOSURE_NoPTRS(closure);
777 *nonptrs = IND_CLOSURE_NoNONPTRS(closure);
781 case INFO_CONST_TYPE:
782 *size = CONST_CLOSURE_SIZE(closure);
783 *ptrs = CONST_CLOSURE_NoPTRS(closure);
784 *nonptrs = CONST_CLOSURE_NoNONPTRS(closure);
788 case INFO_SPEC_RBH_TYPE:
789 *size = SPEC_RBH_CLOSURE_SIZE(closure);
790 *ptrs = SPEC_RBH_CLOSURE_NoPTRS(closure);
791 *nonptrs = SPEC_RBH_CLOSURE_NoNONPTRS(closure);
793 *nonptrs -= (2 - *ptrs);
800 case INFO_GEN_RBH_TYPE:
801 *size = GEN_RBH_CLOSURE_SIZE(closure);
802 *ptrs = GEN_RBH_CLOSURE_NoPTRS(closure);
803 *nonptrs = GEN_RBH_CLOSURE_NoNONPTRS(closure);
805 *nonptrs -= (2 - *ptrs);
812 case INFO_CHARLIKE_TYPE:
813 *size = CHARLIKE_CLOSURE_SIZE(closure);
814 *ptrs = CHARLIKE_CLOSURE_NoPTRS(closure);
815 *nonptrs = CHARLIKE_CLOSURE_NoNONPTRS(closure);
819 case INFO_INTLIKE_TYPE:
820 *size = INTLIKE_CLOSURE_SIZE(closure);
821 *ptrs = INTLIKE_CLOSURE_NoPTRS(closure);
822 *nonptrs = INTLIKE_CLOSURE_NoNONPTRS(closure);
826 case INFO_FETCHME_TYPE:
827 *size = FETCHME_CLOSURE_SIZE(closure);
828 *ptrs = FETCHME_CLOSURE_NoPTRS(closure);
829 *nonptrs = FETCHME_CLOSURE_NoNONPTRS(closure);
834 *size = FMBQ_CLOSURE_SIZE(closure);
835 *ptrs = FMBQ_CLOSURE_NoPTRS(closure);
836 *nonptrs = FMBQ_CLOSURE_NoNONPTRS(closure);
841 *size = BQ_CLOSURE_SIZE(closure);
842 *ptrs = BQ_CLOSURE_NoPTRS(closure);
843 *nonptrs = BQ_CLOSURE_NoNONPTRS(closure);
848 *size = BH_CLOSURE_SIZE(closure);
849 *ptrs = BH_CLOSURE_NoPTRS(closure);
850 *nonptrs = BH_CLOSURE_NoNONPTRS(closure);
855 fprintf(stderr, "get_closure_info: Unexpected closure type (%lu), closure %lx\n",
856 INFO_TYPE(ip), (W_) closure);
864 @AllocateHeap@ will bump the heap pointer by @size@ words if the space
865 is available, but it will not perform garbage collection.
875 /* Allocate a new closure */
876 if (SAVE_Hp + size > SAVE_HpLim)
879 newClosure = SAVE_Hp + 1;
886 doGlobalGC(STG_NO_ARGS)
888 fprintf(stderr,"Splat -- we just hit global GC!\n");
895 #endif /* PAR -- whole file */