X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FStixMacro.lhs;h=09cdc427638c51e3eb75448aa1a489c00f8b6924;hb=fec20b7d33297ee09c5b259255b9858fda56e438;hp=b244110f0277c3593c10937bd9506b3623dce014;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/StixMacro.lhs b/ghc/compiler/nativeGen/StixMacro.lhs index b244110..09cdc42 100644 --- a/ghc/compiler/nativeGen/StixMacro.lhs +++ b/ghc/compiler/nativeGen/StixMacro.lhs @@ -1,27 +1,27 @@ % -% (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, UniqSupply, CAddrMode, CExprMacro, - CStmtMacro - ) where +import {-# SOURCE #-} StixPrim ( amodeToStix ) -import AbsCSyn -import PrelInfo ( 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_SU, uF_UPDATEE, uF_SIZE ) +import CallConv ( cCallConv ) +import PrimOp ( PrimOp(..) ) +import PrimRep ( PrimRep(..) ) import Stix -import UniqSupply -import Util +import UniqSupply ( returnUs, thenUs, UniqSM ) +import CLabel ( mkBlackHoleInfoTableLabel, mkIndStaticInfoLabel, + mkIndInfoLabel, mkUpdInfoLabel, mkSeqInfoLabel, + mkRtsGCEntryLabel, mkStgUpdatePAPLabel ) \end{code} The @ARGS_CHK_A{_LOAD_NODE}@ macros check for sufficient arguments on @@ -30,346 +30,328 @@ 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 +macroCode + :: CStmtMacro -- statement macro -> [CAddrMode] -- args -> UniqSM 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 `thenUs` \ ulbl -> - let [words, lbl] = map a2stix args - temp = StIndex PtrRep stgSpA words - test = StPrim AddrGeOp [stgSuA, temp] - cjmp = StCondJump ulbl test - assign = StAssign PtrRep stgNode lbl - join = StLabel ulbl - in - returnUs (\xs -> cjmp : assign : updatePAP : join : xs) - - genmacro ARGS_CHK_A [words] = - getUniqLabelNCG `thenUs` \ ulbl -> - let temp = StIndex PtrRep stgSpA (a2stix words) - test = StPrim AddrGeOp [stgSuA, temp] - cjmp = StCondJump ulbl test - join = StLabel ulbl - in - returnUs (\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. +----------------------------------------------------------------------------- +Argument satisfaction checks. \begin{code} - - genmacro ARGS_CHK_B_LOAD_NODE args = - getUniqLabelNCG `thenUs` \ ulbl -> - let [words, lbl] = map a2stix args - temp = StIndex PtrRep stgSuB (StPrim IntNegOp [words]) - test = StPrim AddrGeOp [stgSpB, temp] - cjmp = StCondJump ulbl test - assign = StAssign PtrRep stgNode lbl - join = StLabel ulbl +macroCode ARGS_CHK_LOAD_NODE args + = getUniqLabelNCG `thenUs` \ ulbl -> + let + [words, lbl] = map amodeToStix args + temp = StIndex PtrRep stgSp words + test = StPrim AddrGeOp [stgSu, temp] + cjmp = StCondJump ulbl test + assign = StAssign PtrRep stgNode lbl + join = StLabel ulbl in - returnUs (\xs -> cjmp : assign : updatePAP : join : xs) + returnUs (\xs -> cjmp : assign : updatePAP : join : xs) - genmacro ARGS_CHK_B [words] = - getUniqLabelNCG `thenUs` \ ulbl -> - let temp = StIndex PtrRep stgSuB (StPrim IntNegOp [a2stix words]) - test = StPrim AddrGeOp [stgSpB, temp] +macroCode ARGS_CHK [words] + = getUniqLabelNCG `thenUs` \ ulbl -> + let temp = StIndex PtrRep stgSp (amodeToStix words) + test = StPrim AddrGeOp [stgSu, temp] cjmp = StCondJump ulbl test join = StLabel ulbl in - returnUs (\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 liveness words reenter + returnUs (\xs -> cjmp : updatePAP : join : xs) \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 `thenUs` \ ulbl -> - let words = StPrim IntNegOp - [StPrim IntAddOp [a2stix aWords, a2stix bWords]] - temp = StIndex PtrRep stgSpA words - test = StPrim AddrGtOp [temp, stgSpB] - cjmp = StCondJump ulbl test - join = StLabel ulbl - in - returnUs (\xs -> cjmp : stackOverflow : join : xs) --} - returnUs id +----------------------------------------------------------------------------- +Updating a CAF -\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. +@UPD_CAF@ involves changing the info pointer of the closure, and +adding an indirection. \begin{code} - - genmacro UPD_CAF args = - let [cafptr,bhptr] = map a2stix args +macroCode UPD_CAF args + = let + [cafptr,bhptr] = map amodeToStix args w0 = StInd PtrRep cafptr - w1 = StInd PtrRep (StIndex PtrRep cafptr (StInt 1)) - w2 = StInd PtrRep (StIndex PtrRep cafptr (StInt 2)) - a1 = StAssign PtrRep w0 caf_info - a2 = StAssign PtrRep w1 smCAFlist - a3 = StAssign PtrRep w2 bhptr - a4 = StAssign PtrRep smCAFlist cafptr + w1 = StInd PtrRep (StIndex PtrRep cafptr fixedHS) + a1 = StAssign PtrRep w0 ind_static_info + a2 = StAssign PtrRep w1 bhptr + a3 = StCall SLIT("newCAF") cCallConv VoidRep [cafptr] in - returnUs (\xs -> a1 : a2 : a3 : a4 : xs) - -\end{code} - -@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. - -\begin{code} - - genmacro UPD_IND args = - getUniqLabelNCG `thenUs` \ ulbl -> - let [updptr, heapptr] = map a2stix args - test = StPrim AddrGtOp [updptr, smOldLim] - cjmp = StCondJump ulbl test - updRoots = StAssign PtrRep smOldMutables updptr - join = StLabel ulbl - upd0 = StAssign PtrRep (StInd PtrRep updptr) ind_info - upd1 = StAssign PtrRep (StInd PtrRep - (StIndex PtrRep updptr (StInt 1))) smOldMutables - upd2 = StAssign PtrRep (StInd PtrRep - (StIndex PtrRep updptr (StInt 2))) heapptr - in - returnUs (\xs -> cjmp : upd1 : updRoots : join : upd0 : upd2 : xs) - + returnUs (\xs -> a1 : a2 : a3 : xs) \end{code} -@UPD_INPLACE_NOPTRS@ is only needed for ticky-ticky profiling. +----------------------------------------------------------------------------- +Blackholing -\begin{code} - - genmacro UPD_INPLACE_NOPTRS args = returnUs id +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_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. + - 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_INPLACE_PTRS [liveness] = - getUniqLabelNCG `thenUs` \ ulbl -> - let cjmp = StCondJump ulbl testOldLim - testOldLim = StPrim AddrGtOp [stgNode, smOldLim] - join = StLabel ulbl - updUpd0 = StAssign PtrRep (StInd PtrRep stgNode) ind_info - updUpd1 = StAssign PtrRep (StInd PtrRep - (StIndex PtrRep stgNode (StInt 1))) smOldMutables - updUpd2 = StAssign PtrRep (StInd PtrRep - (StIndex PtrRep stgNode (StInt 2))) hpBack2 - hpBack2 = StIndex PtrRep stgHp (StInt (-2)) - updOldMutables = StAssign PtrRep smOldMutables stgNode - updUpdReg = StAssign PtrRep stgNode hpBack2 +macroCode UPD_BH_SINGLE_ENTRY args = returnUs id +{- + = let + update = StAssign PtrRep (StInd PtrRep (amodeToStix arg)) bh_info in - genmacro HEAP_CHK [liveness, mkIntCLit_3, mkIntCLit_0] - `thenUs` \ heap_chk -> - returnUs (\xs -> (cjmp : - heap_chk (updUpd0 : updUpd1 : updUpd2 : - updOldMutables : updUpdReg : join : xs))) - + returnUs (\xs -> update : xs) +-} \end{code} -@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. +----------------------------------------------------------------------------- +Update frames -\begin{code} - - genmacro UPD_BH_UPDATABLE args = returnUs id - - genmacro UPD_BH_SINGLE_ENTRY [arg] = - let - update = StAssign PtrRep (StInd PtrRep (a2stix arg)) bh_info - in - 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. +Push a four word update frame on the stack and slide the Su registers +to the current Sp location. \begin{code} - - genmacro PUSH_STD_UPD_FRAME args = - let [bhptr, aWords, bWords] = map a2stix args +macroCode PUSH_UPD_FRAME args + = let + [bhptr, _{-0-}] = map amodeToStix args frame n = StInd PtrRep - (StIndex PtrRep stgSpB (StPrim IntAddOp - [bWords, StInt (toInteger (sTD_UF_SIZE - n))])) + (StIndex PtrRep stgSp (StInt (toInteger (n-uF_SIZE)))) - a1 = StAssign PtrRep (frame uF_RET) stgRetReg - a2 = StAssign PtrRep (frame uF_SUB) stgSuB - a3 = StAssign PtrRep (frame uF_SUA) stgSuA + -- HWL: these values are *wrong* in a GranSim setup; ToDo: fix + a1 = StAssign PtrRep (frame uF_RET) upd_frame_info + a3 = StAssign PtrRep (frame uF_SU) stgSu a4 = StAssign PtrRep (frame uF_UPDATEE) bhptr - updSuB = StAssign PtrRep - stgSuB (StIndex PtrRep stgSpB (StPrim IntAddOp - [bWords, StInt (toInteger sTD_UF_SIZE)])) - updSuA = StAssign PtrRep - stgSuA (StIndex PtrRep stgSpA (StPrim IntNegOp [aWords])) + updSu = StAssign PtrRep stgSu + (StIndex PtrRep stgSp (StInt (toInteger (-uF_SIZE)))) in - returnUs (\xs -> a1 : a2 : a3 : a4 : updSuB : updSuA : xs) - + returnUs (\xs -> a1 : a3 : a4 : updSu : xs) + + +macroCode PUSH_SEQ_FRAME args + = let [arg_frame] = map amodeToStix args + frame n = StInd PtrRep + (StIndex PtrRep arg_frame (StInt (toInteger n))) + a1 = StAssign PtrRep (frame 0) seq_frame_info + a2 = StAssign PtrRep (frame 1) stgSu + updSu = StAssign PtrRep stgSu arg_frame + in + returnUs (\xs -> a1 : a2 : updSu : xs) + + +macroCode UPDATE_SU_FROM_UPD_FRAME args + = let [arg_frame] = map amodeToStix args + frame n = StInd PtrRep + (StIndex PtrRep arg_frame (StInt (toInteger n))) + updSu + = StAssign PtrRep stgSu (frame uF_SU) + in + returnUs (\xs -> updSu : xs) \end{code} -Pop a standard update frame. - -\begin{code} +----------------------------------------------------------------------------- +Setting the tag register - genmacro POP_STD_UPD_FRAME args = - let frame n = StInd PtrRep (StIndex PtrRep stgSpB (StInt (toInteger (-n)))) - - grabRet = StAssign PtrRep stgRetReg (frame uF_RET) - grabSuB = StAssign PtrRep stgSuB (frame uF_SUB) - grabSuA = StAssign PtrRep stgSuA (frame uF_SUA) +This one only applies if we have a machine register devoted to TagReg. - updSpB = StAssign PtrRep - stgSpB (StIndex PtrRep stgSpB (StInt (toInteger (-sTD_UF_SIZE)))) +\begin{code} +macroCode SET_TAG [tag] + = let set_tag = StAssign IntRep stgTagReg (amodeToStix tag) in - returnUs (\xs -> grabRet : grabSuB : grabSuA : updSpB : xs) - + case stgReg tagreg of + Always _ -> returnUs id + Save _ -> returnUs (\ xs -> set_tag : xs) \end{code} -The @SET_ARITY@ and @CHK_ARITY@ macros are disabled for ``normal'' -compilation. -\begin{code} - genmacro SET_ARITY args = returnUs id - genmacro CHK_ARITY args = returnUs id -\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 IntRep stgTagReg (a2stix tag) - in - case stg_reg TagReg of - Always _ -> returnUs id - Save _ -> returnUs (\ xs -> set_tag : xs) +macroCode REGISTER_IMPORT [arg] + = returnUs ( + \xs -> StAssign WordRep (StInd WordRep stgSp) (amodeToStix arg) + : StAssign PtrRep stgSp (StPrim IntAddOp [stgSp, StInt 4]) + : xs + ) + +macroCode REGISTER_FOREIGN_EXPORT [arg] + = returnUs ( + \xs -> StCall SLIT("getStablePtr") cCallConv VoidRep [amodeToStix arg] + : xs + ) + +macroCode other args + = case other of + SET_TAG -> error "foobarxyzzy8" + _ -> error "StixMacro.macroCode: unknown macro/args" \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) - -> UniqSM StixTreeList - -doHeapCheck {-target:unused now-} liveness words reenter = - getUniqLabelNCG `thenUs` \ ulbl -> - let newHp = StIndex PtrRep stgHp words - assign = StAssign PtrRep 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") VoidRep [arg] - join = StLabel ulbl - in - returnUs (\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 = sStLitLbl SLIT("BH_SINGLE_info") -caf_info = sStLitLbl SLIT("Caf_info") -ind_info = sStLitLbl SLIT("Ind_info") +bh_info, ind_static_info, ind_info :: StixTree +bh_info = StCLbl mkBlackHoleInfoTableLabel +ind_static_info = StCLbl mkIndStaticInfoLabel +ind_info = StCLbl mkIndInfoLabel +upd_frame_info = StCLbl mkUpdInfoLabel +seq_frame_info = StCLbl mkSeqInfoLabel +stg_update_PAP = StCLbl mkStgUpdatePAPLabel -- Some common call trees updatePAP, stackOverflow :: StixTree -updatePAP = StJump (sStLitLbl SLIT("UpdatePAP")) -stackOverflow = StCall SLIT("StackOverflow") VoidRep [] - +updatePAP = StJump NoDestInfo stg_update_PAP +stackOverflow = StCall SLIT("StackOverflow") cCallConv VoidRep [] \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 PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_CAFLIST)) -smOldMutables = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDMUTABLES)) -smOldLim = StInd PtrRep (StIndex PtrRep storageMgrInfo (StInt SM_OLDLIM)) - -smStablePtrTable = StInd PtrRep - (StIndex PtrRep storageMgrInfo (StInt SM_STABLEPOINTERTABLE)) - +checkCode :: CCheckMacro -> [CAddrMode] -> StixTreeList -> UniqSM StixTreeList +checkCode macro args assts + = getUniqLabelNCG `thenUs` \ ulbl_fail -> + getUniqLabelNCG `thenUs` \ ulbl_pass -> + + let args_stix = map amodeToStix args + newHp wds = StIndex PtrRep stgHp wds + assign_hp wds = StAssign PtrRep stgHp (newHp wds) + test_hp = StPrim AddrLeOp [stgHp, stgHpLim] + cjmp_hp = StCondJump ulbl_pass test_hp + + newSp wds = StIndex PtrRep stgSp (StPrim IntNegOp [wds]) + test_sp_pass wds = StPrim AddrGeOp [newSp wds, stgSpLim] + test_sp_fail wds = StPrim AddrLtOp [newSp wds, 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 = StAssign CodePtrRep r ret + + fail = StLabel ulbl_fail + join = StLabel ulbl_pass + + -- see includes/StgMacros.h for explaination of these magic consts + aLL_NON_PTRS + = IF_ARCH_alpha(16383,65535) + + assign_liveness ptr_regs + = StAssign WordRep stgR9 + (StPrim XorOp [StInt aLL_NON_PTRS, ptr_regs]) + assign_reentry reentry + = StAssign WordRep stgR10 reentry + in + + returnUs ( + case macro of + HP_CHK_NP -> + let [words,ptrs] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_enter ptrs : join : xs)) + + HP_CHK_SEQ_NP -> + let [words,ptrs] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_seq ptrs : join : xs)) + + STK_CHK_NP -> + let [words,ptrs] = args_stix + in (\xs -> cjmp_sp_pass words : + assts (gc_enter ptrs : join : xs)) + + HP_STK_CHK_NP -> + let [sp_words,hp_words,ptrs] = args_stix + in (\xs -> cjmp_sp_fail sp_words : + assign_hp hp_words : cjmp_hp : + fail : + assts (gc_enter ptrs : join : xs)) + + HP_CHK -> + let [words,ret,r,ptrs] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (assign_ret r ret : gc_chk ptrs : join : xs)) + + STK_CHK -> + let [words,ret,r,ptrs] = args_stix + in (\xs -> cjmp_sp_pass words : + assts (assign_ret r ret : gc_chk ptrs : join : xs)) + + HP_STK_CHK -> + let [sp_words,hp_words,ret,r,ptrs] = args_stix + in (\xs -> cjmp_sp_fail sp_words : + assign_hp hp_words : cjmp_hp : + fail : + assts (assign_ret r ret : gc_chk ptrs : join : xs)) + + HP_CHK_NOREGS -> + let [words] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_noregs : join : xs)) + + HP_CHK_UNPT_R1 -> + let [words] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_unpt_r1 : join : xs)) + + HP_CHK_UNBX_R1 -> + let [words] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_unbx_r1 : join : xs)) + + HP_CHK_F1 -> + let [words] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_f1 : join : xs)) + + HP_CHK_D1 -> + let [words] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (gc_d1 : join : xs)) + + HP_CHK_UT_ALT -> + let [words,ptrs,nonptrs,r,ret] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (assign_ret r ret : gc_ut ptrs nonptrs + : join : xs)) + + HP_CHK_GEN -> + let [words,liveness,reentry] = args_stix + in (\xs -> assign_hp words : cjmp_hp : + assts (assign_liveness liveness : + assign_reentry reentry : + gc_gen : join : xs)) + ) + +-- Various canned heap-check routines + +mkStJump_to_GCentry :: String -> StixTree +mkStJump_to_GCentry gcname +-- | opt_Static + = StJump NoDestInfo (StCLbl (mkRtsGCEntryLabel gcname)) +-- | otherwise -- it's in a different DLL +-- = StJump (StInd PtrRep (StLitLbl True sdoc)) + +gc_chk (StInt n) = mkStJump_to_GCentry ("stg_chk_" ++ show n) +gc_enter (StInt n) = mkStJump_to_GCentry ("stg_gc_enter_" ++ show n) +gc_seq (StInt n) = mkStJump_to_GCentry ("stg_gc_seq_" ++ show n) +gc_noregs = mkStJump_to_GCentry "stg_gc_noregs" +gc_unpt_r1 = mkStJump_to_GCentry "stg_gc_unpt_r1" +gc_unbx_r1 = mkStJump_to_GCentry "stg_gc_unbx_r1" +gc_f1 = mkStJump_to_GCentry "stg_gc_f1" +gc_d1 = mkStJump_to_GCentry "stg_gc_d1" +gc_gen = mkStJump_to_GCentry "stg_gen_chk" +gc_ut (StInt p) (StInt np) + = mkStJump_to_GCentry ("stg_gc_ut_" ++ show p + ++ "_" ++ show np) \end{code}