[project @ 2004-08-13 10:45:16 by simonmar]
[ghc-hetmet.git] / ghc / compiler / nativeGen / StixMacro.lhs
index 6f3e8c7..be32d65 100644 (file)
 %
-% (c) The AQUA Project, Glasgow University, 1993-1995
+% (c) The AQUA Project, Glasgow University, 1993-1998
 %
 
 \begin{code}
-#include "HsVersions.h"
+module StixMacro ( macroCode, checkCode ) where
 
-module StixMacro (
-       genMacroCode, doHeapCheck, smStablePtrTable,
+#include "HsVersions.h"
+#include "nativeGen/NCG.h"
 
-       Target, StixTree, SplitUniqSupply, CAddrMode, CExprMacro,
-       CStmtMacro
-    ) where
+import {-# SOURCE #-} StixPrim ( amodeToStix )
 
-import AbsCSyn
-import AbsPrel      ( PrimOp(..)
-                     IF_ATTACK_PRAGMAS(COMMA tagOf_PrimOp)
-                         IF_ATTACK_PRAGMAS(COMMA pprPrimOp)
-                   )
-import MachDesc            {- lots -}
-import CgCompInfo   ( sTD_UF_SIZE, uF_RET, uF_SUA, uF_SUB, uF_UPDATEE )
+import MachRegs
+import AbsCSyn         ( CStmtMacro(..), CAddrMode, tagreg, CCheckMacro(..) )
+import Constants       ( uF_RET, uF_UPDATEE, uF_SIZE )
+import ForeignCall     ( CCallConv(..) )
+import MachOp          ( MachOp(..) )
+import PrimRep         ( PrimRep(..) )
 import Stix
-import SplitUniq
-import Unique
-import Util
-
+import Panic           ( panic )
+import UniqSupply      ( returnUs, thenUs, UniqSM )
+import CLabel          ( mkBlackHoleInfoTableLabel, mkIndStaticInfoLabel,
+                         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
 closure address.
 
 \begin{code}
-mkIntCLit_0 = mkIntCLit 0 -- out here to avoid CAF (sigh)
-mkIntCLit_3 = mkIntCLit 3
-
--- hacking with Uncle Will:
-#define target_STRICT target@(Target _ _ _ _ _ _ _ _)
-
-genMacroCode 
-    :: Target 
-    -> CStmtMacro          -- statement macro
-    -> [CAddrMode]         -- args
-    -> SUniqSM StixTreeList
-
-genMacroCode target_STRICT macro args
- = genmacro macro args
- where
-  a2stix  = amodeToStix target
-  stg_reg = stgReg target
-
-  -- real thing: here we go -----------------------
-
-  genmacro ARGS_CHK_A_LOAD_NODE args = 
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let [words, lbl] = map a2stix args
-       temp = StIndex PtrKind stgSpA words
-       test = StPrim AddrGeOp [stgSuA, temp]
-       cjmp = StCondJump ulbl test
-       assign = StAssign PtrKind stgNode lbl
-       join = StLabel ulbl
-    in
-       returnSUs (\xs -> cjmp : assign : updatePAP : join : xs)
-
-  genmacro ARGS_CHK_A [words] = 
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let temp = StIndex PtrKind stgSpA (a2stix words)
-       test = StPrim AddrGeOp [stgSuA, temp]
-       cjmp = StCondJump ulbl test
-       join = StLabel ulbl
-    in
-       returnSUs (\xs -> cjmp : updatePAP : join : xs)
-
-\end{code}
-
-Like the macros above, the @ARGS_CHK_B{_LOAD_NODE}@ macros check for
-sufficient arguments on the B stack, and perform a tail call to
-@UpdatePAP@ if the arguments are not there.  The @_LOAD_NODE@ version
-also loads R1 with an appropriate closure address.  Note that the
-directions are swapped relative to the A stack.
-
-\begin{code}
-
-  genmacro ARGS_CHK_B_LOAD_NODE args = 
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let [words, lbl] = map a2stix args
-       temp = StIndex PtrKind stgSuB (StPrim IntNegOp [words])
-       test = StPrim AddrGeOp [stgSpB, temp]
-       cjmp = StCondJump ulbl test
-       assign = StAssign PtrKind stgNode lbl
-       join = StLabel ulbl
-    in
-       returnSUs (\xs -> cjmp : assign : updatePAP : join : xs)
-
-  genmacro ARGS_CHK_B [words] = 
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let        temp = StIndex PtrKind stgSuB (StPrim IntNegOp [a2stix words])
-       test = StPrim AddrGeOp [stgSpB, temp]
-       cjmp = StCondJump ulbl test
-       join = StLabel ulbl
-    in
-       returnSUs (\xs -> cjmp : updatePAP : join : xs)
-
-\end{code}
-
-The @HEAP_CHK@ macro checks to see that there are enough words
-available in the heap (before reaching @HpLim@).  When a heap check
-fails, it has to call @PerformGC@ via the @PerformGC_wrapper@.  The
-call wrapper saves all of our volatile registers so that we don't have to.
-
-Since there are @HEAP_CHK@s buried at unfortunate places in the integer
-primOps, this is just a wrapper.
-
-\begin{code}
-
-  genmacro HEAP_CHK args =
-    let [liveness,words,reenter] = map a2stix args
-    in
-       doHeapCheck {-UNUSED NOW:target-} liveness words reenter
-
-\end{code}
-
-The @STK_CHK@ macro checks for enough space on the stack between @SpA@
-and @SpB@.  A stack check can be complicated in the parallel world,
-but for the sequential case, we just need to ensure that we have
-enough space to continue.  Not that @_StackOverflow@ doesn't return,
-so we don't have to @callWrapper@ it.
-
-\begin{code}
-
-  genmacro STK_CHK [liveness, aWords, bWords, spa, spb, prim, reenter] = 
-{- Need to check to see if we are compiling with stack checks
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let words = StPrim IntNegOp 
-           [StPrim IntAddOp [a2stix aWords, a2stix bWords]]
-       temp = StIndex PtrKind stgSpA words
-       test = StPrim AddrGtOp [temp, stgSpB]
-       cjmp = StCondJump ulbl test
-       join = StLabel ulbl
-    in
-       returnSUs (\xs -> cjmp : stackOverflow : join : xs)
--}
-    returnSUs id
-
+macroCode
+    :: CStmtMacro          -- statement macro
+    -> [StixExpr]          -- args
+    -> UniqSM StixStmtList
 \end{code}
 
-@UPD_CAF@ involves changing the info pointer of the closure, adding an indirection,
-and putting the new CAF on a linked list for the storage manager.
-
-\begin{code}
-
-  genmacro UPD_CAF args =
-    let [cafptr,bhptr] = map a2stix args
-       w0 = StInd PtrKind cafptr
-       w1 = StInd PtrKind (StIndex PtrKind cafptr (StInt 1))
-       w2 = StInd PtrKind (StIndex PtrKind cafptr (StInt 2))
-       a1 = StAssign PtrKind w0 caf_info
-       a2 = StAssign PtrKind w1 smCAFlist
-       a3 = StAssign PtrKind w2 bhptr
-       a4 = StAssign PtrKind smCAFlist cafptr
-    in
-       returnSUs (\xs -> a1 : a2 : a3 : a4 : xs)
-
-\end{code}
+-----------------------------------------------------------------------------
+Updating a CAF
 
-@UPD_IND@ is complicated by the fact that we are supporting the
-Appel-style garbage collector by default.  This means some extra work
-if we update an old generation object.
+@UPD_CAF@ involves changing the info pointer of the closure, and
+adding an indirection.
 
 \begin{code}
-
-  genmacro UPD_IND args = 
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let [updptr, heapptr] = map a2stix args
-       test = StPrim AddrGtOp [updptr, smOldLim]
-       cjmp = StCondJump ulbl test
-       updRoots = StAssign PtrKind smOldMutables updptr
-       join = StLabel ulbl
-       upd0 = StAssign PtrKind (StInd PtrKind updptr) ind_info
-       upd1 = StAssign PtrKind (StInd PtrKind 
-               (StIndex PtrKind updptr (StInt 1))) smOldMutables
-       upd2 = StAssign PtrKind (StInd PtrKind 
-               (StIndex PtrKind updptr (StInt 2))) heapptr
+macroCode UPD_CAF [cafptr,bhptr]
+  = let
+       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
     in
-       returnSUs (\xs -> cjmp : upd1 : updRoots : join : upd0 : upd2 : xs)
-
-\end{code}
-
-@UPD_INPLACE_NOPTRS@ is only needed for ticky-ticky profiling.
-
-\begin{code}
-
-  genmacro UPD_INPLACE_NOPTRS args = returnSUs id
-
+    returnUs (\xs -> new_caf : a1 : a2 : xs)
 \end{code}
 
-@UPD_INPLACE_PTRS@ is complicated by the fact that we are supporting
-the Appel-style garbage collector by default.  This means some extra work 
-if we update an old generation object.
-
-\begin{code}
+-----------------------------------------------------------------------------
+Blackholing
 
-  genmacro UPD_INPLACE_PTRS [liveness] =
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let cjmp = StCondJump ulbl testOldLim
-        testOldLim = StPrim AddrGtOp [stgNode, smOldLim]
-       join = StLabel ulbl
-        updUpd0 = StAssign PtrKind (StInd PtrKind stgNode) ind_info
-       updUpd1 = StAssign PtrKind (StInd PtrKind 
-                   (StIndex PtrKind stgNode (StInt 1))) smOldMutables
-       updUpd2 = StAssign PtrKind (StInd PtrKind 
-                   (StIndex PtrKind stgNode (StInt 2))) hpBack2
-       hpBack2 = StIndex PtrKind stgHp (StInt (-2))
-       updOldMutables = StAssign PtrKind smOldMutables stgNode
-       updUpdReg = StAssign PtrKind stgNode hpBack2
-    in
-       genmacro HEAP_CHK [liveness, mkIntCLit_3, mkIntCLit_0]
-                                                       `thenSUs` \ heap_chk ->
-       returnSUs (\xs -> (cjmp : 
-                           heap_chk (updUpd0 : updUpd1 : updUpd2 : 
-                                       updOldMutables : updUpdReg : join : xs)))
+We do lazy blackholing: no need to overwrite thunks with blackholes
+the minute they're entered, as long as we do it before a context
+switch or garbage collection, that's ok.
 
-\end{code}
+Don't blackhole single entry closures, for the following reasons:
+       
+       - if the compiler has decided that they won't be entered again,
+         that probably means that nothing has a pointer to it
+         (not necessarily true, but...)
 
-@UPD_BH_UPDATABLE@ is only used when running concurrent threads (in
-the sequential case, the GC takes care of this).  However, we do need
-to handle @UPD_BH_SINGLE_ENTRY@ in all cases.
+       - no need to blackhole for concurrency reasons, because nothing
+         can block on the result of this computation.
 
 \begin{code}
+macroCode UPD_BH_UPDATABLE args = returnUs id
 
-  genmacro UPD_BH_UPDATABLE args = returnSUs id
-
-  genmacro UPD_BH_SINGLE_ENTRY [arg] =
-    let
-       update = StAssign PtrKind (StInd PtrKind (a2stix arg)) bh_info
+macroCode UPD_BH_SINGLE_ENTRY args = returnUs id
+{-
+  = let
+       update = StAssign PtrRep (StInd PtrRep arg) bh_info
     in
-        returnSUs (\xs -> update : xs)
-
+    returnUs (\xs -> update : xs)
+-}
 \end{code}
 
-Push a four word update frame on the stack and slide the Su[AB]
-registers to the current Sp[AB] locations.
-
-\begin{code}
-
-  genmacro PUSH_STD_UPD_FRAME args =
-    let [bhptr, aWords, bWords] = map a2stix args
-       frame n = StInd PtrKind 
-           (StIndex PtrKind stgSpB (StPrim IntAddOp 
-               [bWords, StInt (toInteger (sTD_UF_SIZE - n))]))
-
-       a1 = StAssign PtrKind (frame uF_RET) stgRetReg
-       a2 = StAssign PtrKind (frame uF_SUB) stgSuB
-       a3 = StAssign PtrKind (frame uF_SUA) stgSuA
-       a4 = StAssign PtrKind (frame uF_UPDATEE) bhptr
-
-       updSuB = StAssign PtrKind
-           stgSuB (StIndex PtrKind stgSpB (StPrim IntAddOp 
-               [bWords, StInt (toInteger sTD_UF_SIZE)]))
-       updSuA = StAssign PtrKind
-           stgSuA (StIndex PtrKind stgSpA (StPrim IntNegOp [aWords]))
-    in
-       returnSUs (\xs -> a1 : a2 : a3 : a4 : updSuB : updSuA : xs)
-
-\end{code}
+-----------------------------------------------------------------------------
+Update frames
 
-Pop a standard update frame.
+Push an update frame on the stack.
 
 \begin{code}
+macroCode PUSH_UPD_FRAME [bhptr, _{-0-}]
+  = let
+       frame n = StIndex PtrRep (StReg stgSp) (StInt (toInteger (n-uF_SIZE)))
 
-  genmacro POP_STD_UPD_FRAME args =
-    let frame n = StInd PtrKind (StIndex PtrKind stgSpB (StInt (toInteger (-n))))
-
-       grabRet = StAssign PtrKind stgRetReg (frame uF_RET)
-       grabSuB = StAssign PtrKind stgSuB    (frame uF_SUB)
-       grabSuA = StAssign PtrKind stgSuA    (frame uF_SUA)
-
-       updSpB = StAssign PtrKind
-           stgSpB (StIndex PtrKind stgSpB (StInt (toInteger (-sTD_UF_SIZE))))
+        -- HWL: these values are *wrong* in a GranSim setup; ToDo: fix
+       a1 = StAssignMem PtrRep (frame uF_RET)     upd_frame_info
+       a4 = StAssignMem PtrRep (frame uF_UPDATEE) bhptr
     in
-       returnSUs (\xs -> grabRet : grabSuB : grabSuA : updSpB : xs)
-
+    returnUs (\xs -> a1 : a4 : xs)
 \end{code}
 
-@PUSH_CON_UPD_FRAME@ appears to be unused at the moment.
+-----------------------------------------------------------------------------
+Setting the tag register
 
-\begin{code}
-{- UNUSED:
-  genmacro PUSH_CON_UPD_FRAME args = 
-    panic "genMacroCode:PUSH_CON_UPD_FRAME"
--}
-\end{code}
-
-The @SET_ARITY@ and @CHK_ARITY@ macros are disabled for ``normal'' compilation.
+This one only applies if we have a machine register devoted to TagReg.
 
 \begin{code}
-
-  genmacro SET_ARITY args = returnSUs id
-  genmacro CHK_ARITY args = returnSUs id
-
+macroCode SET_TAG [tag]
+  = case get_MagicId_reg_or_addr tagreg of
+       Right baseRegAddr 
+          -> returnUs id
+       Left  realreg 
+          -> let a1 = StAssignReg IntRep (StixMagicId tagreg) tag
+             in returnUs ( \xs -> a1 : xs )
 \end{code}
 
-This one only applies if we have a machine register devoted to TagReg.
+-----------------------------------------------------------------------------
 
 \begin{code}
-
-  genmacro SET_TAG [tag] = 
-    let set_tag = StAssign IntKind stgTagReg (a2stix tag)
-    in
-        case stg_reg TagReg of
-            Always _ -> returnSUs id
-            Save _ -> returnSUs (\xs -> set_tag : xs)
-
+macroCode REGISTER_IMPORT [arg]
+   = returnUs (
+       \xs -> StAssignMem WordRep (StReg stgSp) arg
+            : StAssignReg PtrRep  stgSp (StMachOp MO_Nat_Add [StReg stgSp, StInt 4])
+            : xs
+     )
+
+macroCode REGISTER_FOREIGN_EXPORT [arg]
+   = returnUs (
+       \xs -> StVoidable (
+                  StCall (Left FSLIT("getStablePtr")) CCallConv VoidRep 
+                         [arg]
+               )
+            : xs
+     )
+
+macroCode other args
+   = panic "StixMacro.macroCode"
 \end{code}
 
 Do the business for a @HEAP_CHK@, having converted the args to Trees
 of StixOp.
 
-\begin{code}
-
-doHeapCheck 
-    :: {- unused now: Target 
-    -> -}StixTree      -- liveness
-    -> StixTree        -- words needed
-    -> StixTree        -- always reenter node? (boolean)
-    -> SUniqSM StixTreeList
-
-doHeapCheck {-target:unused now-} liveness words reenter =
-    getUniqLabelNCG                                    `thenSUs` \ ulbl ->
-    let newHp = StIndex PtrKind stgHp words
-       assign = StAssign PtrKind stgHp newHp
-       test = StPrim AddrLeOp [stgHp, stgHpLim]
-       cjmp = StCondJump ulbl test
-        arg = StPrim IntAddOp [StPrim IntMulOp [words, StInt 256], liveness]
-       -- ToDo: Overflow?  (JSM)
-       gc = StCall SLIT("PerformGC_wrapper") VoidKind [arg]
-       join = StLabel ulbl
-    in
-       returnSUs (\xs -> assign : cjmp : gc : join : xs)
-
-\end{code}
-
+-----------------------------------------------------------------------------
 Let's make sure that these CAFs are lifted out, shall we?
 
 \begin{code}
-
 -- Some common labels
 
-bh_info, caf_info, ind_info :: StixTree
+bh_info, ind_static_info :: StixExpr
 
-bh_info   = sStLitLbl SLIT("BH_SINGLE_info")
-caf_info  = sStLitLbl SLIT("Caf_info")
-ind_info  = sStLitLbl SLIT("Ind_info")
+bh_info        = StCLbl mkBlackHoleInfoTableLabel
+ind_static_info        = StCLbl mkIndStaticInfoLabel
+upd_frame_info = StCLbl mkUpdInfoLabel
 
 -- Some common call trees
-
-updatePAP, stackOverflow :: StixTree
-
-updatePAP     = StJump (sStLitLbl SLIT("UpdatePAP"))
-stackOverflow = StCall SLIT("StackOverflow") VoidKind []
-
 \end{code}
 
-Storage manager nonsense.  Note that the indices are dependent on 
-the definition of the smInfo structure in SMinterface.lh
+-----------------------------------------------------------------------------
+Heap/Stack checks
 
 \begin{code}
-
-#include "../../includes/platform.h"
-
-#if alpha_TARGET_ARCH
-#include "../../includes/alpha-dec-osf1.h"
-#else
-#if sunos4_TARGET_OS
-#include "../../includes/sparc-sun-sunos4.h"
-#else
-#include "../../includes/sparc-sun-solaris2.h"
-#endif
-#endif
-
-storageMgrInfo, smCAFlist, smOldMutables, smOldLim :: StixTree
-
-storageMgrInfo = sStLitLbl SLIT("StorageMgrInfo")
-smCAFlist  = StInd PtrKind (StIndex PtrKind storageMgrInfo (StInt SM_CAFLIST))
-smOldMutables = StInd PtrKind (StIndex PtrKind storageMgrInfo (StInt SM_OLDMUTABLES))
-smOldLim   = StInd PtrKind (StIndex PtrKind storageMgrInfo (StInt SM_OLDLIM))
-
-smStablePtrTable = StInd PtrKind 
-                        (StIndex PtrKind storageMgrInfo (StInt SM_STABLEPOINTERTABLE))
-
+checkCode :: CCheckMacro -> [CAddrMode] -> StixStmtList -> UniqSM StixStmtList
+checkCode macro args assts
+  = getUniqLabelNCG            `thenUs` \ ulbl_fail ->
+    getUniqLabelNCG            `thenUs` \ ulbl_pass ->
+
+    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
+       test_hp          = StMachOp MO_NatU_Le [StReg stgHp, StReg stgHpLim]
+       cjmp_hp          = StCondJump ulbl_pass test_hp
+       newSp wds        = StIndex PtrRep (StReg stgSp) (StMachOp MO_NatS_Neg [wds])
+       test_sp_pass wds = StMachOp MO_NatU_Ge [newSp wds, StReg stgSpLim]
+       test_sp_fail wds = StMachOp MO_NatU_Lt [newSp wds, StReg stgSpLim]
+       cjmp_sp_pass wds = StCondJump ulbl_pass (test_sp_pass wds)
+       cjmp_sp_fail wds = StCondJump ulbl_fail (test_sp_fail wds)
+       assign_ret r ret = mkStAssign CodePtrRep r ret
+
+       fail = StLabel ulbl_fail
+       join = StLabel ulbl_pass
+
+        -- see includes/StgMacros.h for explaination of these magic consts
+        aLL_NON_PTRS = 0xff
+
+        assign_liveness ptr_regs 
+           = StAssignReg WordRep stgR9
+                         (StMachOp MO_Nat_Xor [StInt aLL_NON_PTRS, ptr_regs])
+        assign_reentry reentry 
+           = StAssignReg WordRep stgR10 reentry
+    in 
+
+    returnUs (
+    case macro of
+       HP_CHK_NP      -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_enter : join : xs))
+
+       STK_CHK_NP     -> 
+               let [words] = args_stix
+               in  (\xs -> cjmp_sp_pass words :
+                           assts (gc_enter : join : xs))
+
+       HP_STK_CHK_NP  -> 
+               let [sp_words,hp_words] = args_stix
+               in  (\xs -> cjmp_sp_fail sp_words : 
+                           assign_hp hp_words : cjmp_hp :
+                           fail :
+                           assts (hp_alloc hp_words : gc_enter
+                                  : join : xs))
+
+       HP_CHK_FUN       -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp :
+                           assts (hp_alloc words : gc_fun : join : xs))
+
+       STK_CHK_FUN       -> 
+               let [words] = args_stix
+               in  (\xs -> cjmp_sp_pass words :
+                           assts (gc_fun : join : xs))
+
+       HP_STK_CHK_FUN    -> 
+               let [sp_words,hp_words] = args_stix
+               in  (\xs -> cjmp_sp_fail sp_words :
+                           assign_hp hp_words : cjmp_hp :
+                           fail :
+                           assts (hp_alloc hp_words
+                                 : gc_fun : join : xs))
+
+       HP_CHK_NOREGS  -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_noregs : join : xs))
+
+       HP_CHK_UNPT_R1 -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_unpt_r1 : join : xs))
+
+       HP_CHK_UNBX_R1 -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_unbx_r1 : join : xs))
+
+       HP_CHK_F1      -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_f1 : join : xs))
+
+       HP_CHK_D1      -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_d1 : join : xs))
+
+       HP_CHK_L1      -> 
+               let [words] = args_stix
+               in  (\xs -> assign_hp words : cjmp_hp : 
+                           assts (hp_alloc words : gc_l1 : join : xs))
+
+       HP_CHK_UNBX_TUPLE  -> 
+                let [words,liveness] = args_stix
+                in (\xs -> assign_hp words : cjmp_hp :
+                           assts (hp_alloc words : assign_liveness liveness :
+                                  gc_ut : join : xs))
+    )
+
+-- Various canned heap-check routines
+
+mkStJump_to_GCentry_name :: String -> StixStmt
+mkStJump_to_GCentry_name gcname
+--   | opt_Static
+   = StJump NoDestInfo (StCLbl (mkRtsGCEntryLabel gcname))
+--   | otherwise -- it's in a different DLL
+--   = StJump (StInd PtrRep (StLitLbl True sdoc))
+
+mkStJump_to_RegTable_offw :: Int -> StixStmt
+mkStJump_to_RegTable_offw regtable_offw
+--   | opt_Static
+   = StJump NoDestInfo (StInd PtrRep (get_Regtable_addr_from_offset regtable_offw))
+--   | otherwise
+--   do something plausible for cross-DLL jump
+
+gc_enter = mkStJump_to_RegTable_offw OFFSET_stgGCEnter1
+gc_fun   = mkStJump_to_RegTable_offw OFFSET_stgGCFun
+
+gc_noregs          = mkStJump_to_GCentry_name "stg_gc_noregs"
+gc_unpt_r1         = mkStJump_to_GCentry_name "stg_gc_unpt_r1"
+gc_unbx_r1         = mkStJump_to_GCentry_name "stg_gc_unbx_r1"
+gc_f1              = mkStJump_to_GCentry_name "stg_gc_f1"
+gc_d1              = mkStJump_to_GCentry_name "stg_gc_d1"
+gc_l1              = mkStJump_to_GCentry_name "stg_gc_l1"
+gc_ut              = mkStJump_to_GCentry_name "stg_gc_ut"
 \end{code}