C++ SET_HDR函数代码示例

MessageThrowTo *
throwTo (Capability *cap,       // the Capability we hold
         StgTSO *source,        // the TSO sending the exception (or NULL)
         StgTSO *target,        // the TSO receiving the exception
         StgClosure *exception) // the exception closure
{
    MessageThrowTo *msg;

    msg = (MessageThrowTo *) allocate(cap, sizeofW(MessageThrowTo));
    // the message starts locked; see below
    SET_HDR(msg, &stg_WHITEHOLE_info, CCS_SYSTEM);
    msg->source      = source;
    msg->target      = target;
    msg->exception   = exception;

    switch (throwToMsg(cap, msg))
    {
    case THROWTO_SUCCESS:
        // unlock the message now, otherwise we leave a WHITEHOLE in
        // the heap (#6103)
        SET_HDR(msg, &stg_MSG_THROWTO_info, CCS_SYSTEM);
        return NULL;

    case THROWTO_BLOCKED:
    default:
        // the caller will unlock the message when it is ready.  We
        // cannot unlock it yet, because the calling thread will need
        // to tidy up its state first.
        return msg;
    }
}

HaskellObj
rts_mkDouble (Capability *cap, HsDouble d)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,sizeofW(StgDouble)));
  SET_HDR(p, Dzh_con_info, CCS_SYSTEM);
  ASSIGN_DBL((P_)p->payload, (StgDouble)d);
  return p;
}

HaskellObj
rts_mkFunPtr (Capability *cap, HsFunPtr a)
{
  StgClosure *p = (StgClosure *)allocate(cap,sizeofW(StgHeader)+1);
  SET_HDR(p, FunPtr_con_info, CCS_SYSTEM);
  p->payload[0]  = (StgClosure *)a;
  return p;
}

HaskellObj
rts_mkInt32 (Capability *cap, HsInt32 i)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
  SET_HDR(p, I32zh_con_info, CCS_SYSTEM);
  p->payload[0]  = (StgClosure *)(StgInt)i;
  return p;
}

HaskellObj
rts_mkInt64 (Capability *cap, HsInt64 i)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
  SET_HDR(p, I64zh_con_info, CCS_SYSTEM);
  ASSIGN_Int64((P_)&(p->payload[0]), i);
  return p;
}

HaskellObj
rts_mkWord (Capability *cap, HsWord i)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
  SET_HDR(p, Wzh_con_info, CCS_SYSTEM);
  p->payload[0]  = (StgClosure *)(StgWord)i;
  return p;
}

HaskellObj
rts_mkFloat (Capability *cap, HsFloat f)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
  SET_HDR(p, Fzh_con_info, CCS_SYSTEM);
  ASSIGN_FLT((P_)p->payload, (StgFloat)f);
  return p;
}

HaskellObj
rts_mkWord64 (Capability *cap, HsWord64 w)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,2));
  /* see mk_Int8 comment */
  SET_HDR(p, W64zh_con_info, CCS_SYSTEM);
  ASSIGN_Word64((P_)&(p->payload[0]), w);
  return p;
}

HaskellObj
rts_mkWord8 (Capability *cap, HsWord8 w)
{
  /* see rts_mkInt* comments */
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
  SET_HDR(p, W8zh_con_info, CCS_SYSTEM);
  p->payload[0]  = (StgClosure *)(StgWord)(w & 0xff);
  return p;
}

HaskellObj
rts_mkInt16 (Capability *cap, HsInt16 i)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
  SET_HDR(p, I16zh_con_info, CCS_SYSTEM);
  /* Make sure we mask out the relevant bits */
  p->payload[0]  = (StgClosure *)(StgInt)i;
  return p;
}

HaskellObj
rts_mkInt8 (Capability *cap, HsInt8 i)
{
  StgClosure *p = (StgClosure *)allocate(cap,CONSTR_sizeW(0,1));
  SET_HDR(p, I8zh_con_info, CCS_SYSTEM);
  /* Make sure we mask out the bits above the lowest 8 */
  p->payload[0]  = (StgClosure *)(StgInt)i;
  return p;
}

STATIC_INLINE StgInd *
lockCAF (StgRegTable *reg, StgIndStatic *caf)
{
    const StgInfoTable *orig_info;
    Capability *cap = regTableToCapability(reg);
    StgInd *bh;

    orig_info = caf->header.info;

#ifdef THREADED_RTS
    const StgInfoTable *cur_info;

    if (orig_info == &stg_IND_STATIC_info ||
        orig_info == &stg_WHITEHOLE_info) {
        // already claimed by another thread; re-enter the CAF
        return NULL;
    }

    cur_info = (const StgInfoTable *)
        cas((StgVolatilePtr)&caf->header.info,
            (StgWord)orig_info,
            (StgWord)&stg_WHITEHOLE_info);

    if (cur_info != orig_info) {
        // already claimed by another thread; re-enter the CAF
        return NULL;
    }

    // successfully claimed by us; overwrite with IND_STATIC
#endif

    // For the benefit of revertCAFs(), save the original info pointer
    caf->saved_info = orig_info;

    // Allocate the blackhole indirection closure
    bh = (StgInd *)allocate(cap, sizeofW(*bh));
    SET_HDR(bh, &stg_CAF_BLACKHOLE_info, caf->header.prof.ccs);
    bh->indirectee = (StgClosure *)cap->r.rCurrentTSO;

    caf->indirectee = (StgClosure *)bh;
    write_barrier();
    SET_INFO((StgClosure*)caf,&stg_IND_STATIC_info);

    return bh;
}

StgCompactNFData *
compactNew (Capability *cap, StgWord size)
{
    StgWord aligned_size;
    StgCompactNFDataBlock *block;
    StgCompactNFData *self;
    bdescr *bd;

    aligned_size = BLOCK_ROUND_UP(size + sizeof(StgCompactNFData)
                                  + sizeof(StgCompactNFDataBlock));

    // Don't allow sizes larger than a megablock, because we can't use the
    // memory after the first mblock for storing objects.
    if (aligned_size >= BLOCK_SIZE * BLOCKS_PER_MBLOCK)
        aligned_size = BLOCK_SIZE * BLOCKS_PER_MBLOCK;

    block = compactAllocateBlockInternal(cap, aligned_size, NULL,
                                         ALLOCATE_NEW);

    self = firstBlockGetCompact(block);
    SET_HDR((StgClosure*)self, &stg_COMPACT_NFDATA_CLEAN_info, CCS_SYSTEM);
    self->autoBlockW = aligned_size / sizeof(StgWord);
    self->nursery = block;
    self->last = block;
    self->hash = NULL;

    block->owner = self;

    bd = Bdescr((P_)block);
    bd->free = (StgPtr)((W_)self + sizeof(StgCompactNFData));
    self->hp = bd->free;
    self->hpLim = bd->start + bd->blocks * BLOCK_SIZE_W;

    self->totalW = bd->blocks * BLOCK_SIZE_W;

    debugTrace(DEBUG_compact, "compactNew: size %" FMT_Word, size);

    return self;
}

