/* ----------------------------------------------------------------------------
Building Haskell objects from C datatypes.
+
+ TODO: Currently this code does not tag created pointers,
+ however it is not unsafe (the contructor code will do it)
+ just inefficient.
------------------------------------------------------------------------- */
HaskellObj
rts_mkChar (Capability *cap, HsChar c)
// See comment above:
// ASSERT(p->header.info == Czh_con_info ||
// p->header.info == Czh_static_info);
- return (StgChar)(StgWord)(p->payload[0]);
+ return (StgChar)(StgWord)(UNTAG_CLOSURE(p)->payload[0]);
}
HsInt
// See comment above:
// ASSERT(p->header.info == Izh_con_info ||
// p->header.info == Izh_static_info);
- return (HsInt)(p->payload[0]);
+ return (HsInt)(UNTAG_CLOSURE(p)->payload[0]);
}
HsInt8
// See comment above:
// ASSERT(p->header.info == I8zh_con_info ||
// p->header.info == I8zh_static_info);
- return (HsInt8)(HsInt)(p->payload[0]);
+ return (HsInt8)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
}
HsInt16
// See comment above:
// ASSERT(p->header.info == I16zh_con_info ||
// p->header.info == I16zh_static_info);
- return (HsInt16)(HsInt)(p->payload[0]);
+ return (HsInt16)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
}
HsInt32
// See comment above:
// ASSERT(p->header.info == I32zh_con_info ||
// p->header.info == I32zh_static_info);
- return (HsInt32)(HsInt)(p->payload[0]);
+ return (HsInt32)(HsInt)(UNTAG_CLOSURE(p)->payload[0]);
}
HsInt64
// See comment above:
// ASSERT(p->header.info == I64zh_con_info ||
// p->header.info == I64zh_static_info);
- tmp = (HsInt64*)&(p->payload[0]);
+ tmp = (HsInt64*)&(UNTAG_CLOSURE(p)->payload[0]);
return *tmp;
}
HsWord
// See comment above:
// ASSERT(p->header.info == Wzh_con_info ||
// p->header.info == Wzh_static_info);
- return (HsWord)(p->payload[0]);
+ return (HsWord)(UNTAG_CLOSURE(p)->payload[0]);
}
HsWord8
// See comment above:
// ASSERT(p->header.info == W8zh_con_info ||
// p->header.info == W8zh_static_info);
- return (HsWord8)(HsWord)(p->payload[0]);
+ return (HsWord8)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
}
HsWord16
// See comment above:
// ASSERT(p->header.info == W16zh_con_info ||
// p->header.info == W16zh_static_info);
- return (HsWord16)(HsWord)(p->payload[0]);
+ return (HsWord16)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
}
HsWord32
// See comment above:
// ASSERT(p->header.info == W32zh_con_info ||
// p->header.info == W32zh_static_info);
- return (HsWord32)(HsWord)(p->payload[0]);
+ return (HsWord32)(HsWord)(UNTAG_CLOSURE(p)->payload[0]);
}
// See comment above:
// ASSERT(p->header.info == W64zh_con_info ||
// p->header.info == W64zh_static_info);
- tmp = (HsWord64*)&(p->payload[0]);
+ tmp = (HsWord64*)&(UNTAG_CLOSURE(p)->payload[0]);
return *tmp;
}
// See comment above:
// ASSERT(p->header.info == Fzh_con_info ||
// p->header.info == Fzh_static_info);
- return (float)(PK_FLT((P_)p->payload));
+ return (float)(PK_FLT((P_)UNTAG_CLOSURE(p)->payload));
}
HsDouble
// See comment above:
// ASSERT(p->header.info == Dzh_con_info ||
// p->header.info == Dzh_static_info);
- return (double)(PK_DBL((P_)p->payload));
+ return (double)(PK_DBL((P_)UNTAG_CLOSURE(p)->payload));
}
HsStablePtr
// See comment above:
// ASSERT(p->header.info == StablePtr_con_info ||
// p->header.info == StablePtr_static_info);
- return (StgStablePtr)(p->payload[0]);
+ return (StgStablePtr)(UNTAG_CLOSURE(p)->payload[0]);
}
HsPtr
// See comment above:
// ASSERT(p->header.info == Ptr_con_info ||
// p->header.info == Ptr_static_info);
- return (Capability *)(p->payload[0]);
+ return (Capability *)(UNTAG_CLOSURE(p)->payload[0]);
}
HsFunPtr
// See comment above:
// ASSERT(p->header.info == FunPtr_con_info ||
// p->header.info == FunPtr_static_info);
- return (void *)(p->payload[0]);
+ return (void *)(UNTAG_CLOSURE(p)->payload[0]);
}
HsBool
{
StgInfoTable *info;
- info = get_itbl((StgClosure *)p);
+ info = get_itbl((StgClosure *)UNTAG_CLOSURE(p));
if (info->srt_bitmap == 0) { // srt_bitmap is the constructor tag
return 0;
} else {