[project @ 2003-07-21 11:45:47 by simonmar]

Add support for the new AWAKEN_BQ_CLOSURE macro to the NCG.  Fixes
broken HEAD builds.

diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs
index 99befbd..f2b3ff9 100644 (file)
--- a/ghc/compiler/absCSyn/CLabel.lhs
+++ b/ghc/compiler/absCSyn/CLabel.lhs
@@ -52,6 +52,7 @@ module CLabel (
 
        mkTopTickyCtrLabel,
        mkBlackHoleInfoTableLabel,
+       mkBlackHoleBQInfoTableLabel,
         mkCAFBlackHoleInfoTableLabel,
         mkSECAFBlackHoleInfoTableLabel,
        mkRtsPrimOpLabel,
@@ -270,6 +271,7 @@ mkEMPTY_MVAR_infoLabel              = RtsLabel (Rts_Info "stg_EMPTY_MVAR_info")
 
 mkTopTickyCtrLabel             = RtsLabel RtsTopTickyCtr
 mkBlackHoleInfoTableLabel      = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_info"))
+mkBlackHoleBQInfoTableLabel    = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_BLACKHOLE_BQ_info"))
 mkCAFBlackHoleInfoTableLabel   = RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_CAF_BLACKHOLE_info"))
 mkSECAFBlackHoleInfoTableLabel = if opt_DoTickyProfiling then
                                     RtsLabel (RtsBlackHoleInfoTbl SLIT("stg_SE_CAF_BLACKHOLE_info"))

diff --git a/ghc/compiler/nativeGen/AbsCStixGen.lhs b/ghc/compiler/nativeGen/AbsCStixGen.lhs
index 6e848a7..784b2c1 100644 (file)
--- a/ghc/compiler/nativeGen/AbsCStixGen.lhs
+++ b/ghc/compiler/nativeGen/AbsCStixGen.lhs
@@ -61,7 +61,6 @@ genCodeAbstractC absC
  a2stix'     = amodeToStix'
  volsaves    = volatileSaves
  volrestores = volatileRestores
- macro_code  = macroCode
  -- real code follows... ---------
 \end{code}
 
@@ -425,7 +424,7 @@ Finally, all of the disgusting AbstractC macros.
 
 \begin{code}
 
- gencode (CMacroStmt macro args) = macro_code macro args
+ gencode (CMacroStmt macro args) = macroCode macro (map amodeToStix args)
 
  gencode (CCallProfCtrMacro macro _)
   = returnUs (\xs -> StComment macro : xs)

diff --git a/ghc/compiler/nativeGen/StixMacro.lhs b/ghc/compiler/nativeGen/StixMacro.lhs
index 22988e1..27b544c 100644 (file)
--- a/ghc/compiler/nativeGen/StixMacro.lhs
+++ b/ghc/compiler/nativeGen/StixMacro.lhs
@@ -12,6 +12,7 @@ import {-# SOURCE #-} StixPrim ( amodeToStix )
 
 import MachRegs
 import AbsCSyn         ( CStmtMacro(..), CAddrMode, tagreg, CCheckMacro(..) )
+import SMRep           ( fixedHdrSize )
 import Constants       ( uF_RET, uF_UPDATEE, uF_SIZE )
 import ForeignCall     ( CCallConv(..) )
 import MachOp          ( MachOp(..) )
@@ -20,9 +21,10 @@ import Stix
 import Panic           ( panic )
 import UniqSupply      ( returnUs, thenUs, UniqSM )
 import CLabel          ( mkBlackHoleInfoTableLabel, mkIndStaticInfoLabel,
+                         mkBlackHoleBQInfoTableLabel,
                          mkIndInfoLabel, mkUpdInfoLabel, mkRtsGCEntryLabel )
 \end{code}
-
+--------------------------------------------------------------------------------
 The @ARGS_CHK_A{_LOAD_NODE}@ macros check for sufficient arguments on
 the A stack, and perform a tail call to @UpdatePAP@ if the arguments are
 not there.  The @_LOAD_NODE@ version also loads R1 with an appropriate
@@ -31,7 +33,7 @@ closure address.
 \begin{code}
 macroCode
     :: CStmtMacro          -- statement macro
-    -> [CAddrMode]         -- args
+    -> [StixExpr]          -- args
     -> UniqSM StixStmtList
 \end{code}
 
@@ -42,9 +44,8 @@ Updating a CAF
 adding an indirection.
 
 \begin{code}
-macroCode UPD_CAF args
+macroCode UPD_CAF [cafptr,bhptr]
   = let
-       [cafptr,bhptr] = map amodeToStix args
        new_caf = StVoidable (StCall (Left FSLIT("newCAF")) CCallConv VoidRep [cafptr])
        a1 = StAssignMem PtrRep (StIndex PtrRep cafptr fixedHS) bhptr
        a2 = StAssignMem PtrRep cafptr ind_static_info
@@ -74,7 +75,7 @@ macroCode UPD_BH_UPDATABLE args = returnUs id
 macroCode UPD_BH_SINGLE_ENTRY args = returnUs id
 {-
   = let
-       update = StAssign PtrRep (StInd PtrRep (amodeToStix arg)) bh_info
+       update = StAssign PtrRep (StInd PtrRep arg) bh_info
     in
     returnUs (\xs -> update : xs)
 -}
@@ -86,9 +87,8 @@ Update frames
 Push an update frame on the stack.
 
 \begin{code}
-macroCode PUSH_UPD_FRAME args
+macroCode PUSH_UPD_FRAME [bhptr, _{-0-}]
   = let
-       [bhptr, _{-0-}] = map amodeToStix args
        frame n = StIndex PtrRep (StReg stgSp) (StInt (toInteger (n-uF_SIZE)))
 
         -- HWL: these values are *wrong* in a GranSim setup; ToDo: fix
@@ -109,16 +109,33 @@ macroCode SET_TAG [tag]
        Right baseRegAddr 
           -> returnUs id
        Left  realreg 
-          -> let a1 = StAssignReg IntRep (StixMagicId tagreg) (amodeToStix tag)
+          -> let a1 = StAssignReg IntRep (StixMagicId tagreg) tag
              in returnUs ( \xs -> a1 : xs )
 \end{code}
 
 -----------------------------------------------------------------------------
 
 \begin{code}
+macroCode AWAKEN_BQ_CLOSURE [arg]
+  =  getUniqLabelNCG           `thenUs` \ label ->
+     let
+       info = StInd AddrRep arg
+       cond = StMachOp MO_Nat_Ne [info, bq_info ]
+       jump = StCondJump label cond
+       blocking_queue = StInd PtrRep 
+                         (StIndex PtrRep arg (StInt (toInteger fixedHdrSize)))
+        call = StVoidable (StCall (Left FSLIT("awakenBlockedQueue")) 
+                               CCallConv VoidRep [blocking_queue])
+     in
+     returnUs ( \xs -> jump : call : StLabel label : xs )
+\end{code}
+
+-----------------------------------------------------------------------------
+
+\begin{code}
 macroCode REGISTER_IMPORT [arg]
    = returnUs (
-       \xs -> StAssignMem WordRep (StReg stgSp) (amodeToStix arg)
+       \xs -> StAssignMem WordRep (StReg stgSp) arg
             : StAssignReg PtrRep  stgSp (StMachOp MO_Nat_Add [StReg stgSp, StInt 4])
             : xs
      )
@@ -127,7 +144,7 @@ macroCode REGISTER_FOREIGN_EXPORT [arg]
    = returnUs (
        \xs -> StVoidable (
                   StCall (Left FSLIT("getStablePtr")) CCallConv VoidRep 
-                         [amodeToStix arg]
+                         [arg]
                )
             : xs
      )
@@ -148,6 +165,7 @@ Let's make sure that these CAFs are lifted out, shall we?
 bh_info, ind_static_info, ind_info :: StixExpr
 
 bh_info        = StCLbl mkBlackHoleInfoTableLabel
+bq_info        = StCLbl mkBlackHoleBQInfoTableLabel
 ind_static_info        = StCLbl mkIndStaticInfoLabel
 ind_info       = StCLbl mkIndInfoLabel
 upd_frame_info = StCLbl mkUpdInfoLabel
@@ -164,7 +182,7 @@ checkCode macro args assts
   = getUniqLabelNCG            `thenUs` \ ulbl_fail ->
     getUniqLabelNCG            `thenUs` \ ulbl_pass ->
 
-    let args_stix        = map amodeToStix args
+    let        args_stix        = map amodeToStix args
        newHp wds        = StIndex PtrRep (StReg stgHp) wds
        assign_hp wds    = StAssignReg PtrRep stgHp (newHp wds)
        hp_alloc wds     = StAssignReg IntRep stgHpAlloc wds