annotate C-- calls that do not return

  * The correct definition of C-- requires that a procedure not
    'fall off the end'.  The 'never returns' annotation tells us
    if a (foreign) call is not going to return.

    Validated!

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 5b3ad16..442eb60 100644 (file)
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -12,6 +12,7 @@ module Cmm (
        CmmInfo(..), UpdateFrame(..),
         CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
        GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,
        CmmInfo(..), UpdateFrame(..),
         CmmInfoTable(..), ClosureTypeInfo(..), ProfilingInfo(..), ClosureTypeTag,
        GenBasicBlock(..), CmmBasicBlock, blockId, blockStmts, mapBlockStmts,

+        ReturnInfo(..),

        CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
         CmmSafety(..),
        CmmCallTarget(..),
        CmmStmt(..), CmmActuals, CmmFormal, CmmFormals, CmmHintFormals,
         CmmSafety(..),
        CmmCallTarget(..),

@@ -140,6 +141,9 @@ data ClosureTypeInfo
       [Maybe LocalReg]  -- Forced stack parameters
       C_SRT
 
       [Maybe LocalReg]  -- Forced stack parameters
       C_SRT
 

+data ReturnInfo = MayReturn
+                | NeverReturns
+

 -- TODO: These types may need refinement
 data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
 type ClosureTypeTag = StgHalfWord
 -- TODO: These types may need refinement
 data ProfilingInfo = ProfilingInfo CmmLit CmmLit -- closure_type, closure_desc
 type ClosureTypeTag = StgHalfWord

diff --git a/compiler/cmm/CmmLex.x b/compiler/cmm/CmmLex.x
index ec9f585..5b8aa98 100644 (file)
--- a/compiler/cmm/CmmLex.x
+++ b/compiler/cmm/CmmLex.x
@@ -138,8 +138,10 @@ data CmmToken
   | CmmT_if
   | CmmT_jump
   | CmmT_foreign
   | CmmT_if
   | CmmT_jump
   | CmmT_foreign

+  | CmmT_never

   | CmmT_prim
   | CmmT_return
   | CmmT_prim
   | CmmT_return

+  | CmmT_returns

   | CmmT_import
   | CmmT_switch
   | CmmT_case
   | CmmT_import
   | CmmT_switch
   | CmmT_case

@@ -214,8 +216,10 @@ reservedWordsFM = listToUFM $
        ( "if",                 CmmT_if ),
        ( "jump",               CmmT_jump ),
        ( "foreign",            CmmT_foreign ),
        ( "if",                 CmmT_if ),
        ( "jump",               CmmT_jump ),
        ( "foreign",            CmmT_foreign ),

+       ( "never",              CmmT_never ),

        ( "prim",               CmmT_prim ),
        ( "return",             CmmT_return ),
        ( "prim",               CmmT_prim ),
        ( "return",             CmmT_return ),

+       ( "returns",            CmmT_returns ),

        ( "import",             CmmT_import ),
        ( "switch",             CmmT_switch ),
        ( "case",               CmmT_case ),
        ( "import",             CmmT_import ),
        ( "switch",             CmmT_switch ),
        ( "case",               CmmT_case ),

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index c2dd22f..bce6f27 100644 (file)
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -103,8 +103,10 @@ import System.Exit
        'if'            { L _ (CmmT_if) }
        'jump'          { L _ (CmmT_jump) }
        'foreign'       { L _ (CmmT_foreign) }
        'if'            { L _ (CmmT_if) }
        'jump'          { L _ (CmmT_jump) }
        'foreign'       { L _ (CmmT_foreign) }

+       'never'         { L _ (CmmT_never) }

        'prim'          { L _ (CmmT_prim) }
        'return'        { L _ (CmmT_return) }
        'prim'          { L _ (CmmT_prim) }
        'return'        { L _ (CmmT_return) }

+       'returns'       { L _ (CmmT_returns) }

        'import'        { L _ (CmmT_import) }
        'switch'        { L _ (CmmT_switch) }
        'case'          { L _ (CmmT_case) }
        'import'        { L _ (CmmT_import) }
        'switch'        { L _ (CmmT_switch) }
        'case'          { L _ (CmmT_case) }

@@ -318,8 +320,8 @@ stmt        :: { ExtCode }
        -- we tweak the syntax to avoid the conflict.  The later
        -- option is taken here because the other way would require
        -- multiple levels of expanding and get unwieldy.
        -- we tweak the syntax to avoid the conflict.  The later
        -- option is taken here because the other way would require
        -- multiple levels of expanding and get unwieldy.

-       | maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' safety vols ';'
-               {% foreignCall $3 $1 $4 $6 $9 $8 }
+       | maybe_results 'foreign' STRING expr '(' hint_exprs0 ')' safety vols opt_never_returns ';'
+               {% foreignCall $3 $1 $4 $6 $9 $8 $10 }

        | maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' safety vols ';'
                {% primCall $1 $4 $6 $9 $8 }
        -- stmt-level macros, stealing syntax from ordinary C-- function calls.
        | maybe_results 'prim' '%' NAME '(' hint_exprs0 ')' safety vols ';'
                {% primCall $1 $4 $6 $9 $8 }
        -- stmt-level macros, stealing syntax from ordinary C-- function calls.

@@ -337,6 +339,10 @@ stmt       :: { ExtCode }
        | 'if' bool_expr '{' body '}' else      
                { ifThenElse $2 $4 $6 }
 
        | 'if' bool_expr '{' body '}' else      
                { ifThenElse $2 $4 $6 }
 

+opt_never_returns :: { ReturnInfo }
+        :                               { MayReturn }
+        | 'never' 'returns'             { NeverReturns }
+

 bool_expr :: { ExtFCode BoolExpr }
        : bool_op                       { $1 }
        | expr                          { do e <- $1; return (BoolTest e) }
 bool_expr :: { ExtFCode BoolExpr }
        : bool_op                       { $1 }
        | expr                          { do e <- $1; return (BoolTest e) }

@@ -867,8 +873,9 @@ foreignCall
        -> [ExtFCode (CmmExpr,MachHint)]
        -> Maybe [GlobalReg]
         -> CmmSafety
        -> [ExtFCode (CmmExpr,MachHint)]
        -> Maybe [GlobalReg]
         -> CmmSafety

+        -> ReturnInfo

         -> P ExtCode
         -> P ExtCode

-foreignCall conv_string results_code expr_code args_code vols safety
+foreignCall conv_string results_code expr_code args_code vols safety _ret

   = do  convention <- case conv_string of
           "C" -> return CCallConv
           "C--" -> return CmmCallConv
   = do  convention <- case conv_string of
           "C" -> return CCallConv
           "C--" -> return CmmCallConv

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index dcfd02a..1fc3605 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -1987,4 +1987,4 @@ findModule' hsc_env mod_name maybe_pkg =
 getHistorySpan :: Session -> History -> IO SrcSpan
 getHistorySpan sess h = withSession sess $ \hsc_env -> 
                           return$ InteractiveEval.getHistorySpan hsc_env h
 getHistorySpan :: Session -> History -> IO SrcSpan
 getHistorySpan sess h = withSession sess $ \hsc_env -> 
                           return$ InteractiveEval.getHistorySpan hsc_env h

-#endif
\ No newline at end of file
+#endif

diff --git a/rts/Apply.cmm b/rts/Apply.cmm
index cf8a108..c9c7daa 100644 (file)
--- a/rts/Apply.cmm
+++ b/rts/Apply.cmm
@@ -58,7 +58,7 @@ stg_ap_0_fast
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_PAP,/*special layout*/0,0,PAP,"PAP","PAP")

