Change the calling conventions for unboxed tuples slightly

When returning an unboxed tuple with a single non-void component, we
now use the same calling convention as for returning a value of the
same type as that component.  This means that the return convention
for IO now doesn't vary depending on the platform, which make some
parts of the RTS simpler, and fixes a problem I was having with making
the FFI work in unregisterised GHCi (the byte-code compiler makes
some assumptions about calling conventions to keep things simple).

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index da5a3d9..752769f 100644 (file)
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -336,9 +336,22 @@ assignPrimOpCallRegs args
        -- For primops, *all* arguments must be passed in registers
 
 assignReturnRegs args
- = assign_regs args (mkRegTbl [])
+ -- when we have a single non-void component to return, use the normal
+ -- unpointed return convention.  This make various things simpler: it
+ -- means we can assume a consistent convention for IO, which is useful
+ -- when writing code that relies on knowing the IO return convention in 
+ -- the RTS (primops, especially exception-related primops).
+ -- Also, the bytecode compiler assumes this when compiling
+ -- case expressions and ccalls, so it only needs to know one set of
+ -- return conventions.
+ | [(rep,arg)] <- non_void_args, CmmGlobal r <- dataReturnConvPrim rep
+    = ([(arg, r)], [])
+ | otherwise
+    = assign_regs args (mkRegTbl [])
        -- For returning unboxed tuples etc, 
        -- we use all regs
+ where 
+       non_void_args = filter ((/= VoidArg).fst) args
 
 assign_regs :: [(CgRep,a)]             -- Arg or result values to assign
            -> AvailRegs        -- Regs still avail: Vanilla, Float, Double, Longs

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 793c9ab..479c9c9 100644 (file)
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -64,23 +64,10 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
          * thread, which might result in the thread being killed.
          */
 
-#ifndef REG_R1
-        /*
-         * raiseAsync assumes that the stack is in ThreadRunGHC state,
-         * i.e. with a return address on the top.  In unreg mode, the
-         * return value for IO is on top of the return address, so we
-         * need to make a small adjustment here.
-         */
-        Sp_adj(1);
-#endif
         STK_CHK_GEN( WDS(2), R1_PTR, stg_unblockAsyncExceptionszh_ret_info);
         Sp_adj(-2);
         Sp(1) = R1;
-#ifdef REG_R1
         Sp(0) = stg_gc_unpt_r1_info;
-#else
-        Sp(0) = stg_ut_1_0_unreg_info;
-#endif
         SAVE_THREAD_STATE();
         (r) = foreign "C" maybePerformBlockedException (MyCapability() "ptr", 
                                                      CurrentTSO "ptr") [R1];
@@ -94,25 +81,10 @@ INFO_TABLE_RET( stg_unblockAsyncExceptionszh_ret, RET_SMALL )
                 jump %ENTRY_CODE(Sp(0));
             }
         }
-#ifndef REG_R1
-        /* 
-         * Readjust stack in unregisterised mode if we didn't raise an
-         * exception, see above
-         */
-        else {
-            Sp_adj(-1);
-        }
-#endif
     }
 
-#ifdef REG_R1
     Sp_adj(1);
     jump %ENTRY_CODE(Sp(0));
-#else
-    Sp(1) = Sp(0);
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(1));
-#endif
 }
 
 INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret, RET_SMALL )
@@ -120,14 +92,8 @@ INFO_TABLE_RET( stg_blockAsyncExceptionszh_ret, RET_SMALL )
     StgTSO_flags(CurrentTSO) = 
        StgTSO_flags(CurrentTSO) | TSO_BLOCKEX::I32 | TSO_INTERRUPTIBLE::I32;
 
-#ifdef REG_R1
     Sp_adj(1);
     jump %ENTRY_CODE(Sp(0));
-#else
-    Sp(1) = Sp(0);
-    Sp_adj(1);
-    jump %ENTRY_CODE(Sp(1));
-#endif
 }
 
 blockAsyncExceptionszh_fast
@@ -276,11 +242,7 @@ killThreadzh_fast
    Catch frames
    -------------------------------------------------------------------------- */
 
-#ifdef REG_R1
 #define SP_OFF 0
