Commit 286a25bb authored by simonmar's avatar simonmar

[project @ 2002-12-02 14:33:10 by simonmar]

Fix a bug and clean up some cruft in here:

 - In each function in the rts_getXXXX() family, there was a test that
   the object is actually of the desired type by examining its info
   table.  Some of these tests were disabled, but there was no comment
   explaining why.  I've just (re-)discovered the reason: the
   info table might be dynamically-loaded in the GHCi case.

   Not all the tests were disabled, which lead to bugs using the FFI
   in GHCi (in particular with functions that return Float or Double).

 - I've added consistent, but commented out, assertions to each of
   the rts_getXXXX() functions, and left a comment explaining why
   these reasonable-looking assertions are disabled.

MERGE TO STABLE
parent 12718d14
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.c,v 1.36 2002/08/16 14:30:21 simonmar Exp $
* $Id: RtsAPI.c,v 1.37 2002/12/02 14:33:10 simonmar Exp $
*
* (c) The GHC Team, 1998-2001
*
......@@ -243,185 +243,150 @@ rts_apply (HaskellObj f, HaskellObj arg)
/* ----------------------------------------------------------------------------
Deconstructing Haskell objects
We would like to assert that we have the right kind of object in
each case, but this is problematic because in GHCi the info table
for the D# constructor (say) might be dynamically loaded. Hence we
omit these assertions for now.
------------------------------------------------------------------------- */
HsChar
rts_getChar (HaskellObj p)
{
if ( p->header.info == Czh_con_info ||
p->header.info == Czh_static_info) {
// See comment above:
// ASSERT(p->header.info == Czh_con_info ||
// p->header.info == Czh_static_info);
return (StgChar)(StgWord)(p->payload[0]);
} else {
barf("rts_getChar: not a Char");
}
}
HsInt
rts_getInt (HaskellObj p)
{
if ( 1 ||
p->header.info == Izh_con_info ||
p->header.info == Izh_static_info ) {
// See comment above:
// ASSERT(p->header.info == Izh_con_info ||
// p->header.info == Izh_static_info);
return (HsInt)(p->payload[0]);
} else {
barf("rts_getInt: not an Int");
}
}
HsInt8
rts_getInt8 (HaskellObj p)
{
if ( 1 ||
p->header.info == I8zh_con_info ||
p->header.info == I8zh_static_info ) {
// See comment above:
// ASSERT(p->header.info == I8zh_con_info ||
// p->header.info == I8zh_static_info);
return (HsInt8)(HsInt)(p->payload[0]);
} else {
barf("rts_getInt8: not an Int8");
}
}
HsInt16
rts_getInt16 (HaskellObj p)
{
if ( 1 ||
p->header.info == I16zh_con_info ||
p->header.info == I16zh_static_info ) {
// See comment above:
// ASSERT(p->header.info == I16zh_con_info ||
// p->header.info == I16zh_static_info);
return (HsInt16)(HsInt)(p->payload[0]);
} else {
barf("rts_getInt16: not an Int16");
}
}
HsInt32
rts_getInt32 (HaskellObj p)
{
if ( 1 ||
p->header.info == I32zh_con_info ||
p->header.info == I32zh_static_info ) {
// See comment above:
// ASSERT(p->header.info == I32zh_con_info ||
// p->header.info == I32zh_static_info);
return (HsInt32)(p->payload[0]);
} else {
barf("rts_getInt32: not an Int32");
}
}
HsInt64
rts_getInt64 (HaskellObj p)
{
HsInt64* tmp;
if ( 1 ||
p->header.info == I64zh_con_info ||
p->header.info == I64zh_static_info ) {
HsInt64* tmp;
// See comment above:
// ASSERT(p->header.info == I64zh_con_info ||
// p->header.info == I64zh_static_info);
tmp = (HsInt64*)&(p->payload[0]);
return *tmp;
} else {
barf("rts_getInt64: not an Int64");
}
}
HsWord
rts_getWord (HaskellObj p)
{
if ( 1 || /* see above comment */
p->header.info == Wzh_con_info ||
p->header.info == Wzh_static_info ) {
// See comment above:
// ASSERT(p->header.info == Wzh_con_info ||
// p->header.info == Wzh_static_info);
return (HsWord)(p->payload[0]);
} else {
barf("rts_getWord: not a Word");
}
}
HsWord8
rts_getWord8 (HaskellObj p)
{
if ( 1 || /* see above comment */
p->header.info == W8zh_con_info ||
p->header.info == W8zh_static_info ) {
// See comment above:
// ASSERT(p->header.info == W8zh_con_info ||
// p->header.info == W8zh_static_info);
return (HsWord8)(HsWord)(p->payload[0]);
} else {
barf("rts_getWord8: not a Word8");
}
}
HsWord16
rts_getWord16 (HaskellObj p)
{
if ( 1 || /* see above comment */
p->header.info == W16zh_con_info ||
p->header.info == W16zh_static_info ) {
// See comment above:
// ASSERT(p->header.info == W16zh_con_info ||
// p->header.info == W16zh_static_info);
return (HsWord16)(HsWord)(p->payload[0]);
} else {
barf("rts_getWord16: not a Word16");
}
}
HsWord32
rts_getWord32 (HaskellObj p)
{
if ( 1 || /* see above comment */
p->header.info == W32zh_con_info ||
p->header.info == W32zh_static_info ) {
return (unsigned int)(p->payload[0]);
} else {
barf("rts_getWord: not a Word");
}
// See comment above:
// ASSERT(p->header.info == W32zh_con_info ||
// p->header.info == W32zh_static_info);
return (HsWord32)(p->payload[0]);
}
HsWord64
rts_getWord64 (HaskellObj p)
{
HsWord64* tmp;
if ( 1 || /* see above comment */
p->header.info == W64zh_con_info ||
p->header.info == W64zh_static_info ) {
HsWord64* tmp;
// See comment above:
// ASSERT(p->header.info == W64zh_con_info ||
// p->header.info == W64zh_static_info);
tmp = (HsWord64*)&(p->payload[0]);
return *tmp;
} else {
barf("rts_getWord64: not a Word64");
}
}
HsFloat
rts_getFloat (HaskellObj p)
{
if ( p->header.info == Fzh_con_info ||
p->header.info == Fzh_static_info ) {
// See comment above:
// ASSERT(p->header.info == Fzh_con_info ||
// p->header.info == Fzh_static_info);
return (float)(PK_FLT((P_)p->payload));
} else {
barf("rts_getFloat: not a Float");
}
}
HsDouble
rts_getDouble (HaskellObj p)
{
if ( p->header.info == Dzh_con_info ||
p->header.info == Dzh_static_info ) {
// See comment above:
// ASSERT(p->header.info == Dzh_con_info ||
// p->header.info == Dzh_static_info);
return (double)(PK_DBL((P_)p->payload));
} else {
barf("rts_getDouble: not a Double");
}
}
HsStablePtr
rts_getStablePtr (HaskellObj p)
{
if ( p->header.info == StablePtr_con_info ||
p->header.info == StablePtr_static_info ) {
// See comment above:
// ASSERT(p->header.info == StablePtr_con_info ||
// p->header.info == StablePtr_static_info);
return (StgStablePtr)(p->payload[0]);
} else {
barf("rts_getStablePtr: not a StablePtr");
}
}
HsPtr
rts_getPtr (HaskellObj p)
{
if ( p->header.info == Ptr_con_info ||
p->header.info == Ptr_static_info ) {
// See comment above:
// ASSERT(p->header.info == Ptr_con_info ||
// p->header.info == Ptr_static_info);
return (void *)(p->payload[0]);
} else {
barf("rts_getPtr: not an Ptr");
}
}
#ifdef COMPILER /* GHC has em, Hugs doesn't */
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment