+ // keep printing components of the stack until we run out of space
+ // in the buffer. If we run out of space, end with "...".
+ for (; ccs != NULL && ccs != CCS_MAIN; ccs = ccs->prevStack) {
+
+ // CAF cost centres print as M.CAF, but we leave the module
+ // name out of all the others to save space.
+ if (!strcmp(ccs->cc->label,"CAF")) {
+ p += buf_append(p, ccs->cc->module, buf_end);
+ p += buf_append(p, ".CAF", buf_end);
+ } else {
+ if (ccs->prevStack != NULL && ccs->prevStack != CCS_MAIN) {
+ p += buf_append(p, "/", buf_end);
+ }
+ p += buf_append(p, ccs->cc->label, buf_end);
+ }
+
+ if (p >= buf_end) {
+ sprintf(buf+max_length-4, "...");
+ break;
+ } else {
+ next_offset += written;
+ }
+ }
+ fprintf(fp, "%s", buf);
+}
+#endif // PROFILING
+
+rtsBool
+strMatchesSelector( char* str, char* sel )
+{
+ char* p;
+ // fprintf(stderr, "str_matches_selector %s %s\n", str, sel);
+ while (1) {
+ // Compare str against wherever we've got to in sel.
+ p = str;
+ while (*p != '\0' && *sel != ',' && *sel != '\0' && *p == *sel) {
+ p++; sel++;
+ }
+ // Match if all of str used and have reached the end of a sel fragment.
+ if (*p == '\0' && (*sel == ',' || *sel == '\0'))
+ return rtsTrue;
+
+ // No match. Advance sel to the start of the next elem.
+ while (*sel != ',' && *sel != '\0') sel++;
+ if (*sel == ',') sel++;
+
+ /* Run out of sel ?? */
+ if (*sel == '\0') return rtsFalse;
+ }
+}
+
+/* -----------------------------------------------------------------------------
+ * Figure out whether a closure should be counted in this census, by
+ * testing against all the specified constraints.
+ * -------------------------------------------------------------------------- */
+rtsBool
+closureSatisfiesConstraints( StgClosure* p )
+{
+#ifdef DEBUG_HEAP_PROF
+ return rtsTrue;
+#else
+ rtsBool b;
+
+ // The CCS has a selected field to indicate whether this closure is
+ // deselected by not being mentioned in the module, CC, or CCS
+ // selectors.
+ if (!p->header.prof.ccs->selected) {
+ return rtsFalse;
+ }
+
+ if (RtsFlags.ProfFlags.descrSelector) {
+ b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_desc,
+ RtsFlags.ProfFlags.descrSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.typeSelector) {
+ b = strMatchesSelector( (get_itbl((StgClosure *)p))->prof.closure_type,
+ RtsFlags.ProfFlags.typeSelector );
+ if (!b) return rtsFalse;
+ }
+ if (RtsFlags.ProfFlags.retainerSelector) {
+ RetainerSet *rs;
+ nat i;
+ // We must check that the retainer set is valid here. One
+ // reason it might not be valid is if this closure is a
+ // a newly deceased weak pointer (i.e. a DEAD_WEAK), since
+ // these aren't reached by the retainer profiler's traversal.
+ if (isRetainerSetFieldValid((StgClosure *)p)) {
+ rs = retainerSetOf((StgClosure *)p);
+ if (rs != NULL) {
+ for (i = 0; i < rs->num; i++) {
+ b = strMatchesSelector( rs->element[i]->cc->label,
+ RtsFlags.ProfFlags.retainerSelector );
+ if (b) return rtsTrue;
+ }
+ }
+ }
+ return rtsFalse;
+ }
+ return rtsTrue;
+#endif /* PROFILING */