-#else
-#define SP_OFF 1
-#endif
 
 /* Catch frames are very similar to update frames, but when entering
  * one we just pop the frame off the stack and perform the correct
@@ -292,20 +254,10 @@ INFO_TABLE_RET(stg_catch_frame, CATCH_FRAME,
   W_ unused1, W_ unused2,
 #endif
   W_ unused3, "ptr" W_ unused4)
-#ifdef REG_R1
-   {
-      Sp = Sp + SIZEOF_StgCatchFrame;
-      jump %ENTRY_CODE(Sp(SP_OFF));
-   }
-#else
    {
-      W_ rval;
-      rval = Sp(0);
       Sp = Sp + SIZEOF_StgCatchFrame;
-      Sp(0) = rval;
       jump %ENTRY_CODE(Sp(SP_OFF));
    }
-#endif
 
 /* -----------------------------------------------------------------------------
  * The catch infotable

diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm
index 53de724..99d71ab 100644 (file)
--- a/rts/PrimOps.cmm
+++ b/rts/PrimOps.cmm
@@ -1072,13 +1072,7 @@ threadStatuszh_fast
  * TVar primitives
  * -------------------------------------------------------------------------- */
 
-#ifdef REG_R1
 #define SP_OFF 0
-#define IF_NOT_REG_R1(x) 
-#else
-#define SP_OFF 1
-#define IF_NOT_REG_R1(x) x
-#endif
 
 // Catch retry frame ------------------------------------------------------------
 