//.........这里部分代码省略.........
        case FUN_1_1:
        case FUN_2_0:
        case FUN_0_2:
        case FUN_STATIC:
            end = closure->payload + info->layout.payload.ptrs;
            for (ptr = closure->payload; ptr < end; ptr++) {
                ptrs[nptrs++] = *ptr;
            }
            break;

        case THUNK:
        case THUNK_1_0:
        case THUNK_0_1:
        case THUNK_1_1:
        case THUNK_2_0:
        case THUNK_0_2:
        case THUNK_STATIC:
            end = ((StgThunk *)closure)->payload + info->layout.payload.ptrs;
            for (ptr = ((StgThunk *)closure)->payload; ptr < end; ptr++) {
                ptrs[nptrs++] = *ptr;
            }
            break;

        case THUNK_SELECTOR:
            ptrs[nptrs++] = ((StgSelector *)closure)->selectee;
            break;
            
        case AP:
            ptrs[nptrs++] = ((StgAP *)closure)->fun;
            gtc_heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
                ((StgAP *)closure)->fun,
                ((StgAP *)closure)->payload,
                ((StgAP *)closure)->n_args);
            break;
            
        case PAP:
            ptrs[nptrs++] = ((StgPAP *)closure)->fun;
            gtc_heap_view_closure_ptrs_in_pap_payload(ptrs, &nptrs,
                ((StgPAP *)closure)->fun,
                ((StgPAP *)closure)->payload,
                ((StgPAP *)closure)->n_args);
            break;
            
        case AP_STACK:
            ptrs[nptrs++] = ((StgAP_STACK *)closure)->fun;
            for (i = 0; i < ((StgAP_STACK *)closure)->size; ++i) {
                ptrs[nptrs++] = ((StgAP_STACK *)closure)->payload[i];
            }
            break;
            
        case BCO:
            ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->instrs;
            ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->literals;
            ptrs[nptrs++] = (StgClosure *)((StgBCO *)closure)->ptrs;
            break;
            
        case IND:
        case IND_PERM:
        case IND_STATIC:
        case BLACKHOLE:
            ptrs[nptrs++] = (StgClosure *)(((StgInd *)closure)->indirectee);
            break;

        case MUT_ARR_PTRS_CLEAN:
        case MUT_ARR_PTRS_DIRTY:
        case MUT_ARR_PTRS_FROZEN:
        case MUT_ARR_PTRS_FROZEN0:
            for (i = 0; i < ((StgMutArrPtrs *)closure)->ptrs; ++i) {
                ptrs[nptrs++] = ((StgMutArrPtrs *)closure)->payload[i];
            }
            break;
        case MUT_VAR_CLEAN:
            ptrs[nptrs++] = ((StgMutVar *)closure)->var;
            break;
        case MVAR_DIRTY:
        case MVAR_CLEAN:
            ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->head;
            ptrs[nptrs++] = (StgClosure *)((StgMVar *)closure)->tail;
            ptrs[nptrs++] = ((StgMVar *)closure)->value;
            break;

        default:
            //fprintf(stderr,"closurePtrs: Cannot handle type %s yet\n", gtc_heap_view_closure_type_names[info->type]);
            break;
    }

    size = nptrs + mutArrPtrsCardTableSize(nptrs);
    StgMutArrPtrs *arr = 
        (StgMutArrPtrs *)allocate(cap, sizeofW(StgMutArrPtrs) + size);
    TICK_ALLOC_PRIM(sizeofW(StgMutArrPtrs), nptrs, 0);
    SET_HDR(arr, &stg_MUT_ARR_PTRS_FROZEN_info, CCCS);
    arr->ptrs = nptrs;
    arr->size = size;

    for (i = 0; i<nptrs; i++) {
        arr->payload[i] = ptrs[i];
    }

    return arr;
}

void
tryWakeupThread (Capability *cap, StgTSO *tso)
{
    traceEventThreadWakeup (cap, tso, tso->cap->no);

#ifdef THREADED_RTS
    if (tso->cap != cap)
    {
        MessageWakeup *msg;
        msg = (MessageWakeup *)allocate(cap,sizeofW(MessageWakeup));
        SET_HDR(msg, &stg_MSG_TRY_WAKEUP_info, CCS_SYSTEM);
        msg->tso = tso;
        sendMessage(cap, tso->cap, (Message*)msg);
        debugTraceCap(DEBUG_sched, cap, "message: try wakeup thread %ld on cap %d",
                      (W_)tso->id, tso->cap->no);
        return;
    }
#endif

    switch (tso->why_blocked)
    {
    case BlockedOnMVar:
    case BlockedOnMVarRead:
    {
        if (tso->_link == END_TSO_QUEUE) {
            tso->block_info.closure = (StgClosure*)END_TSO_QUEUE;
            goto unblock;
        } else {
            return;
        }
    }

    case BlockedOnMsgThrowTo:
    {
        const StgInfoTable *i;

        i = lockClosure(tso->block_info.closure);
        unlockClosure(tso->block_info.closure, i);
        if (i != &stg_MSG_NULL_info) {
            debugTraceCap(DEBUG_sched, cap, "thread %ld still blocked on throwto (%p)",
                          (W_)tso->id, tso->block_info.throwto->header.info);
            return;
        }

        // remove the block frame from the stack
        ASSERT(tso->stackobj->sp[0] == (StgWord)&stg_block_throwto_info);
        tso->stackobj->sp += 3;
        goto unblock;
    }

    case BlockedOnBlackHole:
    case BlockedOnSTM:
    case ThreadMigrating:
        goto unblock;

    default:
        // otherwise, do nothing
        return;
    }

unblock:
    // just run the thread now, if the BH is not really available,
    // we'll block again.
    tso->why_blocked = NotBlocked;
    appendToRunQueue(cap,tso);

    // We used to set the context switch flag here, which would
    // trigger a context switch a short time in the future (at the end
    // of the current nursery block).  The idea is that we have just
    // woken up a thread, so we may need to load-balance and migrate
    // threads to other CPUs.  On the other hand, setting the context
    // switch flag here unfairly penalises the current thread by
    // yielding its time slice too early.
    //
    // The synthetic benchmark nofib/smp/chan can be used to show the
    // difference quite clearly.

    // cap->context_switch = 1;
}