diff --git a/ghc/compiler/nativeGen/MachRegs.lhs b/ghc/compiler/nativeGen/MachRegs.lhs
index 7bafa78a5224ebf96860bdaef4d1a72bc9e15155..0ee345a1efe0ab6419fcd8c94b1dc5b94c5fed4e 100644
--- a/ghc/compiler/nativeGen/MachRegs.lhs
+++ b/ghc/compiler/nativeGen/MachRegs.lhs
@@ -560,6 +560,8 @@ baseRegOffset (VanillaReg _ ILIT(5)) = OFFSET_R5
 baseRegOffset (VanillaReg _ ILIT(6)) = OFFSET_R6
 baseRegOffset (VanillaReg _ ILIT(7)) = OFFSET_R7
 baseRegOffset (VanillaReg _ ILIT(8)) = OFFSET_R8
+baseRegOffset (VanillaReg _ ILIT(9)) = OFFSET_R9
+baseRegOffset (VanillaReg _ ILIT(10)) = OFFSET_R10
 baseRegOffset (FloatReg  ILIT(1))    = OFFSET_F1
 baseRegOffset (FloatReg  ILIT(2))    = OFFSET_F2
 baseRegOffset (FloatReg  ILIT(3))    = OFFSET_F3
diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs
index 7945f1e51f22de436f2d092a43c2eb9823d07887..e5dd49d835015bad463fa3464da8188fc461008c 100644
--- a/ghc/compiler/nativeGen/Stix.lhs
+++ b/ghc/compiler/nativeGen/Stix.lhs
@@ -7,7 +7,8 @@ module Stix (
 	CodeSegment(..), StixReg(..), StixTree(..), StixTreeList,
 	sStLitLbl, pprStixTrees,
 
-	stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, stgHp, stgHpLim, stgTagReg,
+	stgBaseReg, stgNode, stgSp, stgSu, stgSpLim, 
+        stgHp, stgHpLim, stgTagReg, stgR9, stgR10,
 	getUniqLabelNCG,
 
 	fixedHS, arrWordsHS, arrPtrsHS
@@ -21,7 +22,7 @@ import AbsCSyn		( node, tagreg, MagicId(..) )
 import AbsCUtils	( magicIdPrimRep )
 import CallConv		( CallConv, pprCallConv )
 import CLabel		( mkAsmTempLabel, CLabel, pprCLabel, pprCLabel_asm )
-import PrimRep          ( PrimRep, showPrimRep )
+import PrimRep          ( PrimRep(..), showPrimRep )
 import PrimOp           ( PrimOp, pprPrimOp )
 import Unique           ( Unique )
 import SMRep		( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
@@ -203,6 +204,8 @@ stgSu 		    = StReg (StixMagicId Su)
 stgSpLim	    = StReg (StixMagicId SpLim)
 stgHp		    = StReg (StixMagicId Hp)
 stgHpLim	    = StReg (StixMagicId HpLim)
+stgR9               = StReg (StixMagicId (VanillaReg WordRep ILIT(9)))
+stgR10              = StReg (StixMagicId (VanillaReg WordRep ILIT(10)))
 
 getUniqLabelNCG :: UniqSM CLabel
 getUniqLabelNCG
diff --git a/ghc/compiler/nativeGen/StixMacro.lhs b/ghc/compiler/nativeGen/StixMacro.lhs
index a476a4bc6816b39fb95a98211c3ec27c6e164155..530146d39c1747189dc6d481330241aed76dbae0 100644
--- a/ghc/compiler/nativeGen/StixMacro.lhs
+++ b/ghc/compiler/nativeGen/StixMacro.lhs
@@ -6,6 +6,7 @@
 module StixMacro ( macroCode, checkCode ) where
 
 #include "HsVersions.h"
+#include "nativeGen/NCG.h"
 
 import {-# SOURCE #-} StixPrim ( amodeToStix )
 
@@ -232,6 +233,16 @@ checkCode macro args assts
 
 	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 (
@@ -301,8 +312,12 @@ checkCode macro args assts
                            assts (assign_ret r ret : gc_ut ptrs nonptrs : join : xs))
 
 	HP_CHK_GEN     -> 
-		error "unimplemented check"
-  )
+                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
 
@@ -313,6 +328,7 @@ gc_unpt_r1         = StJump (StLitLbl (ptext SLIT("stg_gc_unpt_r1")))
 gc_unbx_r1         = StJump (StLitLbl (ptext SLIT("stg_gc_unbx_r1")))
 gc_f1              = StJump (StLitLbl (ptext SLIT("stg_gc_f1")))
 gc_d1              = StJump (StLitLbl (ptext SLIT("stg_gc_d1")))
+gc_gen             = StJump (StLitLbl (ptext SLIT("stg_gen_chk")))
 
 gc_ut (StInt p) (StInt np)
                    = StJump (StLitLbl (ptext SLIT("stg_gc_ut_") <> int (fromInteger p) 
diff --git a/ghc/includes/mkNativeHdr.c b/ghc/includes/mkNativeHdr.c
index de04c8c623ab117749d8f3483a74fc2efe60c899..d9d8a9507ab0003175b875c4b33906496935da9c 100644
--- a/ghc/includes/mkNativeHdr.c
+++ b/ghc/includes/mkNativeHdr.c
@@ -1,5 +1,5 @@
 /* --------------------------------------------------------------------------
- * $Id: mkNativeHdr.c,v 1.2 1998/12/02 13:21:50 simonm Exp $
+ * $Id: mkNativeHdr.c,v 1.3 2000/01/25 18:09:52 sewardj Exp $
  *
  * (c) The GHC Team, 1992-1998
  *
@@ -19,6 +19,8 @@
 #define OFFSET_R6    OFFSET(RegTable, RegTable.rR6)
 #define OFFSET_R7    OFFSET(RegTable, RegTable.rR7)
 #define OFFSET_R8    OFFSET(RegTable, RegTable.rR8)
+#define OFFSET_R9    OFFSET(RegTable, RegTable.rR9)
+#define OFFSET_R10   OFFSET(RegTable, RegTable.rR10)
 #define OFFSET_F1    OFFSET(RegTable, RegTable.rF1)
 #define OFFSET_F2    OFFSET(RegTable, RegTable.rF2)
 #define OFFSET_F3    OFFSET(RegTable, RegTable.rF3)
@@ -54,6 +56,8 @@ main()
     printf("#define OFFSET_R6 %d\n", OFFSET_R6);
     printf("#define OFFSET_R7 %d\n", OFFSET_R7);
     printf("#define OFFSET_R8 %d\n", OFFSET_R8);
+    printf("#define OFFSET_R9 %d\n", OFFSET_R9);
+    printf("#define OFFSET_R10 %d\n", OFFSET_R10);
     printf("#define OFFSET_F1 %d\n", OFFSET_F1);
     printf("#define OFFSET_F2 %d\n", OFFSET_F2);
     printf("#define OFFSET_F3 %d\n", OFFSET_F3);