@@ -1089,7 +1083,6 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME,
   W_ unused3, "ptr" W_ unused4, "ptr" W_ unused5)
 {
    W_ r, frame, trec, outer;
-   IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
 
    frame = Sp;
    trec = StgTSO_trec(CurrentTSO);
@@ -1099,7 +1092,6 @@ INFO_TABLE_RET(stg_catch_retry_frame, CATCH_RETRY_FRAME,
      /* Succeeded (either first branch or second branch) */
      StgTSO_trec(CurrentTSO) = outer;
      Sp = Sp + SIZEOF_StgCatchRetryFrame;
-     IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
      jump %ENTRY_CODE(Sp(SP_OFF));
    } else {
      /* Did not commit: re-execute */
@@ -1125,7 +1117,6 @@ INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME,
   "ptr" W_ unused3, "ptr" W_ unused4)
 {
   W_ frame, trec, valid, next_invariant, q, outer;
-  IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
 
   frame = Sp;
   trec = StgTSO_trec(CurrentTSO);
@@ -1169,7 +1160,6 @@ INFO_TABLE_RET(stg_atomically_frame, ATOMICALLY_FRAME,
       /* Transaction was valid: commit succeeded */
       StgTSO_trec(CurrentTSO) = NO_TREC;
       Sp = Sp + SIZEOF_StgAtomicallyFrame;
-      IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
       jump %ENTRY_CODE(Sp(SP_OFF));
     } else {
       /* Transaction was not valid: try again */
@@ -1189,7 +1179,6 @@ INFO_TABLE_RET(stg_atomically_waiting_frame, ATOMICALLY_FRAME,
   "ptr" W_ unused3, "ptr" W_ unused4)
 {
   W_ frame, trec, valid;
-  IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
 
   frame = Sp;
 
@@ -1197,9 +1186,6 @@ INFO_TABLE_RET(stg_atomically_waiting_frame, ATOMICALLY_FRAME,
   (valid) = foreign "C" stmReWait(MyCapability() "ptr", CurrentTSO "ptr") [];
   if (valid != 0) {
     /* Previous attempt is still valid: no point trying again yet */
-         IF_NOT_REG_R1(Sp_adj(-2);
-                       Sp(1) = stg_NO_FINALIZER_closure;
-                       Sp(0) = stg_ut_1_0_unreg_info;)
     jump stg_block_noregs;
   } else {
     /* Previous attempt is no longer valid: try again */
@@ -1213,11 +1199,7 @@ INFO_TABLE_RET(stg_atomically_waiting_frame, ATOMICALLY_FRAME,
 
 // STM catch frame --------------------------------------------------------------
 
-#ifdef REG_R1
 #define SP_OFF 0
-#else
-#define SP_OFF 1
-#endif
 
 /* Catch frames are very similar to update frames, but when entering
  * one we just pop the frame off the stack and perform the correct
@@ -1230,7 +1212,6 @@ INFO_TABLE_RET(stg_catch_stm_frame, CATCH_STM_FRAME,
 #endif
   "ptr" W_ unused3, "ptr" W_ unused4)
    {
-      IF_NOT_REG_R1(W_ rval;  rval = Sp(0);  Sp_adj(1); )
       W_ r, frame, trec, outer;
       frame = Sp;
       trec = StgTSO_trec(CurrentTSO);
@@ -1240,7 +1221,6 @@ INFO_TABLE_RET(stg_catch_stm_frame, CATCH_STM_FRAME,
         /* Commit succeeded */
         StgTSO_trec(CurrentTSO) = outer;
         Sp = Sp + SIZEOF_StgCatchSTMFrame;
-        IF_NOT_REG_R1(Sp_adj(-1); Sp(0) = rval;)
         jump Sp(SP_OFF);
       } else {
         /* Commit failed */
@@ -1412,9 +1392,6 @@ retry_pop_stack:
     StgHeader_info(frame) = stg_atomically_waiting_frame_info;
     Sp = frame;
     // Fix up the stack in the unregisterised case: the return convention is different.
-    IF_NOT_REG_R1(Sp_adj(-2); 
-                 Sp(1) = stg_NO_FINALIZER_closure;
-                 Sp(0) = stg_ut_1_0_unreg_info;)
     R3 = trec; // passing to stmWaitUnblock()
     jump stg_block_stmwait;
   } else {
@@ -1555,16 +1532,9 @@ newMVarzh_fast
 }
 
 
-/* If R1 isn't available, pass it on the stack */
-#ifdef REG_R1
 #define PerformTake(tso, value)                                \
     W_[StgTSO_sp(tso) + WDS(1)] = value;               \
     W_[StgTSO_sp(tso) + WDS(0)] = stg_gc_unpt_r1_info;
-#else
-#define PerformTake(tso, value)                                        \
-    W_[StgTSO_sp(tso) + WDS(1)] = value;                       \
-    W_[StgTSO_sp(tso) + WDS(0)] = stg_ut_1_0_unreg_info;
-#endif
 
 #define PerformPut(tso,lval)                   \
     StgTSO_sp(tso) = StgTSO_sp(tso) + WDS(3);  \

diff --git a/rts/RaiseAsync.c b/rts/RaiseAsync.c
index 9d03d07..d3400d7 100644 (file)
--- a/rts/RaiseAsync.c
+++ b/rts/RaiseAsync.c
@@ -1010,17 +1010,7 @@ raiseAsync(Capability *cap, StgTSO *tso, StgClosure *exception,
            if (stop_at_atomically) {
                ASSERT(stmGetEnclosingTRec(tso->trec) == NO_TREC);
                stmCondemnTransaction(cap, tso -> trec);
-#ifdef REG_R1
                tso->sp = frame;
-#else
-               // R1 is not a register: the return convention for IO in
-               // this case puts the return value on the stack, so we
-               // need to set up the stack to return to the atomically
-               // frame properly...
-               tso->sp = frame - 2;
-               tso->sp[1] = (StgWord) &stg_NO_FINALIZER_closure; // why not?
-               tso->sp[0] = (StgWord) &stg_ut_1_0_unreg_info;
-#endif
                tso->what_next = ThreadRunGHC;
                return;
            }

diff --git a/rts/Schedule.c b/rts/Schedule.c
index c6fb1d8..96c52f5 100644 (file)
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -1479,9 +1479,7 @@ schedulePostRunThread (StgTSO *t)
             throwToSingleThreaded_(&capabilities[0], t, 
                                    NULL, rtsTrue, NULL);
             
-#ifdef REG_R1
             ASSERT(get_itbl((StgClosure *)t->sp)->type == ATOMICALLY_FRAME);
-#endif
         }
     }
 

diff --git a/rts/StgStartup.cmm b/rts/StgStartup.cmm
index b5a5cdc..16e5c62 100644 (file)
--- a/rts/StgStartup.cmm
+++ b/rts/StgStartup.cmm
@@ -147,18 +147,10 @@ stg_threadFinished
 
 INFO_TABLE_RET( stg_forceIO, RET_SMALL)
 
-#ifdef REG_R1
 {
   Sp_adj(1);
   ENTER();
 }
-#else
-{
-  R1 = Sp(0);
-  Sp_adj(2);
-  ENTER();
-}
-#endif
 
 /* -----------------------------------------------------------------------------
     Non-strict IO application.
@@ -171,18 +163,10 @@ INFO_TABLE_RET( stg_forceIO, RET_SMALL)
 
 INFO_TABLE_RET( stg_noforceIO, RET_SMALL )
 
-#ifdef REG_R1
 {
   Sp_adj(1);
   jump %ENTRY_CODE(Sp(0));
 }
-#else
-{
-  R1 = Sp(0);
-  Sp_adj(2);
-  jump %ENTRY_CODE(Sp(0));
-}
-#endif
 
 /* -----------------------------------------------------------------------------
    Special STG entry points for module registration.