Fix #4867, ghci displays negative floats incorrectly
[ghc.git] / rts / Updates.cmm
index e0fd7c3..789bdd5 100644 (file)
 
 #include "Updates.h"
 
-/* on entry to the update code
-   (1) R1 points to the closure being returned
-   (2) Sp points to the update frame
-*/
+#if defined(PROFILING)
+#define UPD_FRAME_PARAMS W_ unused1, W_ unused2, P_ unused3
+#else
+#define UPD_FRAME_PARAMS P_ unused1
+#endif
 
 /* The update fragment has been tuned so as to generate good
    code with gcc, which accounts for some of the strangeness in the
    code), since we don't mind duplicating this jump.
 */
 
-#define UPD_FRAME_ENTRY_TEMPLATE                                       \
-       {                                                               \
-          W_ updatee;                                                  \
-                                                                       \
-          updatee = StgUpdateFrame_updatee(Sp);                                \
-                                                                       \
-         /* remove the update frame from the stack */                  \
-         Sp = Sp + SIZEOF_StgUpdateFrame;                              \
-                                                                       \
-         /* ToDo: it might be a PAP, so we should check... */          \
-         TICK_UPD_CON_IN_NEW(sizeW_fromITBL(%GET_STD_INFO(updatee)));  \
-                                                                       \
-          updateWithIndirection(stg_IND_direct_info,                    \
-                               updatee,                                \
-                               R1,                                     \
-                               jump %ENTRY_CODE(Sp(0)));               \
-       }
-
-#if defined(PROFILING)
-#define UPD_FRAME_PARAMS W_ unused1, W_ unused2, P_ unused3
-#else
-#define UPD_FRAME_PARAMS P_ unused1
-#endif
-
-/* this bitmap indicates that the first word of an update frame is a
- * non-pointer - this is the update frame link.  (for profiling,
- * there's a cost-centre-stack in there too).
- */
+/* on entry to the update code
+   (1) R1 points to the closure being returned
+   (2) Sp points to the update frame
+*/
 
 INFO_TABLE_RET( stg_upd_frame, UPDATE_FRAME, UPD_FRAME_PARAMS)
-UPD_FRAME_ENTRY_TEMPLATE
+{
+    W_ updatee;
+    
+    updatee = StgUpdateFrame_updatee(Sp);
+    
+    /* remove the update frame from the stack */
+    Sp = Sp + SIZEOF_StgUpdateFrame;
+    
+    /* ToDo: it might be a PAP, so we should check... */
+    TICK_UPD_CON_IN_NEW(sizeW_fromITBL(%GET_STD_INFO(updatee)));
+    
+    updateWithIndirection(updatee,
+                          R1,
+                          jump %ENTRY_CODE(Sp(0)));
+}
 
 
 INFO_TABLE_RET( stg_marked_upd_frame, UPDATE_FRAME, UPD_FRAME_PARAMS)
-UPD_FRAME_ENTRY_TEMPLATE
+{
+    W_ updatee, v, i, tso, link;
+
+    // we know the closure is a BLACKHOLE
+    updatee = StgUpdateFrame_updatee(Sp);
+    v = StgInd_indirectee(updatee);
+
+    // remove the update frame from the stack
+    Sp = Sp + SIZEOF_StgUpdateFrame;
+    
+    if (GETTAG(v) != 0) {
+        // updated by someone else: discard our value and use the
+        // other one to increase sharing, but check the blocking
+        // queues to see if any threads were waiting on this BLACKHOLE.
+        R1 = v;
+        foreign "C" checkBlockingQueues(MyCapability() "ptr",
+                                        CurrentTSO "ptr") [R1];
+        jump %ENTRY_CODE(Sp(0));
+    }
+
+    // common case: it is still our BLACKHOLE
+    if (v == CurrentTSO) {
+        updateWithIndirection(updatee,
+                              R1,
+                              jump %ENTRY_CODE(Sp(0)));
+    }
+
+    // The other cases are all handled by the generic code
+    foreign "C" updateThunk (MyCapability() "ptr", CurrentTSO "ptr", 
+                             updatee "ptr", R1 "ptr") [R1];
+
+    jump %ENTRY_CODE(Sp(0));
+}
+
+// Special update frame code for CAFs and eager-blackholed thunks: it
+// knows how to update blackholes, but is distinct from
+// stg_marked_upd_frame so that lazy blackholing won't treat it as the
+// high watermark.
+INFO_TABLE_RET (stg_bh_upd_frame, UPDATE_FRAME, UPD_FRAME_PARAMS)
+{
+    jump RET_LBL(stg_marked_upd_frame);
+}