-{  foreign "C" barf("PAP object entered!"); }
+{  foreign "C" barf("PAP object entered!") never returns; }

     
 stg_PAP_apply
 {
     
 stg_PAP_apply
 {

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 4cce586..f3f23d6 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1969,7 +1969,7 @@ waitReadzh_fast
 {
     /* args: R1 */
 #ifdef THREADED_RTS
 {
     /* args: R1 */
 #ifdef THREADED_RTS

-    foreign "C" barf("waitRead# on threaded RTS");
+    foreign "C" barf("waitRead# on threaded RTS") never returns;

 #else
 
     ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
 #else
 
     ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);

@@ -1986,7 +1986,7 @@ waitWritezh_fast
 {
     /* args: R1 */
 #ifdef THREADED_RTS
 {
     /* args: R1 */
 #ifdef THREADED_RTS

-    foreign "C" barf("waitWrite# on threaded RTS");
+    foreign "C" barf("waitWrite# on threaded RTS") never returns;

 #else
 
     ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);
 #else
 
     ASSERT(StgTSO_why_blocked(CurrentTSO) == NotBlocked::I16);

@@ -2011,7 +2011,7 @@ delayzh_fast
 #endif
 
 #ifdef THREADED_RTS
 #endif
 
 #ifdef THREADED_RTS

-    foreign "C" barf("delay# on threaded RTS");
+    foreign "C" barf("delay# on threaded RTS") never returns;

 #else
 
     /* args: R1 (microsecond delay amount) */
 #else
 
     /* args: R1 (microsecond delay amount) */

@@ -2077,7 +2077,7 @@ asyncReadzh_fast
     CInt reqID;
 
 #ifdef THREADED_RTS
     CInt reqID;
 
 #ifdef THREADED_RTS

-    foreign "C" barf("asyncRead# on threaded RTS");
+    foreign "C" barf("asyncRead# on threaded RTS") never returns;

 #else
 
     /* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
 #else
 
     /* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */

@@ -2105,7 +2105,7 @@ asyncWritezh_fast
     CInt reqID;
 
 #ifdef THREADED_RTS
     CInt reqID;
 
 #ifdef THREADED_RTS

-    foreign "C" barf("asyncWrite# on threaded RTS");
+    foreign "C" barf("asyncWrite# on threaded RTS") never returns;

 #else
 
     /* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */
 #else
 
     /* args: R1 = fd, R2 = isSock, R3 = len, R4 = buf */

@@ -2133,7 +2133,7 @@ asyncDoProczh_fast
     CInt reqID;
 
 #ifdef THREADED_RTS
     CInt reqID;
 
 #ifdef THREADED_RTS

-    foreign "C" barf("asyncDoProc# on threaded RTS");
+    foreign "C" barf("asyncDoProc# on threaded RTS") never returns;

 #else
 
     /* args: R1 = proc, R2 = param */
 #else
 
     /* args: R1 = proc, R2 = param */

diff --git a/rts/StgMiscClosures.cmm b/rts/StgMiscClosures.cmm
index c6cc541..9e1eaf9 100644 (file)
--- a/rts/StgMiscClosures.cmm
+++ b/rts/StgMiscClosures.cmm
@@ -343,13 +343,13 @@ INFO_TABLE(stg_RBH,1,1,RBH,"RBH","RBH")
 }
 
 INFO_TABLE(stg_RBH_Save_0,0,2,CONSTR,"RBH_Save_0","RBH_Save_0")
 }
 
 INFO_TABLE(stg_RBH_Save_0,0,2,CONSTR,"RBH_Save_0","RBH_Save_0")

-{ foreign "C" barf("RBH_Save_0 object entered!"); }
+{ foreign "C" barf("RBH_Save_0 object entered!") never returns; }

 
 INFO_TABLE(stg_RBH_Save_1,1,1,CONSTR,"RBH_Save_1","RBH_Save_1");
 
 INFO_TABLE(stg_RBH_Save_1,1,1,CONSTR,"RBH_Save_1","RBH_Save_1");

-{ foreign "C" barf("RBH_Save_1 object entered!"); }
+{ foreign "C" barf("RBH_Save_1 object entered!") never returns; }

 
 INFO_TABLE(stg_RBH_Save_2,2,0,CONSTR,"RBH_Save_2","RBH_Save_2");
 
 INFO_TABLE(stg_RBH_Save_2,2,0,CONSTR,"RBH_Save_2","RBH_Save_2");

-{ foreign "C" barf("RBH_Save_2 object entered!"); }
+{ foreign "C" barf("RBH_Save_2 object entered!") never returns; }

 
 #endif /* defined(PAR) || defined(GRAN) */
 
 
 #endif /* defined(PAR) || defined(GRAN) */
 

@@ -386,10 +386,10 @@ INFO_TABLE(stg_CAF_BLACKHOLE,0,1,CAF_BLACKHOLE,"CAF_BLACKHOLE","CAF_BLACKHOLE")
 
 #ifdef EAGER_BLACKHOLING
 INFO_TABLE(stg_SE_BLACKHOLE,0,1,SE_BLACKHOLE,"SE_BLACKHOLE","SE_BLACKHOLE")
 
 #ifdef EAGER_BLACKHOLING
 INFO_TABLE(stg_SE_BLACKHOLE,0,1,SE_BLACKHOLE,"SE_BLACKHOLE","SE_BLACKHOLE")

-{ foreign "C" barf("SE_BLACKHOLE object entered!"); }
+{ foreign "C" barf("SE_BLACKHOLE object entered!") never returns; }

 
 INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_BLACKHOLE")
 
 INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_BLACKHOLE")

-{ foreign "C" barf("SE_CAF_BLACKHOLE object entered!"); }
+{ foreign "C" barf("SE_CAF_BLACKHOLE object entered!") never returns; }

 #endif
 
 /* ----------------------------------------------------------------------------
 #endif
 
 /* ----------------------------------------------------------------------------

@@ -400,7 +400,7 @@ INFO_TABLE(stg_SE_CAF_BLACKHOLE,0,1,SE_CAF_BLACKHOLE,"SE_CAF_BLACKHOLE","SE_CAF_
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_WHITEHOLE, 0,0, BLACKHOLE, "WHITEHOLE", "WHITEHOLE")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_WHITEHOLE, 0,0, BLACKHOLE, "WHITEHOLE", "WHITEHOLE")

-{ foreign "C" barf("WHITEHOLE object entered!"); }
+{ foreign "C" barf("WHITEHOLE object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    Some static info tables for things that don't get entered, and
 
 /* ----------------------------------------------------------------------------
    Some static info tables for things that don't get entered, and

@@ -409,7 +409,7 @@ INFO_TABLE(stg_WHITEHOLE, 0,0, BLACKHOLE, "WHITEHOLE", "WHITEHOLE")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")

-{ foreign "C" barf("TSO object entered!"); }
+{ foreign "C" barf("TSO object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    Evacuees are left behind by the garbage collector.  Any attempt to enter
 
 /* ----------------------------------------------------------------------------
    Evacuees are left behind by the garbage collector.  Any attempt to enter

@@ -417,7 +417,7 @@ INFO_TABLE(stg_TSO, 0,0,TSO, "TSO", "TSO")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_EVACUATED,1,0,EVACUATED,"EVACUATED","EVACUATED")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_EVACUATED,1,0,EVACUATED,"EVACUATED","EVACUATED")

-{ foreign "C" barf("EVACUATED object entered!"); }
+{ foreign "C" barf("EVACUATED object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    Weak pointers
 
 /* ----------------------------------------------------------------------------
    Weak pointers

@@ -428,7 +428,7 @@ INFO_TABLE(stg_EVACUATED,1,0,EVACUATED,"EVACUATED","EVACUATED")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_WEAK,0,4,WEAK,"WEAK","WEAK")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_WEAK,0,4,WEAK,"WEAK","WEAK")

-{ foreign "C" barf("WEAK object entered!"); }
+{ foreign "C" barf("WEAK object entered!") never returns; }

 
 /*
  * It's important when turning an existing WEAK into a DEAD_WEAK
 
 /*
  * It's important when turning an existing WEAK into a DEAD_WEAK

@@ -437,7 +437,7 @@ INFO_TABLE(stg_WEAK,0,4,WEAK,"WEAK","WEAK")
  * DEAD_WEAK 4 non-pointer fields, the same as WEAK.
  */
 INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,4,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
  * DEAD_WEAK 4 non-pointer fields, the same as WEAK.
  */
 INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,4,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")

-{ foreign "C" barf("DEAD_WEAK object entered!"); }
+{ foreign "C" barf("DEAD_WEAK object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    NO_FINALIZER
 
 /* ----------------------------------------------------------------------------
    NO_FINALIZER

@@ -447,7 +447,7 @@ INFO_TABLE_CONSTR(stg_DEAD_WEAK,0,4,0,CONSTR,"DEAD_WEAK","DEAD_WEAK")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_FINALIZER")

-{ foreign "C" barf("NO_FINALIZER object entered!"); }
+{ foreign "C" barf("NO_FINALIZER object entered!") never returns; }

 
 CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
 
 
 CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
 

@@ -456,7 +456,7 @@ CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER);
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_STABLE_NAME,0,1,STABLE_NAME,"STABLE_NAME","STABLE_NAME")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_STABLE_NAME,0,1,STABLE_NAME,"STABLE_NAME","STABLE_NAME")

-{ foreign "C" barf("STABLE_NAME object entered!"); }
+{ foreign "C" barf("STABLE_NAME object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    MVars
 
 /* ----------------------------------------------------------------------------
    MVars

@@ -466,44 +466,44 @@ INFO_TABLE(stg_STABLE_NAME,0,1,STABLE_NAME,"STABLE_NAME","STABLE_NAME")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_FULL_MVAR,3,0,MVAR,"MVAR","MVAR")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_FULL_MVAR,3,0,MVAR,"MVAR","MVAR")

-{ foreign "C" barf("FULL_MVAR object entered!"); }
+{ foreign "C" barf("FULL_MVAR object entered!") never returns; }

 
 INFO_TABLE(stg_EMPTY_MVAR,3,0,MVAR,"MVAR","MVAR")
 
 INFO_TABLE(stg_EMPTY_MVAR,3,0,MVAR,"MVAR","MVAR")

-{ foreign "C" barf("EMPTY_MVAR object entered!"); }
+{ foreign "C" barf("EMPTY_MVAR object entered!") never returns; }

 
 /* -----------------------------------------------------------------------------
    STM
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_TVAR, 0, 0, TVAR, "TVAR", "TVAR")
 
 /* -----------------------------------------------------------------------------
    STM
    -------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_TVAR, 0, 0, TVAR, "TVAR", "TVAR")

-{ foreign "C" barf("TVAR object entered!"); }
+{ foreign "C" barf("TVAR object entered!") never returns; }

 
 INFO_TABLE(stg_TVAR_WATCH_QUEUE, 0, 0, TVAR_WATCH_QUEUE, "TVAR_WATCH_QUEUE", "TVAR_WATCH_QUEUE")
 
 INFO_TABLE(stg_TVAR_WATCH_QUEUE, 0, 0, TVAR_WATCH_QUEUE, "TVAR_WATCH_QUEUE", "TVAR_WATCH_QUEUE")

-{ foreign "C" barf("TVAR_WATCH_QUEUE object entered!"); }
+{ foreign "C" barf("TVAR_WATCH_QUEUE object entered!") never returns; }

 
 INFO_TABLE(stg_ATOMIC_INVARIANT, 0, 0, ATOMIC_INVARIANT, "ATOMIC_INVARIANT", "ATOMIC_INVARIANT")
 
 INFO_TABLE(stg_ATOMIC_INVARIANT, 0, 0, ATOMIC_INVARIANT, "ATOMIC_INVARIANT", "ATOMIC_INVARIANT")

-{ foreign "C" barf("ATOMIC_INVARIANT object entered!"); }
+{ foreign "C" barf("ATOMIC_INVARIANT object entered!") never returns; }

 
 INFO_TABLE(stg_INVARIANT_CHECK_QUEUE, 0, 0, INVARIANT_CHECK_QUEUE, "INVARIANT_CHECK_QUEUE", "INVARIANT_CHECK_QUEUE")
 
 INFO_TABLE(stg_INVARIANT_CHECK_QUEUE, 0, 0, INVARIANT_CHECK_QUEUE, "INVARIANT_CHECK_QUEUE", "INVARIANT_CHECK_QUEUE")

-{ foreign "C" barf("INVARIANT_CHECK_QUEUE object entered!"); }
+{ foreign "C" barf("INVARIANT_CHECK_QUEUE object entered!") never returns; }

 
 INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")
 
 INFO_TABLE(stg_TREC_CHUNK, 0, 0, TREC_CHUNK, "TREC_CHUNK", "TREC_CHUNK")

-{ foreign "C" barf("TREC_CHUNK object entered!"); }
+{ foreign "C" barf("TREC_CHUNK object entered!") never returns; }

 
 INFO_TABLE(stg_TREC_HEADER, 0, 0, TREC_HEADER, "TREC_HEADER", "TREC_HEADER")
 
 INFO_TABLE(stg_TREC_HEADER, 0, 0, TREC_HEADER, "TREC_HEADER", "TREC_HEADER")

-{ foreign "C" barf("TREC_HEADER object entered!"); }
+{ foreign "C" barf("TREC_HEADER object entered!") never returns; }

 
 INFO_TABLE_CONSTR(stg_END_STM_WATCH_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WATCH_QUEUE","END_STM_WATCH_QUEUE")
 
 INFO_TABLE_CONSTR(stg_END_STM_WATCH_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_WATCH_QUEUE","END_STM_WATCH_QUEUE")

-{ foreign "C" barf("END_STM_WATCH_QUEUE object entered!"); }
+{ foreign "C" barf("END_STM_WATCH_QUEUE object entered!") never returns; }

 
 INFO_TABLE_CONSTR(stg_END_INVARIANT_CHECK_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_INVARIANT_CHECK_QUEUE","END_INVARIANT_CHECK_QUEUE")
 
 INFO_TABLE_CONSTR(stg_END_INVARIANT_CHECK_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_INVARIANT_CHECK_QUEUE","END_INVARIANT_CHECK_QUEUE")

-{ foreign "C" barf("END_INVARIANT_CHECK_QUEUE object entered!"); }
+{ foreign "C" barf("END_INVARIANT_CHECK_QUEUE object entered!") never returns; }

 
 INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")
 
 INFO_TABLE_CONSTR(stg_END_STM_CHUNK_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_STM_CHUNK_LIST","END_STM_CHUNK_LIST")

-{ foreign "C" barf("END_STM_CHUNK_LIST object entered!"); }
+{ foreign "C" barf("END_STM_CHUNK_LIST object entered!") never returns; }

 
 INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")
 
 INFO_TABLE_CONSTR(stg_NO_TREC,0,0,0,CONSTR_NOCAF_STATIC,"NO_TREC","NO_TREC")

-{ foreign "C" barf("NO_TREC object entered!"); }
+{ foreign "C" barf("NO_TREC object entered!") never returns; }

 
 CLOSURE(stg_END_STM_WATCH_QUEUE_closure,stg_END_STM_WATCH_QUEUE);
 
 
 CLOSURE(stg_END_STM_WATCH_QUEUE_closure,stg_END_STM_WATCH_QUEUE);
 

@@ -521,7 +521,7 @@ CLOSURE(stg_NO_TREC_closure,stg_NO_TREC);
    ------------------------------------------------------------------------- */
 
 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE_CONSTR(stg_END_TSO_QUEUE,0,0,0,CONSTR_NOCAF_STATIC,"END_TSO_QUEUE","END_TSO_QUEUE")

-{ foreign "C" barf("END_TSO_QUEUE object entered!"); }
+{ foreign "C" barf("END_TSO_QUEUE object entered!") never returns; }

 
 CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
 
 
 CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
 

@@ -530,12 +530,12 @@ CLOSURE(stg_END_TSO_QUEUE_closure,stg_END_TSO_QUEUE);
    ------------------------------------------------------------------------- */
 
 INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_EXCEPTION_LIST","END_EXCEPTION_LIST")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE_CONSTR(stg_END_EXCEPTION_LIST,0,0,0,CONSTR_NOCAF_STATIC,"END_EXCEPTION_LIST","END_EXCEPTION_LIST")

-{ foreign "C" barf("END_EXCEPTION_LIST object entered!"); }
+{ foreign "C" barf("END_EXCEPTION_LIST object entered!") never returns; }

 
 CLOSURE(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST);
 
 INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")
 
 CLOSURE(stg_END_EXCEPTION_LIST_closure,stg_END_EXCEPTION_LIST);
 
 INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")

-{ foreign "C" barf("EXCEPTION_CONS object entered!"); }
+{ foreign "C" barf("EXCEPTION_CONS object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    Arrays
 
 /* ----------------------------------------------------------------------------
    Arrays

@@ -553,28 +553,28 @@ INFO_TABLE(stg_EXCEPTION_CONS,1,1,CONSTR,"EXCEPTION_CONS","EXCEPTION_CONS")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_ARR_WORDS, 0, 0, ARR_WORDS, "ARR_WORDS", "ARR_WORDS")

-{ foreign "C" barf("ARR_WORDS object entered!"); }
+{ foreign "C" barf("ARR_WORDS object entered!") never returns; }

 
 INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")
 
 INFO_TABLE(stg_MUT_ARR_PTRS_CLEAN, 0, 0, MUT_ARR_PTRS_CLEAN, "MUT_ARR_PTRS_CLEAN", "MUT_ARR_PTRS_CLEAN")

-{ foreign "C" barf("MUT_ARR_PTRS_CLEAN object entered!"); }
+{ foreign "C" barf("MUT_ARR_PTRS_CLEAN object entered!") never returns; }

 
 INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY")
 
 INFO_TABLE(stg_MUT_ARR_PTRS_DIRTY, 0, 0, MUT_ARR_PTRS_DIRTY, "MUT_ARR_PTRS_DIRTY", "MUT_ARR_PTRS_DIRTY")

-{ foreign "C" barf("MUT_ARR_PTRS_DIRTY object entered!"); }
+{ foreign "C" barf("MUT_ARR_PTRS_DIRTY object entered!") never returns; }

 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")
 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN, 0, 0, MUT_ARR_PTRS_FROZEN, "MUT_ARR_PTRS_FROZEN", "MUT_ARR_PTRS_FROZEN")

-{ foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!"); }
+{ foreign "C" barf("MUT_ARR_PTRS_FROZEN object entered!") never returns; }

 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_FROZEN0", "MUT_ARR_PTRS_FROZEN0")
 
 INFO_TABLE(stg_MUT_ARR_PTRS_FROZEN0, 0, 0, MUT_ARR_PTRS_FROZEN0, "MUT_ARR_PTRS_FROZEN0", "MUT_ARR_PTRS_FROZEN0")

-{ foreign "C" barf("MUT_ARR_PTRS_FROZEN0 object entered!"); }
+{ foreign "C" barf("MUT_ARR_PTRS_FROZEN0 object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    Mutable Variables
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_MUT_VAR_CLEAN, 1, 0, MUT_VAR_CLEAN, "MUT_VAR_CLEAN", "MUT_VAR_CLEAN")
 
 /* ----------------------------------------------------------------------------
    Mutable Variables
    ------------------------------------------------------------------------- */
 
 INFO_TABLE(stg_MUT_VAR_CLEAN, 1, 0, MUT_VAR_CLEAN, "MUT_VAR_CLEAN", "MUT_VAR_CLEAN")

-{ foreign "C" barf("MUT_VAR_CLEAN object entered!"); }
+{ foreign "C" barf("MUT_VAR_CLEAN object entered!") never returns; }

 INFO_TABLE(stg_MUT_VAR_DIRTY, 1, 0, MUT_VAR_DIRTY, "MUT_VAR_DIRTY", "MUT_VAR_DIRTY")
 INFO_TABLE(stg_MUT_VAR_DIRTY, 1, 0, MUT_VAR_DIRTY, "MUT_VAR_DIRTY", "MUT_VAR_DIRTY")

-{ foreign "C" barf("MUT_VAR_DIRTY object entered!"); }
+{ foreign "C" barf("MUT_VAR_DIRTY object entered!") never returns; }

 
 /* ----------------------------------------------------------------------------
    Dummy return closure
 
 /* ----------------------------------------------------------------------------
    Dummy return closure

diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs
index c42ccb1..e46b37a 100644 (file)
--- a/utils/genapply/GenApply.hs
+++ b/utils/genapply/GenApply.hs
@@ -602,7 +602,7 @@ genApply regstatus args =
 
        text "default: {",
        nest 4 (
 
        text "default: {",
        nest 4 (

-         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\");"
+         text "foreign \"C\" barf(\"" <> fun_ret_label <> text "\") never returns;"

        ),
        text "}"
        
        ),
        text "}"