[project @ 2000-07-11 15:26:33 by sewardj]
[ghc-hetmet.git] / ghc / compiler / nativeGen / MachCode.lhs
index a4bd777..3fd6dd9 100644 (file)
@@ -9,80 +9,133 @@ This is a big module, but, if you pay attention to
 structure should not be too overwhelming.
 
 \begin{code}
 structure should not be too overwhelming.
 
 \begin{code}
-module MachCode ( stmt2Instrs, asmVoid, InstrList ) where
+module MachCode ( stmt2Instrs, InstrBlock ) where
 
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
 import MachMisc                -- may differ per-platform
 import MachRegs
 
 #include "HsVersions.h"
 #include "nativeGen/NCG.h"
 
 import MachMisc                -- may differ per-platform
 import MachRegs
-
+import OrdList         ( OrdList, nilOL, isNilOL, unitOL, appOL, toOL,
+                         snocOL, consOL, concatOL )
 import AbsCSyn         ( MagicId )
 import AbsCUtils       ( magicIdPrimRep )
 import CallConv                ( CallConv )
 import AbsCSyn         ( MagicId )
 import AbsCUtils       ( magicIdPrimRep )
 import CallConv                ( CallConv )
-import CLabel          ( isAsmTemp, CLabel, pprCLabel_asm )
+import CLabel          ( isAsmTemp, CLabel, pprCLabel_asm, labelDynamic )
 import Maybes          ( maybeToBool, expectJust )
 import Maybes          ( maybeToBool, expectJust )
-import OrdList         -- quite a bit of it
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import PrimOp          ( PrimOp(..) )
 import CallConv                ( cCallConv )
 import PrimRep         ( isFloatingRep, PrimRep(..) )
 import PrimOp          ( PrimOp(..) )
 import CallConv                ( cCallConv )
-import Stix            ( getUniqLabelNCG, StixTree(..),
+import Stix            ( getNatLabelNCG, StixTree(..),
                          StixReg(..), CodeSegment(..), 
                          StixReg(..), CodeSegment(..), 
-                          pprStixTrees, ppStixReg
-                       )
-import UniqSupply      ( returnUs, thenUs, mapUs, mapAndUnzipUs,
-                         mapAccumLUs, UniqSM
+                          pprStixTree, ppStixReg,
+                          NatM, thenNat, returnNat, mapNat, 
+                          mapAndUnzipNat, mapAccumLNat,
+                          getDeltaNat, setDeltaNat
                        )
 import Outputable
                        )
 import Outputable
-import PprMach                 ( pprSize )
+import CmdLineOpts     ( opt_Static )
+
+infixr 3 `bind`
+
+\end{code}
+
+@InstrBlock@s are the insn sequences generated by the insn selectors.
+They are really trees of insns to facilitate fast appending, where a
+left-to-right traversal (pre-order?) yields the insns in the correct
+order.
+
+\begin{code}
+
+type InstrBlock = OrdList Instr
+
+x `bind` f = f x
+
 \end{code}
 
 Code extractor for an entire stix tree---stix statement level.
 
 \begin{code}
 \end{code}
 
 Code extractor for an entire stix tree---stix statement level.
 
 \begin{code}
-stmt2Instrs :: StixTree {- a stix statement -} -> UniqSM InstrBlock
+stmt2Instrs :: StixTree {- a stix statement -} -> NatM InstrBlock
 
 stmt2Instrs stmt = case stmt of
 
 stmt2Instrs stmt = case stmt of
-    StComment s    -> returnInstr (COMMENT s)
-    StSegment seg  -> returnInstr (SEGMENT seg)
+    StComment s    -> returnNat (unitOL (COMMENT s))
+    StSegment seg  -> returnNat (unitOL (SEGMENT seg))
+
+    StFunBegin lab -> returnNat (unitOL (IF_ARCH_alpha(FUNBEGIN lab,
+                                                       LABEL lab)))
+    StFunEnd lab   -> IF_ARCH_alpha(returnNat (unitOL (FUNEND lab)),
+                                    returnNat nilOL)
 
 
-    StFunBegin lab -> returnInstr (IF_ARCH_alpha(FUNBEGIN lab,LABEL lab))
-    StFunEnd lab   -> IF_ARCH_alpha(returnInstr (FUNEND lab),returnUs id)
-    StLabel lab           -> returnInstr (LABEL lab)
+    StLabel lab           -> returnNat (unitOL (LABEL lab))
 
 
-    StJump arg            -> genJump arg
-    StCondJump lab arg    -> genCondJump lab arg
-    StCall fn cconv VoidRep args -> genCCall fn cconv VoidRep args
+    StJump arg            -> genJump (derefDLL arg)
+    StCondJump lab arg    -> genCondJump lab (derefDLL arg)
+
+    -- A call returning void, ie one done for its side-effects
+    StCall fn cconv VoidRep args -> genCCall fn
+                                             cconv VoidRep (map derefDLL args)
 
     StAssign pk dst src
 
     StAssign pk dst src
-      | isFloatingRep pk -> assignFltCode pk dst src
-      | otherwise       -> assignIntCode pk dst src
+      | isFloatingRep pk -> assignFltCode pk (derefDLL dst) (derefDLL src)
+      | otherwise       -> assignIntCode pk (derefDLL dst) (derefDLL src)
 
     StFallThrough lbl
        -- When falling through on the Alpha, we still have to load pv
        -- with the address of the next routine, so that it can load gp.
       -> IF_ARCH_alpha(returnInstr (LDA pv (AddrImm (ImmCLbl lbl)))
 
     StFallThrough lbl
        -- When falling through on the Alpha, we still have to load pv
        -- with the address of the next routine, so that it can load gp.
       -> IF_ARCH_alpha(returnInstr (LDA pv (AddrImm (ImmCLbl lbl)))
-       ,returnUs id)
+       ,returnNat nilOL)
 
     StData kind args
 
     StData kind args
-      -> mapAndUnzipUs getData args    `thenUs` \ (codes, imms) ->
-        returnUs (\xs -> mkSeqList (asmInstr (DATA (primRepToSize kind) imms))
-                                   (foldr (.) id codes xs))
+      -> mapAndUnzipNat getData args `thenNat` \ (codes, imms) ->
+        returnNat (DATA (primRepToSize kind) imms  
+                    `consOL`  concatOL codes)
       where
       where
-       getData :: StixTree -> UniqSM (InstrBlock, Imm)
-
-       getData (StInt i)    = returnUs (id, ImmInteger i)
-       getData (StDouble d) = returnUs (id, ImmDouble d)
-       getData (StLitLbl s) = returnUs (id, ImmLab s)
-       getData (StCLbl l)   = returnUs (id, ImmCLbl l)
-       getData (StString s) =
-           getUniqLabelNCG                 `thenUs` \ lbl ->
-           returnUs (mkSeqInstrs [LABEL lbl,
-                                  ASCII True (_UNPK_ s)],
-                                  ImmCLbl lbl)
+       getData :: StixTree -> NatM (InstrBlock, Imm)
+
+       getData (StInt i)        = returnNat (nilOL, ImmInteger i)
+       getData (StDouble d)     = returnNat (nilOL, ImmDouble d)
+       getData (StFloat d)      = returnNat (nilOL, ImmFloat d)
+       getData (StCLbl l)       = returnNat (nilOL, ImmCLbl l)
+       getData (StString s)     =
+           getNatLabelNCG                  `thenNat` \ lbl ->
+           returnNat (toOL [LABEL lbl,
+                            ASCII True (_UNPK_ s)],
+                       ImmCLbl lbl)
        -- the linker can handle simple arithmetic...
        getData (StIndex rep (StCLbl lbl) (StInt off)) =
        -- the linker can handle simple arithmetic...
        getData (StIndex rep (StCLbl lbl) (StInt off)) =
-               returnUs (id, ImmIndex lbl (fromInteger (off * sizeOf rep)))
+               returnNat (nilOL, 
+                           ImmIndex lbl (fromInteger (off * sizeOf rep)))
+
+-- Walk a Stix tree, and insert dereferences to CLabels which are marked
+-- as labelDynamic.  stmt2Instrs calls derefDLL selectively, because
+-- not all such CLabel occurrences need this dereferencing -- SRTs don't
+-- for one.
+derefDLL :: StixTree -> StixTree
+derefDLL tree
+   | opt_Static   -- short out the entire deal if not doing DLLs
+   = tree
+   | otherwise
+   = qq tree
+     where
+        qq t
+           = case t of
+                StCLbl lbl -> if   labelDynamic lbl
+                              then StInd PtrRep (StCLbl lbl)
+                              else t
+                -- all the rest are boring
+                StIndex pk base offset -> StIndex pk (qq base) (qq offset)
+                StPrim pk args         -> StPrim pk (map qq args)
+                StInd pk addr          -> StInd pk (qq addr)
+                StCall who cc pk args  -> StCall who cc pk (map qq args)
+                StInt    _             -> t
+                StFloat  _             -> t
+                StDouble _             -> t
+                StString _             -> t
+                StReg    _             -> t
+                StScratchWord _        -> t
+                _                      -> pprPanic "derefDLL: unhandled case" 
+                                                   (pprStixTree t)
 \end{code}
 
 %************************************************************************
 \end{code}
 
 %************************************************************************
@@ -92,38 +145,6 @@ stmt2Instrs stmt = case stmt of
 %************************************************************************
 
 \begin{code}
 %************************************************************************
 
 \begin{code}
-type InstrList  = OrdList Instr
-type InstrBlock = InstrList -> InstrList
-
-asmVoid :: InstrList
-asmVoid = mkEmptyList
-
-asmInstr :: Instr -> InstrList
-asmInstr i = mkUnitList i
-
-asmSeq :: [Instr] -> InstrList
-asmSeq is = foldr (mkSeqList . asmInstr) asmVoid is
-
-asmParThen :: [InstrList] -> InstrBlock
-asmParThen others code = mkSeqList (foldr mkParList mkEmptyList others) code
-
-returnInstr :: Instr -> UniqSM InstrBlock
-returnInstr instr = returnUs (\xs -> mkSeqList (asmInstr instr) xs)
-
-returnInstrs :: [Instr] -> UniqSM InstrBlock
-returnInstrs instrs = returnUs (\xs -> mkSeqList (asmSeq instrs) xs)
-
-returnSeq :: InstrBlock -> [Instr] -> UniqSM InstrBlock
-returnSeq code instrs = returnUs (\xs -> code (mkSeqList (asmSeq instrs) xs))
-
-mkSeqInstr :: Instr -> InstrBlock
-mkSeqInstr instr code = mkSeqList (asmInstr instr) code
-
-mkSeqInstrs :: [Instr] -> InstrBlock
-mkSeqInstrs instrs code = mkSeqList (asmSeq instrs) code
-\end{code}
-
-\begin{code}
 mangleIndexTree :: StixTree -> StixTree
 
 mangleIndexTree (StIndex pk base (StInt i))
 mangleIndexTree :: StixTree -> StixTree
 
 mangleIndexTree (StIndex pk base (StInt i))
@@ -147,12 +168,10 @@ mangleIndexTree (StIndex pk base off)
 \begin{code}
 maybeImm :: StixTree -> Maybe Imm
 
 \begin{code}
 maybeImm :: StixTree -> Maybe Imm
 
-maybeImm (StLitLbl s) = Just (ImmLab s)
-maybeImm (StCLbl   l) = Just (ImmCLbl l)
-
-maybeImm (StIndex rep (StCLbl l) (StInt off)) = 
-       Just (ImmIndex l (fromInteger (off * sizeOf rep)))
-
+maybeImm (StCLbl l)       
+   = Just (ImmCLbl l)
+maybeImm (StIndex rep (StCLbl l) (StInt off)) 
+   = Just (ImmIndex l (fromInteger (off * sizeOf rep)))
 maybeImm (StInt i)
   | i >= toInteger minInt && i <= toInteger maxInt
   = Just (ImmInt (fromInteger i))
 maybeImm (StInt i)
   | i >= toInteger minInt && i <= toInteger maxInt
   = Just (ImmInt (fromInteger i))
@@ -182,47 +201,66 @@ registerCode :: Register -> Reg -> InstrBlock
 registerCode (Fixed _ _ code) reg = code
 registerCode (Any _ code) reg = code reg
 
 registerCode (Fixed _ _ code) reg = code
 registerCode (Any _ code) reg = code reg
 
+registerCodeF (Fixed _ _ code) = code
+registerCodeF (Any _ _)        = pprPanic "registerCodeF" empty
+
+registerCodeA (Any _ code)  = code
+registerCodeA (Fixed _ _ _) = pprPanic "registerCodeA" empty
+
 registerName :: Register -> Reg -> Reg
 registerName (Fixed _ reg _) _ = reg
 registerName :: Register -> Reg -> Reg
 registerName (Fixed _ reg _) _ = reg
-registerName (Any   _ _)   reg = reg
+registerName (Any _ _)   reg   = reg
+
+registerNameF (Fixed _ reg _) = reg
+registerNameF (Any _ _)       = pprPanic "registerNameF" empty
 
 registerRep :: Register -> PrimRep
 registerRep (Fixed pk _ _) = pk
 registerRep (Any   pk _) = pk
 
 
 registerRep :: Register -> PrimRep
 registerRep (Fixed pk _ _) = pk
 registerRep (Any   pk _) = pk
 
-isFixed :: Register -> Bool
+{-# INLINE registerCode  #-}
+{-# INLINE registerCodeF #-}
+{-# INLINE registerName  #-}
+{-# INLINE registerNameF #-}
+{-# INLINE registerRep   #-}
+{-# INLINE isFixed       #-}
+{-# INLINE isAny         #-}
+
+isFixed, isAny :: Register -> Bool
 isFixed (Fixed _ _ _) = True
 isFixed (Any _ _)     = False
 isFixed (Fixed _ _ _) = True
 isFixed (Any _ _)     = False
+
+isAny = not . isFixed
 \end{code}
 
 Generate code to get a subtree into a @Register@:
 \begin{code}
 \end{code}
 
 Generate code to get a subtree into a @Register@:
 \begin{code}
-getRegister :: StixTree -> UniqSM Register
+getRegister :: StixTree -> NatM Register
 
 getRegister (StReg (StixMagicId stgreg))
   = case (magicIdRegMaybe stgreg) of
 
 getRegister (StReg (StixMagicId stgreg))
   = case (magicIdRegMaybe stgreg) of
-      Just reg -> returnUs (Fixed (magicIdPrimRep stgreg) reg id)
+      Just reg -> returnNat (Fixed (magicIdPrimRep stgreg) reg nilOL)
                   -- cannae be Nothing
 
 getRegister (StReg (StixTemp u pk))
                   -- cannae be Nothing
 
 getRegister (StReg (StixTemp u pk))
-  = returnUs (Fixed pk (UnmappedReg u pk) id)
+  = returnNat (Fixed pk (mkVReg u pk) nilOL)
 
 getRegister tree@(StIndex _ _ _) = getRegister (mangleIndexTree tree)
 
 getRegister (StCall fn cconv kind args)
 
 getRegister tree@(StIndex _ _ _) = getRegister (mangleIndexTree tree)
 
 getRegister (StCall fn cconv kind args)
-  = genCCall fn cconv kind args            `thenUs` \ call ->
-    returnUs (Fixed kind reg call)
+  = genCCall fn cconv kind args            `thenNat` \ call ->
+    returnNat (Fixed kind reg call)
   where
     reg = if isFloatingRep kind
          then IF_ARCH_alpha( f0, IF_ARCH_i386( fake0, IF_ARCH_sparc( f0,)))
          else IF_ARCH_alpha( v0, IF_ARCH_i386( eax, IF_ARCH_sparc( o0,)))
 
 getRegister (StString s)
   where
     reg = if isFloatingRep kind
          then IF_ARCH_alpha( f0, IF_ARCH_i386( fake0, IF_ARCH_sparc( f0,)))
          else IF_ARCH_alpha( v0, IF_ARCH_i386( eax, IF_ARCH_sparc( o0,)))
 
 getRegister (StString s)
-  = getUniqLabelNCG                `thenUs` \ lbl ->
+  = getNatLabelNCG                 `thenNat` \ lbl ->
     let
        imm_lbl = ImmCLbl lbl
 
     let
        imm_lbl = ImmCLbl lbl
 
-       code dst = mkSeqInstrs [
+       code dst = toOL [
            SEGMENT DataSegment,
            LABEL lbl,
            ASCII True (_UNPK_ s),
            SEGMENT DataSegment,
            LABEL lbl,
            ASCII True (_UNPK_ s),
@@ -239,7 +277,7 @@ getRegister (StString s)
 #endif
            ]
     in
 #endif
            ]
     in
-    returnUs (Any PtrRep code)
+    returnNat (Any PtrRep code)
 
 
 
 
 
 
@@ -248,8 +286,8 @@ getRegister (StString s)
 #if alpha_TARGET_ARCH
 
 getRegister (StDouble d)
 #if alpha_TARGET_ARCH
 
 getRegister (StDouble d)
-  = getUniqLabelNCG                `thenUs` \ lbl ->
-    getNewRegNCG PtrRep            `thenUs` \ tmp ->
+  = getNatLabelNCG                 `thenNat` \ lbl ->
+    getNewRegNCG PtrRep            `thenNat` \ tmp ->
     let code dst = mkSeqInstrs [
            SEGMENT DataSegment,
            LABEL lbl,
     let code dst = mkSeqInstrs [
            SEGMENT DataSegment,
            LABEL lbl,
@@ -258,7 +296,7 @@ getRegister (StDouble d)
            LDA tmp (AddrImm (ImmCLbl lbl)),
            LD TF dst (AddrReg tmp)]
     in
            LDA tmp (AddrImm (ImmCLbl lbl)),
            LD TF dst (AddrReg tmp)]
     in
-       returnUs (Any DoubleRep code)
+       returnNat (Any DoubleRep code)
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
@@ -394,17 +432,17 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
        any kind leave the result in a floating point register, so we
        need to wrangle an integer register out of things.
     -}
        any kind leave the result in a floating point register, so we
        need to wrangle an integer register out of things.
     -}
-    int_NE_code :: StixTree -> StixTree -> UniqSM Register
+    int_NE_code :: StixTree -> StixTree -> NatM Register
 
     int_NE_code x y
 
     int_NE_code x y
-      = trivialCode (CMP EQQ) x y      `thenUs` \ register ->
-       getNewRegNCG IntRep             `thenUs` \ tmp ->
+      = trivialCode (CMP EQQ) x y      `thenNat` \ register ->
+       getNewRegNCG IntRep             `thenNat` \ tmp ->
        let
            code = registerCode register tmp
            src  = registerName register tmp
            code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
        in
        let
            code = registerCode register tmp
            src  = registerName register tmp
            code__2 dst = code . mkSeqInstr (XOR src (RIImm (ImmInt 1)) dst)
        in
-       returnUs (Any IntRep code__2)
+       returnNat (Any IntRep code__2)
 
     {- ------------------------------------------------------------
        Comments for int_NE_code also apply to cmpF_code
 
     {- ------------------------------------------------------------
        Comments for int_NE_code also apply to cmpF_code
@@ -413,12 +451,12 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
        :: (Reg -> Reg -> Reg -> Instr)
        -> Cond
        -> StixTree -> StixTree
        :: (Reg -> Reg -> Reg -> Instr)
        -> Cond
        -> StixTree -> StixTree
-       -> UniqSM Register
+       -> NatM Register
 
     cmpF_code instr cond x y
 
     cmpF_code instr cond x y
-      = trivialFCode pr instr x y      `thenUs` \ register ->
-       getNewRegNCG DoubleRep          `thenUs` \ tmp ->
-       getUniqLabelNCG                 `thenUs` \ lbl ->
+      = trivialFCode pr instr x y      `thenNat` \ register ->
+       getNewRegNCG DoubleRep          `thenNat` \ tmp ->
+       getNatLabelNCG                  `thenNat` \ lbl ->
        let
            code = registerCode register tmp
            result  = registerName register tmp
        let
            code = registerCode register tmp
            result  = registerName register tmp
@@ -429,32 +467,32 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                OR zeroh (RIReg zeroh) dst,
                LABEL lbl]
        in
                OR zeroh (RIReg zeroh) dst,
                LABEL lbl]
        in
-       returnUs (Any IntRep code__2)
+       returnNat (Any IntRep code__2)
       where
        pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
       ------------------------------------------------------------
 
 getRegister (StInd pk mem)
       where
        pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
       ------------------------------------------------------------
 
 getRegister (StInd pk mem)
-  = getAmode mem                   `thenUs` \ amode ->
+  = getAmode mem                   `thenNat` \ amode ->
     let
        code = amodeCode amode
        src   = amodeAddr amode
        size = primRepToSize pk
        code__2 dst = code . mkSeqInstr (LD size dst src)
     in
     let
        code = amodeCode amode
        src   = amodeAddr amode
        size = primRepToSize pk
        code__2 dst = code . mkSeqInstr (LD size dst src)
     in
-    returnUs (Any pk code__2)
+    returnNat (Any pk code__2)
 
 getRegister (StInt i)
   | fits8Bits i
   = let
        code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
     in
 
 getRegister (StInt i)
   | fits8Bits i
   = let
        code dst = mkSeqInstr (OR zeroh (RIImm src) dst)
     in
-    returnUs (Any IntRep code)
+    returnNat (Any IntRep code)
   | otherwise
   = let
        code dst = mkSeqInstr (LDI Q dst src)
     in
   | otherwise
   = let
        code dst = mkSeqInstr (LDI Q dst src)
     in
-    returnUs (Any IntRep code)
+    returnNat (Any IntRep code)
   where
     src = ImmInt (fromInteger i)
 
   where
     src = ImmInt (fromInteger i)
 
@@ -463,7 +501,7 @@ getRegister leaf
   = let
        code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
     in
   = let
        code dst = mkSeqInstr (LDA dst (AddrImm imm__2))
     in
-    returnUs (Any PtrRep code)
+    returnNat (Any PtrRep code)
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
@@ -473,8 +511,18 @@ getRegister leaf
 #if i386_TARGET_ARCH
 
 getRegister (StDouble d)
 #if i386_TARGET_ARCH
 
 getRegister (StDouble d)
-  = getUniqLabelNCG                `thenUs` \ lbl ->
-    let code dst = mkSeqInstrs [
+
+  | d == 0.0
+  = let code dst = unitOL (GLDZ dst)
+    in  returnNat (Any DoubleRep code)
+
+  | d == 1.0
+  = let code dst = unitOL (GLD1 dst)
+    in  returnNat (Any DoubleRep code)
+
+  | otherwise
+  = getNatLabelNCG                 `thenNat` \ lbl ->
+    let code dst = toOL [
            SEGMENT DataSegment,
            LABEL lbl,
            DATA DF [ImmDouble d],
            SEGMENT DataSegment,
            LABEL lbl,
            DATA DF [ImmDouble d],
@@ -482,11 +530,18 @@ getRegister (StDouble d)
            GLD DF (ImmAddr (ImmCLbl lbl) 0) dst
            ]
     in
            GLD DF (ImmAddr (ImmCLbl lbl) 0) dst
            ]
     in
-    returnUs (Any DoubleRep code)
+    returnNat (Any DoubleRep code)
 
 
+-- Calculate the offset for (i+1) words above the _initial_
+-- %esp value by first determining the current offset of it.
 getRegister (StScratchWord i)
 getRegister (StScratchWord i)
-   = let code dst = mkSeqInstr (LEA L (OpAddr (spRel (-1000+i))) (OpReg dst))
-     in returnUs (Any PtrRep code)
+   | i >= 0 && i < 6
+   = getDeltaNat `thenNat` \ current_stack_offset ->
+     let j = i+1   - (current_stack_offset `div` 4)
+         code dst
+           = unitOL (LEA L (OpAddr (spRel (j+1))) (OpReg dst))
+     in 
+     returnNat (Any PtrRep code)
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
@@ -499,6 +554,15 @@ getRegister (StPrim primop [x]) -- unary PrimOps
       FloatSqrtOp  -> trivialUFCode FloatRep  (GSQRT F) x
       DoubleSqrtOp -> trivialUFCode DoubleRep (GSQRT DF) x
 
       FloatSqrtOp  -> trivialUFCode FloatRep  (GSQRT F) x
       DoubleSqrtOp -> trivialUFCode DoubleRep (GSQRT DF) x
 
+      FloatSinOp  -> trivialUFCode FloatRep  (GSIN F) x
+      DoubleSinOp -> trivialUFCode DoubleRep (GSIN DF) x
+
+      FloatCosOp  -> trivialUFCode FloatRep  (GCOS F) x
+      DoubleCosOp -> trivialUFCode DoubleRep (GCOS DF) x
+
+      FloatTanOp  -> trivialUFCode FloatRep  (GTAN F) x
+      DoubleTanOp -> trivialUFCode DoubleRep (GTAN DF) x
+
       Double2FloatOp -> trivialUFCode FloatRep  GDTOF x
       Float2DoubleOp -> trivialUFCode DoubleRep GFTOD x
 
       Double2FloatOp -> trivialUFCode FloatRep  GDTOF x
       Float2DoubleOp -> trivialUFCode DoubleRep GFTOD x
 
@@ -523,10 +587,6 @@ getRegister (StPrim primop [x]) -- unary PrimOps
              FloatExpOp    -> (True,  SLIT("exp"))
              FloatLogOp    -> (True,  SLIT("log"))
 
              FloatExpOp    -> (True,  SLIT("exp"))
              FloatLogOp    -> (True,  SLIT("log"))
 
-             FloatSinOp    -> (True,  SLIT("sin"))
-             FloatCosOp    -> (True,  SLIT("cos"))
-             FloatTanOp    -> (True,  SLIT("tan"))
-
              FloatAsinOp   -> (True,  SLIT("asin"))
              FloatAcosOp   -> (True,  SLIT("acos"))
              FloatAtanOp   -> (True,  SLIT("atan"))
              FloatAsinOp   -> (True,  SLIT("asin"))
              FloatAcosOp   -> (True,  SLIT("acos"))
              FloatAtanOp   -> (True,  SLIT("atan"))
@@ -538,10 +598,6 @@ getRegister (StPrim primop [x]) -- unary PrimOps
              DoubleExpOp   -> (False, SLIT("exp"))
              DoubleLogOp   -> (False, SLIT("log"))
 
              DoubleExpOp   -> (False, SLIT("exp"))
              DoubleLogOp   -> (False, SLIT("log"))
 
-             DoubleSinOp   -> (False, SLIT("sin"))
-             DoubleCosOp   -> (False, SLIT("cos"))
-             DoubleTanOp   -> (False, SLIT("tan"))
-
              DoubleAsinOp  -> (False, SLIT("asin"))
              DoubleAcosOp  -> (False, SLIT("acos"))
              DoubleAtanOp  -> (False, SLIT("atan"))
              DoubleAsinOp  -> (False, SLIT("asin"))
              DoubleAcosOp  -> (False, SLIT("acos"))
              DoubleAtanOp  -> (False, SLIT("atan"))
@@ -552,7 +608,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 
               other
                  -> pprPanic "getRegister(x86,unary primop)" 
 
               other
                  -> pprPanic "getRegister(x86,unary primop)" 
-                             (pprStixTrees [StPrim primop [x]])
+                             (pprStixTree (StPrim primop [x]))
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
@@ -602,7 +658,7 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       IntSubOp  -> sub_code  L x y
       IntQuotOp -> quot_code L x y True{-division-}
       IntRemOp  -> quot_code L x y False{-remainder-}
       IntSubOp  -> sub_code  L x y
       IntQuotOp -> quot_code L x y True{-division-}
       IntRemOp  -> quot_code L x y False{-remainder-}
-      IntMulOp  -> trivialCode (IMUL L) x y {-True-}
+      IntMulOp  -> let op = IMUL L in trivialCode op (Just op) x y
 
       FloatAddOp -> trivialFCode  FloatRep  GADD x y
       FloatSubOp -> trivialFCode  FloatRep  GSUB x y
 
       FloatAddOp -> trivialFCode  FloatRep  GADD x y
       FloatSubOp -> trivialFCode  FloatRep  GSUB x y
@@ -614,18 +670,17 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       DoubleMulOp -> trivialFCode DoubleRep GMUL x y
       DoubleDivOp -> trivialFCode DoubleRep GDIV x y
 
       DoubleMulOp -> trivialFCode DoubleRep GMUL x y
       DoubleDivOp -> trivialFCode DoubleRep GDIV x y
 
-      AndOp -> trivialCode (AND L) x y {-True-}
-      OrOp  -> trivialCode (OR L)  x y {-True-}
-      XorOp -> trivialCode (XOR L) x y {-True-}
+      AndOp -> let op = AND L in trivialCode op (Just op) x y
+      OrOp  -> let op = OR  L in trivialCode op (Just op) x y
+      XorOp -> let op = XOR L in trivialCode op (Just op) x y
 
        {- Shift ops on x86s have constraints on their source, it
           either has to be Imm, CL or 1
            => trivialCode's is not restrictive enough (sigh.)
        -}
           
 
        {- Shift ops on x86s have constraints on their source, it
           either has to be Imm, CL or 1
            => trivialCode's is not restrictive enough (sigh.)
        -}
           
-      SllOp -> shift_code (SHL L) x y {-False-}
-      SrlOp -> shift_code (SHR L) x y {-False-}
-
+      SllOp  -> shift_code (SHL L) x y {-False-}
+      SrlOp  -> shift_code (SHR L) x y {-False-}
       ISllOp -> shift_code (SHL L) x y {-False-}
       ISraOp -> shift_code (SAR L) x y {-False-}
       ISrlOp -> shift_code (SHR L) x y {-False-}
       ISllOp -> shift_code (SHL L) x y {-False-}
       ISraOp -> shift_code (SAR L) x y {-False-}
       ISrlOp -> shift_code (SHR L) x y {-False-}
@@ -637,229 +692,206 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
                                            [x, y])
       other
          -> pprPanic "getRegister(x86,dyadic primop)" 
                                            [x, y])
       other
          -> pprPanic "getRegister(x86,dyadic primop)" 
-                     (pprStixTrees [StPrim primop [x, y]])
+                     (pprStixTree (StPrim primop [x, y]))
   where
 
     --------------------
   where
 
     --------------------
-    shift_code :: (Operand -> Operand -> Instr)
+    shift_code :: (Imm -> Operand -> Instr)
               -> StixTree
               -> StixTree
               -> StixTree
               -> StixTree
-              -> UniqSM Register
+              -> NatM Register
 
       {- Case1: shift length as immediate -}
       -- Code is the same as the first eq. for trivialCode -- sigh.
     shift_code instr x y{-amount-}
       | maybeToBool imm
 
       {- Case1: shift length as immediate -}
       -- Code is the same as the first eq. for trivialCode -- sigh.
     shift_code instr x y{-amount-}
       | maybeToBool imm
-      = getRegister x          `thenUs` \ register ->
-       let
-           op_imm = OpImm imm__2
-           code__2 dst = 
-               let
-                code  = registerCode  register dst
-                src   = registerName  register dst
-               in
-               mkSeqInstr (COMMENT SLIT("shift_code")) . 
-               code .
-               if isFixed register && src /= dst
-               then
-                  mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
-                               instr op_imm  (OpReg dst)]
-               else
-                  mkSeqInstr (instr op_imm (OpReg src)) 
-       in
-        returnUs (Any IntRep code__2)
+      = getRegister x                     `thenNat` \ regx ->
+        let mkcode dst
+              = if   isAny regx
+                then registerCodeA regx dst  `bind` \ code_x ->
+                     code_x `snocOL`
+                     instr imm__2 (OpReg dst)
+                else registerCodeF regx      `bind` \ code_x ->
+                     registerNameF regx      `bind` \ r_x ->
+                     code_x `snocOL`
+                     MOV L (OpReg r_x) (OpReg dst) `snocOL`
+                     instr imm__2 (OpReg dst)
+        in
+        returnNat (Any IntRep mkcode)        
       where
        imm = maybeImm y
        imm__2 = case imm of Just x -> x
 
       {- Case2: shift length is complex (non-immediate) -}
       where
        imm = maybeImm y
        imm__2 = case imm of Just x -> x
 
       {- Case2: shift length is complex (non-immediate) -}
+      -- Since ECX is always used as a spill temporary, we can't
+      -- use it here to do non-immediate shifts.  No big deal --
+      -- they are only very rare, and we can use an equivalent
+      -- test-and-jump sequence which doesn't use ECX.
+      -- DO NOT REPLACE THIS CODE WITH THE "OBVIOUS" shl/shr/sar CODE, 
+      -- SINCE IT WILL CAUSE SERIOUS PROBLEMS WITH THE SPILLER
     shift_code instr x y{-amount-}
     shift_code instr x y{-amount-}
-     = getRegister y           `thenUs` \ register1 ->  
-       getRegister x           `thenUs` \ register2 ->
-       let
-       -- Note: we force the shift length to be loaded
-       -- into ECX, so that we can use CL when shifting.
-       -- (only register location we are allowed
-       -- to put shift amounts.)
-       -- 
-       -- The shift instruction is fed ECX as src reg,
-       -- but we coerce this into CL when printing out.
-       src1    = registerName register1 ecx
-       code1   = if src1 /= ecx then -- if it is not in ecx already, force it!
-                   registerCode register1 ecx .
-                   mkSeqInstr (MOV L (OpReg src1) (OpReg ecx))
-                 else 
-                   registerCode register1 ecx
-       code__2 = 
-                     let
-                      code2 = registerCode register2 eax
-                      src2  = registerName register2 eax
-                     in
-                     code1 . code2 .
-                     mkSeqInstr (instr (OpReg ecx) (OpReg eax))
+     = getRegister x   `thenNat` \ register1 ->
+       getRegister y   `thenNat` \ register2 ->
+       getNatLabelNCG  `thenNat` \ lbl_test3 ->
+       getNatLabelNCG  `thenNat` \ lbl_test2 ->
+       getNatLabelNCG  `thenNat` \ lbl_test1 ->
+       getNatLabelNCG  `thenNat` \ lbl_test0 ->
+       getNatLabelNCG  `thenNat` \ lbl_after ->
+       getNewRegNCG IntRep   `thenNat` \ tmp ->
+       let code__2 dst
+              = let src_val  = registerName register1 dst
+                    code_val = registerCode register1 dst
+                    src_amt  = registerName register2 tmp
+                    code_amt = registerCode register2 tmp
+                    r_dst    = OpReg dst
+                    r_tmp    = OpReg tmp
+                in
+                    code_amt `snocOL`
+                    MOV L (OpReg src_amt) r_tmp `appOL`
+                    code_val `snocOL`
+                    MOV L (OpReg src_val) r_dst `appOL`
+                    toOL [
+                       COMMENT (_PK_ "begin shift sequence"),
+                       MOV L (OpReg src_val) r_dst,
+                       MOV L (OpReg src_amt) r_tmp,
+
+                       BT L (ImmInt 4) r_tmp,
+                       JXX GEU lbl_test3,
+                       instr (ImmInt 16) r_dst,
+
+                       LABEL lbl_test3,
+                       BT L (ImmInt 3) r_tmp,
+                       JXX GEU lbl_test2,
+                       instr (ImmInt 8) r_dst,
+
+                       LABEL lbl_test2,
+                       BT L (ImmInt 2) r_tmp,
+                       JXX GEU lbl_test1,
+                       instr (ImmInt 4) r_dst,
+
+                       LABEL lbl_test1,
+                       BT L (ImmInt 1) r_tmp,
+                       JXX GEU lbl_test0,
+                       instr (ImmInt 2) r_dst,
+
+                       LABEL lbl_test0,
+                       BT L (ImmInt 0) r_tmp,
+                       JXX GEU lbl_after,
+                       instr (ImmInt 1) r_dst,
+                       LABEL lbl_after,
+                                           
+                       COMMENT (_PK_ "end shift sequence")
+                    ]
        in
        in
-       returnUs (Fixed IntRep eax code__2)
+       returnNat (Any IntRep code__2)
 
     --------------------
 
     --------------------
-    add_code :: Size -> StixTree -> StixTree -> UniqSM Register
+    add_code :: Size -> StixTree -> StixTree -> NatM Register
 
     add_code sz x (StInt y)
 
     add_code sz x (StInt y)
-      = getRegister x          `thenUs` \ register ->
-       getNewRegNCG IntRep     `thenUs` \ tmp ->
+      = getRegister x          `thenNat` \ register ->
+       getNewRegNCG IntRep     `thenNat` \ tmp ->
        let
            code = registerCode register tmp
            src1 = registerName register tmp
            src2 = ImmInt (fromInteger y)
            code__2 dst 
        let
            code = registerCode register tmp
            src1 = registerName register tmp
            src2 = ImmInt (fromInteger y)
            code__2 dst 
-               = code .
-                mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
-                                    (OpReg dst))
+               = code `snocOL`
+                LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
+                        (OpReg dst)
        in
        in
-       returnUs (Any IntRep code__2)
+       returnNat (Any IntRep code__2)
 
 
-    add_code sz x y
-      = getRegister x          `thenUs` \ register1 ->
-       getRegister y           `thenUs` \ register2 ->
-       getNewRegNCG IntRep     `thenUs` \ tmp1 ->
-       getNewRegNCG IntRep     `thenUs` \ tmp2 ->
-       let
-           code1 = registerCode register1 tmp1 asmVoid
-           src1  = registerName register1 tmp1
-           code2 = registerCode register2 tmp2 asmVoid
-           src2  = registerName register2 tmp2
-           code__2 dst 
-               = asmParThen [code1, code2] .
-                mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) (Just (src2,1)) 
-                                                           (ImmInt 0))) 
-                                    (OpReg dst))
-       in
-       returnUs (Any IntRep code__2)
+    add_code sz x y = trivialCode (ADD sz) (Just (ADD sz)) x y
 
     --------------------
 
     --------------------
-    sub_code :: Size -> StixTree -> StixTree -> UniqSM Register
+    sub_code :: Size -> StixTree -> StixTree -> NatM Register
 
     sub_code sz x (StInt y)
 
     sub_code sz x (StInt y)
-      = getRegister x          `thenUs` \ register ->
-       getNewRegNCG IntRep     `thenUs` \ tmp ->
+      = getRegister x          `thenNat` \ register ->
+       getNewRegNCG IntRep     `thenNat` \ tmp ->
        let
            code = registerCode register tmp
            src1 = registerName register tmp
            src2 = ImmInt (-(fromInteger y))
            code__2 dst 
        let
            code = registerCode register tmp
            src1 = registerName register tmp
            src2 = ImmInt (-(fromInteger y))
            code__2 dst 
-               = code .
-                mkSeqInstr (LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
-                                    (OpReg dst))
+               = code `snocOL`
+                LEA sz (OpAddr (AddrBaseIndex (Just src1) Nothing src2))
+                        (OpReg dst)
        in
        in
-       returnUs (Any IntRep code__2)
+       returnNat (Any IntRep code__2)
 
 
-    sub_code sz x y = trivialCode (SUB sz) x y {-False-}
+    sub_code sz x y = trivialCode (SUB sz) Nothing x y
 
     --------------------
     quot_code
        :: Size
        -> StixTree -> StixTree
        -> Bool -- True => division, False => remainder operation
 
     --------------------
     quot_code
        :: Size
        -> StixTree -> StixTree
        -> Bool -- True => division, False => remainder operation
-       -> UniqSM Register
+       -> NatM Register
 
     -- x must go into eax, edx must be a sign-extension of eax, and y
     -- should go in some other register (or memory), so that we get
 
     -- x must go into eax, edx must be a sign-extension of eax, and y
     -- should go in some other register (or memory), so that we get
-    -- edx:eax / reg -> eax (remainder in edx) Currently we chose to
-    -- put y in memory (if it is not there already)
-
-    quot_code sz x (StInd pk mem) is_division
-      = getRegister x          `thenUs` \ register1 ->
-       getNewRegNCG IntRep     `thenUs` \ tmp1 ->
-       getAmode mem            `thenUs` \ amode ->
-       let
-           code1   = registerCode register1 tmp1 asmVoid
-           src1    = registerName register1 tmp1
-           code2   = amodeCode amode asmVoid
-           src2    = amodeAddr amode
-           code__2 = asmParThen [code1, code2] .
-                     mkSeqInstrs [MOV L (OpReg src1) (OpReg eax),
-                                  CLTD,
-                                  IDIV sz (OpAddr src2)]
-       in
-       returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
-
-    quot_code sz x (StInt i) is_division
-      = getRegister x          `thenUs` \ register1 ->
-       getNewRegNCG IntRep     `thenUs` \ tmp1 ->
-       let
-           code1   = registerCode register1 tmp1 asmVoid
-           src1    = registerName register1 tmp1
-           src2    = ImmInt (fromInteger i)
-           code__2 = asmParThen [code1] .
-                     mkSeqInstrs [-- we put src2 in (ebx)
-                        MOV L (OpImm src2) 
-                               (OpAddr (AddrBaseIndex (Just ebx) Nothing 
-                                                      (ImmInt OFFSET_R1))),
-                        MOV L (OpReg src1) (OpReg eax),
-                        CLTD,
-                        IDIV sz (OpAddr (AddrBaseIndex (Just ebx) Nothing 
-                                         (ImmInt OFFSET_R1)))
-                      ]
-       in
-       returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
+    -- edx:eax / reg -> eax (remainder in edx).  Currently we choose
+    -- to put y on the C stack, since that avoids tying up yet another
+    -- precious register.
 
     quot_code sz x y is_division
 
     quot_code sz x y is_division
-      = getRegister x          `thenUs` \ register1 ->
-       getNewRegNCG IntRep     `thenUs` \ tmp1 ->
-       getRegister y           `thenUs` \ register2 ->
-       getNewRegNCG IntRep     `thenUs` \ tmp2 ->
+      = getRegister x          `thenNat` \ register1 ->
+       getRegister y           `thenNat` \ register2 ->
+       getNewRegNCG IntRep     `thenNat` \ tmp ->
+        getDeltaNat             `thenNat` \ delta ->
        let
        let
-           code1   = registerCode register1 tmp1 asmVoid
-           src1    = registerName register1 tmp1
-           code2   = registerCode register2 tmp2 asmVoid
-           src2    = registerName register2 tmp2
-           code__2 = asmParThen [code1, code2] .
-                     if src2 == ecx || src2 == esi
-                     then mkSeqInstrs [ 
-                              MOV L (OpReg src1) (OpReg eax),
-                             CLTD,
-                             IDIV sz (OpReg src2)
-                           ]
-                     else mkSeqInstrs [ -- we put src2 in (ebx)
-                             MOV L (OpReg src2) 
-                                    (OpAddr (AddrBaseIndex (Just ebx) Nothing 
-                                                           (ImmInt OFFSET_R1))),
-                             MOV L (OpReg src1) (OpReg eax),
-                             CLTD,
-                             IDIV sz (OpAddr (AddrBaseIndex (Just ebx) Nothing 
-                                                             (ImmInt OFFSET_R1)))
-                           ]
+           code1   = registerCode register1 tmp
+           src1    = registerName register1 tmp
+           code2   = registerCode register2 tmp
+           src2    = registerName register2 tmp
+           code__2 = code2               `snocOL`      --       src2 := y
+                      PUSH L (OpReg src2) `snocOL`      --   -4(%esp) := y
+                      DELTA (delta-4)     `appOL`
+                      code1               `snocOL`      --       src1 := x
+                      MOV L (OpReg src1) (OpReg eax) `snocOL`  -- eax := x
+                      CLTD                           `snocOL`
+                      IDIV sz (OpAddr (spRel 0))     `snocOL`
+                      ADD L (OpImm (ImmInt 4)) (OpReg esp) `snocOL`
+                      DELTA delta
        in
        in
-       returnUs (Fixed IntRep (if is_division then eax else edx) code__2)
+       returnNat (Fixed IntRep (if is_division then eax else edx) code__2)
        -----------------------
 
 getRegister (StInd pk mem)
        -----------------------
 
 getRegister (StInd pk mem)
-  = getAmode mem                   `thenUs` \ amode ->
+  = getAmode mem                   `thenNat` \ amode ->
     let
        code = amodeCode amode
        src  = amodeAddr amode
        size = primRepToSize pk
     let
        code = amodeCode amode
        src  = amodeAddr amode
        size = primRepToSize pk
-       code__2 dst = code .
-                     if pk == DoubleRep || pk == FloatRep
-                     then mkSeqInstr (GLD size src dst)
-                     else mkSeqInstr (MOV size (OpAddr src) (OpReg dst))
+       code__2 dst = code `snocOL`
+                     if   pk == DoubleRep || pk == FloatRep
+                     then GLD size src dst
+                     else case size of
+                             L -> MOV L    (OpAddr src) (OpReg dst)
+                             B -> MOVZxL B (OpAddr src) (OpReg dst)
     in
     in
-       returnUs (Any pk code__2)
+       returnNat (Any pk code__2)
 
 getRegister (StInt i)
   = let
        src = ImmInt (fromInteger i)
 
 getRegister (StInt i)
   = let
        src = ImmInt (fromInteger i)
-       code dst = mkSeqInstr (MOV L (OpImm src) (OpReg dst))
+       code dst 
+           | i == 0
+           = unitOL (XOR L (OpReg dst) (OpReg dst))
+           | otherwise
+           = unitOL (MOV L (OpImm src) (OpReg dst))
     in
     in
-       returnUs (Any IntRep code)
+       returnNat (Any IntRep code)
 
 getRegister leaf
   | maybeToBool imm
 
 getRegister leaf
   | maybeToBool imm
-  = let
-       code dst = mkSeqInstr (MOV L (OpImm imm__2) (OpReg dst))
+  = let code dst = unitOL (MOV L (OpImm imm__2) (OpReg dst))
     in
     in
-       returnUs (Any PtrRep code)
+       returnNat (Any PtrRep code)
   | otherwise
   | otherwise
-  = pprPanic "getRegister(x86)" (pprStixTrees [leaf])
+  = pprPanic "getRegister(x86)" (pprStixTree leaf)
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
@@ -868,10 +900,23 @@ getRegister leaf
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
+getRegister (StFloat d)
+  = getNatLabelNCG                 `thenNat` \ lbl ->
+    getNewRegNCG PtrRep            `thenNat` \ tmp ->
+    let code dst = toOL [
+           SEGMENT DataSegment,
+           LABEL lbl,
+           DATA F [ImmFloat d],
+           SEGMENT TextSegment,
+           SETHI (HI (ImmCLbl lbl)) tmp,
+           LD F (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
+    in
+       returnNat (Any FloatRep code)
+
 getRegister (StDouble d)
 getRegister (StDouble d)
-  = getUniqLabelNCG                `thenUs` \ lbl ->
-    getNewRegNCG PtrRep            `thenUs` \ tmp ->
-    let code dst = mkSeqInstrs [
+  = getNatLabelNCG                 `thenNat` \ lbl ->
+    getNewRegNCG PtrRep            `thenNat` \ tmp ->
+    let code dst = toOL [
            SEGMENT DataSegment,
            LABEL lbl,
            DATA DF [ImmDouble d],
            SEGMENT DataSegment,
            LABEL lbl,
            DATA DF [ImmDouble d],
@@ -879,35 +924,44 @@ getRegister (StDouble d)
            SETHI (HI (ImmCLbl lbl)) tmp,
            LD DF (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
     in
            SETHI (HI (ImmCLbl lbl)) tmp,
            LD DF (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
     in
-       returnUs (Any DoubleRep code)
+       returnNat (Any DoubleRep code)
+
+-- The 6-word scratch area is immediately below the frame pointer.
+-- Below that is the spill area.
+getRegister (StScratchWord i)
+   | i >= 0 && i < 6
+   = let j        = i+1
+         code dst = unitOL (fpRelEA j dst)
+     in 
+     returnNat (Any PtrRep code)
+
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
 
 getRegister (StPrim primop [x]) -- unary PrimOps
   = case primop of
-      IntNegOp -> trivialUCode (SUB False False g0) x
-      NotOp    -> trivialUCode (XNOR False g0) x
-
-      FloatNegOp  -> trivialUFCode FloatRep (FNEG F) x
+      IntNegOp       -> trivialUCode (SUB False False g0) x
+      NotOp          -> trivialUCode (XNOR False g0) x
 
 
-      DoubleNegOp -> trivialUFCode DoubleRep (FNEG DF) x
+      FloatNegOp     -> trivialUFCode FloatRep (FNEG F) x
+      DoubleNegOp    -> trivialUFCode DoubleRep (FNEG DF) x
 
       Double2FloatOp -> trivialUFCode FloatRep  (FxTOy DF F) x
       Float2DoubleOp -> trivialUFCode DoubleRep (FxTOy F DF) x
 
 
       Double2FloatOp -> trivialUFCode FloatRep  (FxTOy DF F) x
       Float2DoubleOp -> trivialUFCode DoubleRep (FxTOy F DF) x
 
-      OrdOp -> coerceIntCode IntRep x
-      ChrOp -> chrCode x
+      OrdOp          -> coerceIntCode IntRep x
+      ChrOp          -> chrCode x
 
 
-      Float2IntOp  -> coerceFP2Int x
-      Int2FloatOp  -> coerceInt2FP FloatRep x
-      Double2IntOp -> coerceFP2Int x
-      Int2DoubleOp -> coerceInt2FP DoubleRep x
+      Float2IntOp    -> coerceFP2Int x
+      Int2FloatOp    -> coerceInt2FP FloatRep x
+      Double2IntOp   -> coerceFP2Int x
+      Int2DoubleOp   -> coerceInt2FP DoubleRep x
 
       other_op ->
         let
 
       other_op ->
         let
-           fixed_x = if is_float_op  -- promote to double
-                         then StPrim Float2DoubleOp [x]
-                         else x
+           fixed_x = if   is_float_op  -- promote to double
+                     then StPrim Float2DoubleOp [x]
+                     else x
        in
        in
-       getRegister (StCall fn cCallConv DoubleRep [x])
+       getRegister (StCall fn cCallConv DoubleRep [fixed_x])
        where
        (is_float_op, fn)
          = case primop of
        where
        (is_float_op, fn)
          = case primop of
@@ -929,7 +983,7 @@ getRegister (StPrim primop [x]) -- unary PrimOps
 
              DoubleExpOp   -> (False, SLIT("exp"))
              DoubleLogOp   -> (False, SLIT("log"))
 
              DoubleExpOp   -> (False, SLIT("exp"))
              DoubleLogOp   -> (False, SLIT("log"))
-             DoubleSqrtOp  -> (True,  SLIT("sqrt"))
+             DoubleSqrtOp  -> (False, SLIT("sqrt"))
 
              DoubleSinOp   -> (False, SLIT("sin"))
              DoubleCosOp   -> (False, SLIT("cos"))
 
              DoubleSinOp   -> (False, SLIT("sin"))
              DoubleCosOp   -> (False, SLIT("cos"))
@@ -942,7 +996,10 @@ getRegister (StPrim primop [x]) -- unary PrimOps
              DoubleSinhOp  -> (False, SLIT("sinh"))
              DoubleCoshOp  -> (False, SLIT("cosh"))
              DoubleTanhOp  -> (False, SLIT("tanh"))
              DoubleSinhOp  -> (False, SLIT("sinh"))
              DoubleCoshOp  -> (False, SLIT("cosh"))
              DoubleTanhOp  -> (False, SLIT("tanh"))
-             _             -> panic ("Monadic PrimOp not handled: " ++ show primop)
+
+              other
+                 -> pprPanic "getRegister(sparc,monadicprimop)" 
+                             (pprStixTree (StPrim primop [x]))
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
 
 getRegister (StPrim primop [x, y]) -- dyadic PrimOps
   = case primop of
@@ -1016,39 +1073,47 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps
       ISraOp -> trivialCode SRA x y  --was: panic "SparcGen:isra"
       ISrlOp -> trivialCode SRL x y  --was: panic "SparcGen:isrl"
 
       ISraOp -> trivialCode SRA x y  --was: panic "SparcGen:isra"
       ISrlOp -> trivialCode SRL x y  --was: panic "SparcGen:isrl"
 
-      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [promote x, promote y])
+      FloatPowerOp  -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
+                                           [promote x, promote y])
                       where promote x = StPrim Float2DoubleOp [x]
                       where promote x = StPrim Float2DoubleOp [x]
-      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep [x, y])
---      _ -> panic "Prim op " ++ (showPrimOp primop) ++ " not handled!"
+      DoublePowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep 
+                                           [x, y])
+
+      other
+         -> pprPanic "getRegister(sparc,dyadic primop)" 
+                     (pprStixTree (StPrim primop [x, y]))
+
   where
     imul_div fn x y = getRegister (StCall fn cCallConv IntRep [x, y])
 
 getRegister (StInd pk mem)
   where
     imul_div fn x y = getRegister (StCall fn cCallConv IntRep [x, y])
 
 getRegister (StInd pk mem)
-  = getAmode mem                   `thenUs` \ amode ->
+  = getAmode mem                   `thenNat` \ amode ->
     let
        code = amodeCode amode
        src   = amodeAddr amode
        size = primRepToSize pk
     let
        code = amodeCode amode
        src   = amodeAddr amode
        size = primRepToSize pk
-       code__2 dst = code . mkSeqInstr (LD size src dst)
+       code__2 dst = code `snocOL` LD size src dst
     in
     in
-       returnUs (Any pk code__2)
+       returnNat (Any pk code__2)
 
 getRegister (StInt i)
   | fits13Bits i
   = let
        src = ImmInt (fromInteger i)
 
 getRegister (StInt i)
   | fits13Bits i
   = let
        src = ImmInt (fromInteger i)
-       code dst = mkSeqInstr (OR False g0 (RIImm src) dst)
+       code dst = unitOL (OR False g0 (RIImm src) dst)
     in
     in
-       returnUs (Any IntRep code)
+       returnNat (Any IntRep code)
 
 getRegister leaf
   | maybeToBool imm
   = let
 
 getRegister leaf
   | maybeToBool imm
   = let
-       code dst = mkSeqInstrs [
+       code dst = toOL [
            SETHI (HI imm__2) dst,
            OR False dst (RIImm (LO imm__2)) dst]
     in
            SETHI (HI imm__2) dst,
            OR False dst (RIImm (LO imm__2)) dst]
     in
-       returnUs (Any PtrRep code)
+       returnNat (Any PtrRep code)
+  | otherwise
+  = pprPanic "getRegister(sparc)" (pprStixTree leaf)
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
@@ -1073,119 +1138,125 @@ amodeCode (Amode _ code) = code
 Now, given a tree (the argument to an StInd) that references memory,
 produce a suitable addressing mode.
 
 Now, given a tree (the argument to an StInd) that references memory,
 produce a suitable addressing mode.
 
+A Rule of the Game (tm) for Amodes: use of the addr bit must
+immediately follow use of the code part, since the code part puts
+values in registers which the addr then refers to.  So you can't put
+anything in between, lest it overwrite some of those registers.  If
+you need to do some other computation between the code part and use of
+the addr bit, first store the effective address from the amode in a
+temporary, then do the other computation, and then use the temporary:
+
+    code
+    LEA amode, tmp
+    ... other computation ...
+    ... (tmp) ...
+
 \begin{code}
 \begin{code}
-getAmode :: StixTree -> UniqSM Amode
+getAmode :: StixTree -> NatM Amode
 
 getAmode tree@(StIndex _ _ _) = getAmode (mangleIndexTree tree)
 
 #if alpha_TARGET_ARCH
 
 getAmode (StPrim IntSubOp [x, StInt i])
 
 getAmode tree@(StIndex _ _ _) = getAmode (mangleIndexTree tree)
 
 #if alpha_TARGET_ARCH
 
 getAmode (StPrim IntSubOp [x, StInt i])
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister x              `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister x              `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (-(fromInteger i))
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (-(fromInteger i))
     in
-    returnUs (Amode (AddrRegImm reg off) code)
+    returnNat (Amode (AddrRegImm reg off) code)
 
 getAmode (StPrim IntAddOp [x, StInt i])
 
 getAmode (StPrim IntAddOp [x, StInt i])
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister x              `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister x              `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (fromInteger i)
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (fromInteger i)
     in
-    returnUs (Amode (AddrRegImm reg off) code)
+    returnNat (Amode (AddrRegImm reg off) code)
 
 getAmode leaf
   | maybeToBool imm
 
 getAmode leaf
   | maybeToBool imm
-  = returnUs (Amode (AddrImm imm__2) id)
+  = returnNat (Amode (AddrImm imm__2) id)
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
 getAmode other
   where
     imm = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
 getAmode other
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister other          `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister other          `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
     in
-    returnUs (Amode (AddrReg reg) code)
+    returnNat (Amode (AddrReg reg) code)
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 getAmode (StPrim IntSubOp [x, StInt i])
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 getAmode (StPrim IntSubOp [x, StInt i])
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister x              `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister x              `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (-(fromInteger i))
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (-(fromInteger i))
     in
-    returnUs (Amode (AddrBaseIndex (Just reg) Nothing off) code)
+    returnNat (Amode (AddrBaseIndex (Just reg) Nothing off) code)
 
 getAmode (StPrim IntAddOp [x, StInt i])
   | maybeToBool imm
 
 getAmode (StPrim IntAddOp [x, StInt i])
   | maybeToBool imm
-  = let
-       code = mkSeqInstrs []
-    in
-    returnUs (Amode (ImmAddr imm__2 (fromInteger i)) code)
+  = returnNat (Amode (ImmAddr imm__2 (fromInteger i)) nilOL)
   where
     imm    = maybeImm x
     imm__2 = case imm of Just x -> x
 
 getAmode (StPrim IntAddOp [x, StInt i])
   where
     imm    = maybeImm x
     imm__2 = case imm of Just x -> x
 
 getAmode (StPrim IntAddOp [x, StInt i])
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister x              `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister x              `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (fromInteger i)
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (fromInteger i)
     in
-    returnUs (Amode (AddrBaseIndex (Just reg) Nothing off) code)
+    returnNat (Amode (AddrBaseIndex (Just reg) Nothing off) code)
 
 getAmode (StPrim IntAddOp [x, StPrim SllOp [y, StInt shift]])
   | shift == 0 || shift == 1 || shift == 2 || shift == 3
 
 getAmode (StPrim IntAddOp [x, StPrim SllOp [y, StInt shift]])
   | shift == 0 || shift == 1 || shift == 2 || shift == 3
-  = getNewRegNCG PtrRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep        `thenUs` \ tmp2 ->
-    getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep        `thenNat` \ tmp2 ->
+    getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        reg1  = registerName register1 tmp1
        reg1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        reg2  = registerName register2 tmp2
        reg2  = registerName register2 tmp2
-       code__2 = asmParThen [code1, code2]
+       code__2 = code1 `appOL` code2
         base = case shift of 0 -> 1 ; 1 -> 2; 2 -> 4; 3 -> 8
     in
         base = case shift of 0 -> 1 ; 1 -> 2; 2 -> 4; 3 -> 8
     in
-    returnUs (Amode (AddrBaseIndex (Just reg1) (Just (reg2,base)) (ImmInt 0))
-                    code__2)
+    returnNat (Amode (AddrBaseIndex (Just reg1) (Just (reg2,base)) (ImmInt 0))
+               code__2)
 
 getAmode leaf
   | maybeToBool imm
 
 getAmode leaf
   | maybeToBool imm
-  = let
-       code = mkSeqInstrs []
-    in
-    returnUs (Amode (ImmAddr imm__2 0) code)
+  = returnNat (Amode (ImmAddr imm__2 0) nilOL)
   where
     imm    = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
 getAmode other
   where
     imm    = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
 getAmode other
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister other          `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister other          `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
     let
        code = registerCode register tmp
        reg  = registerName register tmp
-       off  = Nothing
     in
     in
-    returnUs (Amode (AddrBaseIndex (Just reg) Nothing (ImmInt 0)) code)
+    returnNat (Amode (AddrBaseIndex (Just reg) Nothing (ImmInt 0)) code)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -1193,61 +1264,61 @@ getAmode other
 
 getAmode (StPrim IntSubOp [x, StInt i])
   | fits13Bits (-i)
 
 getAmode (StPrim IntSubOp [x, StInt i])
   | fits13Bits (-i)
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister x              `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister x              `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (-(fromInteger i))
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (-(fromInteger i))
     in
-    returnUs (Amode (AddrRegImm reg off) code)
+    returnNat (Amode (AddrRegImm reg off) code)
 
 
 getAmode (StPrim IntAddOp [x, StInt i])
   | fits13Bits i
 
 
 getAmode (StPrim IntAddOp [x, StInt i])
   | fits13Bits i
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister x              `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister x              `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (fromInteger i)
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt (fromInteger i)
     in
-    returnUs (Amode (AddrRegImm reg off) code)
+    returnNat (Amode (AddrRegImm reg off) code)
 
 getAmode (StPrim IntAddOp [x, y])
 
 getAmode (StPrim IntAddOp [x, y])
-  = getNewRegNCG PtrRep        `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep        `thenUs` \ tmp2 ->
-    getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
+  = getNewRegNCG PtrRep        `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep        `thenNat` \ tmp2 ->
+    getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        reg1  = registerName register1 tmp1
        reg1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        reg2  = registerName register2 tmp2
        reg2  = registerName register2 tmp2
-       code__2 = asmParThen [code1, code2]
+       code__2 = code1 `appOL` code2
     in
     in
-    returnUs (Amode (AddrRegReg reg1 reg2) code__2)
+    returnNat (Amode (AddrRegReg reg1 reg2) code__2)
 
 getAmode leaf
   | maybeToBool imm
 
 getAmode leaf
   | maybeToBool imm
-  = getNewRegNCG PtrRep            `thenUs` \ tmp ->
+  = getNewRegNCG PtrRep            `thenNat` \ tmp ->
     let
     let
-       code = mkSeqInstr (SETHI (HI imm__2) tmp)
+       code = unitOL (SETHI (HI imm__2) tmp)
     in
     in
-    returnUs (Amode (AddrRegImm tmp (LO imm__2)) code)
+    returnNat (Amode (AddrRegImm tmp (LO imm__2)) code)
   where
     imm    = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
 getAmode other
   where
     imm    = maybeImm leaf
     imm__2 = case imm of Just x -> x
 
 getAmode other
-  = getNewRegNCG PtrRep                `thenUs` \ tmp ->
-    getRegister other          `thenUs` \ register ->
+  = getNewRegNCG PtrRep                `thenNat` \ tmp ->
+    getRegister other          `thenNat` \ register ->
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt 0
     in
     let
        code = registerCode register tmp
        reg  = registerName register tmp
        off  = ImmInt 0
     in
-    returnUs (Amode (AddrRegImm reg off) code)
+    returnNat (Amode (AddrRegImm reg off) code)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -1270,7 +1341,7 @@ condCode  (CondCode _ _ code)        = code
 Set up a condition code for a conditional branch.
 
 \begin{code}
 Set up a condition code for a conditional branch.
 
 \begin{code}
-getCondCode :: StixTree -> UniqSM CondCode
+getCondCode :: StixTree -> NatM CondCode
 
 #if alpha_TARGET_ARCH
 getCondCode = panic "MachCode.getCondCode: not on Alphas"
 
 #if alpha_TARGET_ARCH
 getCondCode = panic "MachCode.getCondCode: not on Alphas"
@@ -1283,46 +1354,46 @@ getCondCode = panic "MachCode.getCondCode: not on Alphas"
 getCondCode (StPrim primop [x, y])
   = case primop of
       CharGtOp -> condIntCode GTT  x y
 getCondCode (StPrim primop [x, y])
   = case primop of
       CharGtOp -> condIntCode GTT  x y
-      CharGeOp -> condIntCode GE  x y
+      CharGeOp -> condIntCode GE   x y
       CharEqOp -> condIntCode EQQ  x y
       CharEqOp -> condIntCode EQQ  x y
-      CharNeOp -> condIntCode NE  x y
+      CharNeOp -> condIntCode NE   x y
       CharLtOp -> condIntCode LTT  x y
       CharLtOp -> condIntCode LTT  x y
-      CharLeOp -> condIntCode LE  x y
+      CharLeOp -> condIntCode LE   x y
  
       IntGtOp  -> condIntCode GTT  x y
  
       IntGtOp  -> condIntCode GTT  x y
-      IntGeOp  -> condIntCode GE  x y
+      IntGeOp  -> condIntCode GE   x y
       IntEqOp  -> condIntCode EQQ  x y
       IntEqOp  -> condIntCode EQQ  x y
-      IntNeOp  -> condIntCode NE  x y
+      IntNeOp  -> condIntCode NE   x y
       IntLtOp  -> condIntCode LTT  x y
       IntLtOp  -> condIntCode LTT  x y
-      IntLeOp  -> condIntCode LE  x y
+      IntLeOp  -> condIntCode LE   x y
 
 
-      WordGtOp -> condIntCode GU  x y
-      WordGeOp -> condIntCode GEU x y
+      WordGtOp -> condIntCode GU   x y
+      WordGeOp -> condIntCode GEU  x y
       WordEqOp -> condIntCode EQQ  x y
       WordEqOp -> condIntCode EQQ  x y
-      WordNeOp -> condIntCode NE  x y
-      WordLtOp -> condIntCode LU  x y
-      WordLeOp -> condIntCode LEU x y
+      WordNeOp -> condIntCode NE   x y
+      WordLtOp -> condIntCode LU   x y
+      WordLeOp -> condIntCode LEU  x y
 
 
-      AddrGtOp -> condIntCode GU  x y
-      AddrGeOp -> condIntCode GEU x y
+      AddrGtOp -> condIntCode GU   x y
+      AddrGeOp -> condIntCode GEU  x y
       AddrEqOp -> condIntCode EQQ  x y
       AddrEqOp -> condIntCode EQQ  x y
-      AddrNeOp -> condIntCode NE  x y
-      AddrLtOp -> condIntCode LU  x y
-      AddrLeOp -> condIntCode LEU x y
+      AddrNeOp -> condIntCode NE   x y
+      AddrLtOp -> condIntCode LU   x y
+      AddrLeOp -> condIntCode LEU  x y
 
       FloatGtOp -> condFltCode GTT x y
 
       FloatGtOp -> condFltCode GTT x y
-      FloatGeOp -> condFltCode GE x y
+      FloatGeOp -> condFltCode GE  x y
       FloatEqOp -> condFltCode EQQ x y
       FloatEqOp -> condFltCode EQQ x y
-      FloatNeOp -> condFltCode NE x y
+      FloatNeOp -> condFltCode NE  x y
       FloatLtOp -> condFltCode LTT x y
       FloatLtOp -> condFltCode LTT x y
-      FloatLeOp -> condFltCode LE x y
+      FloatLeOp -> condFltCode LE  x y
 
       DoubleGtOp -> condFltCode GTT x y
 
       DoubleGtOp -> condFltCode GTT x y
-      DoubleGeOp -> condFltCode GE x y
+      DoubleGeOp -> condFltCode GE  x y
       DoubleEqOp -> condFltCode EQQ x y
       DoubleEqOp -> condFltCode EQQ x y
-      DoubleNeOp -> condFltCode NE x y
+      DoubleNeOp -> condFltCode NE  x y
       DoubleLtOp -> condFltCode LTT x y
       DoubleLtOp -> condFltCode LTT x y
-      DoubleLeOp -> condFltCode LE x y
+      DoubleLeOp -> condFltCode LE  x y
 
 #endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- i386_TARGET_ARCH || sparc_TARGET_ARCH -}
 \end{code}
@@ -1333,7 +1404,7 @@ getCondCode (StPrim primop [x, y])
 passed back up the tree.
 
 \begin{code}
 passed back up the tree.
 
 \begin{code}
-condIntCode, condFltCode :: Cond -> StixTree -> StixTree -> UniqSM CondCode
+condIntCode, condFltCode :: Cond -> StixTree -> StixTree -> NatM CondCode
 
 #if alpha_TARGET_ARCH
 condIntCode = panic "MachCode.condIntCode: not on Alphas"
 
 #if alpha_TARGET_ARCH
 condIntCode = panic "MachCode.condIntCode: not on Alphas"
@@ -1343,98 +1414,130 @@ condFltCode = panic "MachCode.condFltCode: not on Alphas"
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-condIntCode cond (StInd _ x) y
+-- memory vs immediate
+condIntCode cond (StInd pk x) y
   | maybeToBool imm
   | maybeToBool imm
-  = getAmode x                 `thenUs` \ amode ->
+  = getAmode x                 `thenNat` \ amode ->
     let
     let
-       code1 = amodeCode amode asmVoid
-       y__2  = amodeAddr amode
-       code__2 = asmParThen [code1] .
-                 mkSeqInstr (CMP L (OpImm imm__2) (OpAddr y__2))
+       code1 = amodeCode amode
+       x__2  = amodeAddr amode
+        sz    = primRepToSize pk
+       code__2 = code1 `snocOL`
+                 CMP sz (OpImm imm__2) (OpAddr x__2)
     in
     in
-    returnUs (CondCode False cond code__2)
+    returnNat (CondCode False cond code__2)
   where
     imm    = maybeImm y
     imm__2 = case imm of Just x -> x
 
   where
     imm    = maybeImm y
     imm__2 = case imm of Just x -> x
 
+-- anything vs zero
 condIntCode cond x (StInt 0)
 condIntCode cond x (StInt 0)
-  = getRegister x              `thenUs` \ register1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code__2 = asmParThen [code1] .
-               mkSeqInstr (TEST L (OpReg src1) (OpReg src1))
+       code__2 = code1 `snocOL`
+                 TEST L (OpReg src1) (OpReg src1)
     in
     in
-    returnUs (CondCode False cond code__2)
+    returnNat (CondCode False cond code__2)
 
 
+-- anything vs immediate
 condIntCode cond x y
   | maybeToBool imm
 condIntCode cond x y
   | maybeToBool imm
-  = getRegister x              `thenUs` \ register1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code__2 = asmParThen [code1] .
-               mkSeqInstr (CMP L (OpImm imm__2) (OpReg src1))
+       code__2 = code1 `snocOL`
+                  CMP L (OpImm imm__2) (OpReg src1)
     in
     in
-    returnUs (CondCode False cond code__2)
+    returnNat (CondCode False cond code__2)
   where
     imm    = maybeImm y
     imm__2 = case imm of Just x -> x
 
   where
     imm    = maybeImm y
     imm__2 = case imm of Just x -> x
 
-condIntCode cond (StInd _ x) y
-  = getAmode x                 `thenUs` \ amode ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
-    let
-       code1 = amodeCode amode asmVoid
-       src1  = amodeAddr amode
-       code2 = registerCode register2 tmp2 asmVoid
-       src2  = registerName register2 tmp2
-       code__2 = asmParThen [code1, code2] .
-                 mkSeqInstr (CMP L (OpReg src2) (OpAddr src1))
-    in
-    returnUs (CondCode False cond code__2)
-
-condIntCode cond y (StInd _ x)
-  = getAmode x                 `thenUs` \ amode ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
-    let
-       code1 = amodeCode amode asmVoid
-       src1  = amodeAddr amode
-       code2 = registerCode register2 tmp2 asmVoid
-       src2  = registerName register2 tmp2
-       code__2 = asmParThen [code1, code2] .
-                 mkSeqInstr (CMP L (OpAddr src1) (OpReg src2))
-    in
-    returnUs (CondCode False cond code__2)
-
+-- memory vs anything
+condIntCode cond (StInd pk x) y
+  = getAmode x                 `thenNat` \ amode_x ->
+    getRegister y              `thenNat` \ reg_y ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
+    let
+       c_x   = amodeCode amode_x
+       am_x  = amodeAddr amode_x
+       c_y   = registerCode reg_y tmp
+       r_y   = registerName reg_y tmp
+        sz    = primRepToSize pk
+
+        -- optimisation: if there's no code for x, just an amode,
+        -- use whatever reg y winds up in.  Assumes that c_y doesn't
+        -- clobber any regs in the amode am_x, which I'm not sure is
+        -- justified.  The otherwise clause makes the same assumption.
+       code__2 | isNilOL c_x 
+                = c_y `snocOL`
+                  CMP sz (OpReg r_y) (OpAddr am_x)
+
+                | otherwise
+                = c_y `snocOL` 
+                  MOV L (OpReg r_y) (OpReg tmp) `appOL`
+                  c_x `snocOL`
+                 CMP sz (OpReg tmp) (OpAddr am_x)
+    in
+    returnNat (CondCode False cond code__2)
+
+-- anything vs memory
+-- 
+condIntCode cond y (StInd pk x)
+  = getAmode x                 `thenNat` \ amode_x ->
+    getRegister y              `thenNat` \ reg_y ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
+    let
+       c_x   = amodeCode amode_x
+       am_x  = amodeAddr amode_x
+       c_y   = registerCode reg_y tmp
+       r_y   = registerName reg_y tmp
+        sz    = primRepToSize pk
+        -- same optimisation and nagging doubts as previous clause
+       code__2 | isNilOL c_x
+                = c_y `snocOL`
+                  CMP sz (OpAddr am_x) (OpReg r_y)
+
+                | otherwise
+                = c_y `snocOL` 
+                  MOV L (OpReg r_y) (OpReg tmp) `appOL`
+                  c_x `snocOL`
+                 CMP sz (OpAddr am_x) (OpReg tmp)
+    in
+    returnNat (CondCode False cond code__2)
+
+-- anything vs anything
 condIntCode cond x y
 condIntCode cond x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
        src2  = registerName register2 tmp2
-       code__2 = asmParThen [code1, code2] .
-               mkSeqInstr (CMP L (OpReg src2) (OpReg src1))
+       code__2 = code1 `snocOL`
+                  MOV L (OpReg src1) (OpReg tmp1) `appOL`
+                  code2 `snocOL`
+                 CMP L (OpReg src2) (OpReg tmp1)
     in
     in
-    returnUs (CondCode False cond code__2)
+    returnNat (CondCode False cond code__2)
 
 -----------
 condFltCode cond x y
 
 -----------
 condFltCode cond x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
     getNewRegNCG (registerRep register1)
     getNewRegNCG (registerRep register1)
-                               `thenUs` \ tmp1 ->
+                               `thenNat` \ tmp1 ->
     getNewRegNCG (registerRep register2)
     getNewRegNCG (registerRep register2)
-                               `thenUs` \ tmp2 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp ->
+                               `thenNat` \ tmp2 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp ->
     let
        pk1   = registerRep register1
        code1 = registerCode register1 tmp1
     let
        pk1   = registerRep register1
        code1 = registerCode register1 tmp1
@@ -1444,21 +1547,29 @@ condFltCode cond x y
        code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
 
        code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
 
-       code__2 =   asmParThen [code1 asmVoid, code2 asmVoid] .
-                   mkSeqInstr (GCMP (primRepToSize pk1) src1 src2)
+       code__2 | isAny register1
+                = code1 `appOL`   -- result in tmp1
+                  code2 `snocOL`
+                 GCMP (primRepToSize pk1) tmp1 src2
+                  
+                | otherwise
+                = code1 `snocOL` 
+                  GMOV src1 tmp1 `appOL`
+                  code2 `snocOL`
+                 GCMP (primRepToSize pk1) tmp1 src2
 
         {- On the 486, the flags set by FP compare are the unsigned ones!
            (This looks like a HACK to me.  WDP 96/03)
         -}
         fix_FP_cond :: Cond -> Cond
 
 
         {- On the 486, the flags set by FP compare are the unsigned ones!
            (This looks like a HACK to me.  WDP 96/03)
         -}
         fix_FP_cond :: Cond -> Cond
 
-        fix_FP_cond GE  = GEU
+        fix_FP_cond GE   = GEU
         fix_FP_cond GTT  = GU
         fix_FP_cond LTT  = LU
         fix_FP_cond GTT  = GU
         fix_FP_cond LTT  = LU
-        fix_FP_cond LE  = LEU
-        fix_FP_cond any = any
+        fix_FP_cond LE   = LEU
+        fix_FP_cond any  = any
     in
     in
-    returnUs (CondCode True (fix_FP_cond cond) code__2)
+    returnNat (CondCode True (fix_FP_cond cond) code__2)
 
 
 
 
 
 
@@ -1468,42 +1579,42 @@ condFltCode cond x y
 
 condIntCode cond x (StInt y)
   | fits13Bits y
 
 condIntCode cond x (StInt y)
   | fits13Bits y
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src1 = registerName register tmp
        src2 = ImmInt (fromInteger y)
     let
        code = registerCode register tmp
        src1 = registerName register tmp
        src2 = ImmInt (fromInteger y)
-       code__2 = code . mkSeqInstr (SUB False True src1 (RIImm src2) g0)
+       code__2 = code `snocOL` SUB False True src1 (RIImm src2) g0
     in
     in
-    returnUs (CondCode False cond code__2)
+    returnNat (CondCode False cond code__2)
 
 condIntCode cond x y
 
 condIntCode cond x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
        src2  = registerName register2 tmp2
-       code__2 = asmParThen [code1, code2] .
-               mkSeqInstr (SUB False True src1 (RIReg src2) g0)
+       code__2 = code1 `appOL` code2 `snocOL`
+                 SUB False True src1 (RIReg src2) g0
     in
     in
-    returnUs (CondCode False cond code__2)
+    returnNat (CondCode False cond code__2)
 
 -----------
 condFltCode cond x y
 
 -----------
 condFltCode cond x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
     getNewRegNCG (registerRep register1)
     getNewRegNCG (registerRep register1)
-                               `thenUs` \ tmp1 ->
+                               `thenNat` \ tmp1 ->
     getNewRegNCG (registerRep register2)
     getNewRegNCG (registerRep register2)
-                               `thenUs` \ tmp2 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp ->
+                               `thenNat` \ tmp2 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp ->
     let
     let
-       promote x = asmInstr (FxTOy F DF x tmp)
+       promote x = FxTOy F DF x tmp
 
        pk1   = registerRep register1
        code1 = registerCode register1 tmp1
 
        pk1   = registerRep register1
        code1 = registerCode register1 tmp1
@@ -1515,16 +1626,16 @@ condFltCode cond x y
 
        code__2 =
                if pk1 == pk2 then
 
        code__2 =
                if pk1 == pk2 then
-                   asmParThen [code1 asmVoid, code2 asmVoid] .
-                   mkSeqInstr (FCMP True (primRepToSize pk1) src1 src2)
+                   code1 `appOL` code2 `snocOL`
+                   FCMP True (primRepToSize pk1) src1 src2
                else if pk1 == FloatRep then
                else if pk1 == FloatRep then
-                   asmParThen [code1 (promote src1), code2 asmVoid] .
-                   mkSeqInstr (FCMP True DF tmp src2)
+                   code1 `snocOL` promote src1 `appOL` code2 `snocOL`
+                   FCMP True DF tmp src2
                else
                else
-                   asmParThen [code1 asmVoid, code2 (promote src2)] .
-                   mkSeqInstr (FCMP True DF src1 tmp)
+                   code1 `appOL` code2 `snocOL` promote src2 `snocOL`
+                   FCMP True DF src1 tmp
     in
     in
-    returnUs (CondCode True cond code__2)
+    returnNat (CondCode True cond code__2)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -1545,27 +1656,27 @@ hand side is forced into a fixed register (e.g. the result of a call).
 
 \begin{code}
 assignIntCode, assignFltCode
 
 \begin{code}
 assignIntCode, assignFltCode
-       :: PrimRep -> StixTree -> StixTree -> UniqSM InstrBlock
+       :: PrimRep -> StixTree -> StixTree -> NatM InstrBlock
 
 #if alpha_TARGET_ARCH
 
 assignIntCode pk (StInd _ dst) src
 
 #if alpha_TARGET_ARCH
 
 assignIntCode pk (StInd _ dst) src
-  = getNewRegNCG IntRep            `thenUs` \ tmp ->
-    getAmode dst                   `thenUs` \ amode ->
-    getRegister src                `thenUs` \ register ->
+  = getNewRegNCG IntRep            `thenNat` \ tmp ->
+    getAmode dst                   `thenNat` \ amode ->
+    getRegister src                `thenNat` \ register ->
     let
     let
-       code1   = amodeCode amode asmVoid
+       code1   = amodeCode amode []
        dst__2  = amodeAddr amode
        dst__2  = amodeAddr amode
-       code2   = registerCode register tmp asmVoid
+       code2   = registerCode register tmp []
        src__2  = registerName register tmp
        sz      = primRepToSize pk
        src__2  = registerName register tmp
        sz      = primRepToSize pk
-       code__2 = asmParThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
+       code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
     in
     in
-    returnUs code__2
+    returnNat code__2
 
 assignIntCode pk dst src
 
 assignIntCode pk dst src
-  = getRegister dst                        `thenUs` \ register1 ->
-    getRegister src                        `thenUs` \ register2 ->
+  = getRegister dst                        `thenNat` \ register1 ->
+    getRegister src                        `thenNat` \ register2 ->
     let
        dst__2  = registerName register1 zeroh
        code    = registerCode register2 dst__2
     let
        dst__2  = registerName register1 zeroh
        code    = registerCode register2 dst__2
@@ -1574,105 +1685,132 @@ assignIntCode pk dst src
                  then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2)
                  else code
     in
                  then code . mkSeqInstr (OR src__2 (RIReg src__2) dst__2)
                  else code
     in
-    returnUs code__2
+    returnNat code__2
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-assignIntCode pk dd@(StInd _ dst) src
-  = getAmode dst               `thenUs` \ amode ->
-    get_op_RI src              `thenUs` \ (codesrc, opsrc) ->
-    let
-       code1   = amodeCode amode asmVoid
-       dst__2  = amodeAddr amode
-       code__2 = asmParThen [code1, codesrc asmVoid] .
-                 mkSeqInstr (MOV (primRepToSize pk) opsrc (OpAddr dst__2))
-    in
-    returnUs code__2
+-- Destination of an assignment can only be reg or mem.
+-- This is the mem case.
+assignIntCode pk (StInd _ dst) src
+  = getAmode dst               `thenNat` \ amode ->
+    get_op_RI src              `thenNat` \ (codesrc, opsrc) ->
+    getNewRegNCG PtrRep         `thenNat` \ tmp ->
+    let
+        -- In general, if the address computation for dst may require
+        -- some insns preceding the addressing mode itself.  So there's
+        -- no guarantee that the code for dst and the code for src won't
+        -- write the same register.  This means either the address or 
+        -- the value needs to be copied into a temporary.  We detect the
+        -- common case where the amode has no code, and elide the copy.
+       codea   = amodeCode amode
+       dst__a  = amodeAddr amode
+
+       code    | isNilOL codea
+                = codesrc `snocOL`
+                 MOV (primRepToSize pk) opsrc (OpAddr dst__a)
+                | otherwise
+
+                = codea `snocOL` 
+                  LEA L (OpAddr dst__a) (OpReg tmp) `appOL`
+                  codesrc `snocOL`
+                  MOV (primRepToSize pk) opsrc 
+                      (OpAddr (AddrBaseIndex (Just tmp) Nothing (ImmInt 0)))
+    in
+    returnNat code
   where
     get_op_RI
        :: StixTree
   where
     get_op_RI
        :: StixTree
-       -> UniqSM (InstrBlock,Operand)  -- code, operator
+       -> NatM (InstrBlock,Operand)    -- code, operator
 
     get_op_RI op
       | maybeToBool imm
 
     get_op_RI op
       | maybeToBool imm
-      = returnUs (asmParThen [], OpImm imm_op)
+      = returnNat (nilOL, OpImm imm_op)
       where
        imm    = maybeImm op
        imm_op = case imm of Just x -> x
 
     get_op_RI op
       where
        imm    = maybeImm op
        imm_op = case imm of Just x -> x
 
     get_op_RI op
-      = getRegister op                 `thenUs` \ register ->
+      = getRegister op                 `thenNat` \ register ->
        getNewRegNCG (registerRep register)
        getNewRegNCG (registerRep register)
-                                       `thenUs` \ tmp ->
-       let
-           code = registerCode register tmp
+                                       `thenNat` \ tmp ->
+       let code = registerCode register tmp
            reg  = registerName register tmp
        in
            reg  = registerName register tmp
        in
-       returnUs (code, OpReg reg)
+       returnNat (code, OpReg reg)
 
 
+-- Assign; dst is a reg, rhs is mem
 assignIntCode pk dst (StInd pks src)
 assignIntCode pk dst (StInd pks src)
-  = getNewRegNCG IntRep            `thenUs` \ tmp ->
-    getAmode src                   `thenUs` \ amode ->
-    getRegister dst                        `thenUs` \ register ->
-    let
-       code1   = amodeCode amode asmVoid
-       src__2  = amodeAddr amode
-       code2   = registerCode register tmp asmVoid
-       dst__2  = registerName register tmp
-       szs     = primRepToSize pks
-       code__2 = asmParThen [code1, code2] .
-                  case szs of
-                     L -> mkSeqInstr (MOV L (OpAddr src__2) (OpReg dst__2))
-                     B -> mkSeqInstr (MOVZxL B (OpAddr src__2) (OpReg dst__2))
-    in
-    returnUs code__2
-
-assignIntCode pk dst src
-  = getRegister dst                        `thenUs` \ register1 ->
-    getRegister src                        `thenUs` \ register2 ->
-    getNewRegNCG IntRep            `thenUs` \ tmp ->
+  = getNewRegNCG PtrRep            `thenNat` \ tmp ->
+    getAmode src                   `thenNat` \ amode ->
+    getRegister dst                `thenNat` \ reg_dst ->
     let
     let
-       dst__2  = registerName register1 tmp
-       code    = registerCode register2 dst__2
-       src__2  = registerName register2 dst__2
-       code__2 = if isFixed register2 && dst__2 /= src__2
-                 then code . mkSeqInstr (MOV L (OpReg src__2) (OpReg dst__2))
-                 else code
+       c_addr  = amodeCode amode
+       am_addr = amodeAddr amode
+
+       c_dst = registerCode reg_dst tmp  -- should be empty
+       r_dst = registerName reg_dst tmp
+       szs   = primRepToSize pks
+        opc   = case szs of L -> MOV L ; B -> MOVZxL B
+
+       code  | isNilOL c_dst
+              = c_addr `snocOL`
+                opc (OpAddr am_addr) (OpReg r_dst)
+              | otherwise
+              = pprPanic "assignIntCode(x86): bad dst(2)" empty
     in
     in
-    returnUs code__2
+    returnNat code
+
+-- dst is a reg, but src could be anything
+assignIntCode pk dst src
+  = getRegister dst                `thenNat` \ registerd ->
+    getRegister src                `thenNat` \ registers ->
+    getNewRegNCG IntRep            `thenNat` \ tmp ->
+    let 
+        r_dst = registerName registerd tmp
+        c_dst = registerCode registerd tmp -- should be empty
+        r_src = registerName registers r_dst
+        c_src = registerCode registers r_dst
+        
+        code | isNilOL c_dst
+             = c_src `snocOL` 
+               MOV L (OpReg r_src) (OpReg r_dst)
+             | otherwise
+             = pprPanic "assignIntCode(x86): bad dst(3)" empty
+    in
+    returnNat code
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 assignIntCode pk (StInd _ dst) src
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 assignIntCode pk (StInd _ dst) src
-  = getNewRegNCG IntRep            `thenUs` \ tmp ->
-    getAmode dst                   `thenUs` \ amode ->
-    getRegister src                        `thenUs` \ register ->
+  = getNewRegNCG IntRep            `thenNat` \ tmp ->
+    getAmode dst                   `thenNat` \ amode ->
+    getRegister src                        `thenNat` \ register ->
     let
     let
-       code1   = amodeCode amode asmVoid
+       code1   = amodeCode amode
        dst__2  = amodeAddr amode
        dst__2  = amodeAddr amode
-       code2   = registerCode register tmp asmVoid
+       code2   = registerCode register tmp
        src__2  = registerName register tmp
        sz      = primRepToSize pk
        src__2  = registerName register tmp
        sz      = primRepToSize pk
-       code__2 = asmParThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
+       code__2 = code1 `appOL` code2 `snocOL` ST sz src__2 dst__2
     in
     in
-    returnUs code__2
+    returnNat code__2
 
 assignIntCode pk dst src
 
 assignIntCode pk dst src
-  = getRegister dst                        `thenUs` \ register1 ->
-    getRegister src                        `thenUs` \ register2 ->
+  = getRegister dst                        `thenNat` \ register1 ->
+    getRegister src                        `thenNat` \ register2 ->
     let
        dst__2  = registerName register1 g0
        code    = registerCode register2 dst__2
        src__2  = registerName register2 dst__2
        code__2 = if isFixed register2
     let
        dst__2  = registerName register1 g0
        code    = registerCode register2 dst__2
        src__2  = registerName register2 dst__2
        code__2 = if isFixed register2
-                 then code . mkSeqInstr (OR False g0 (RIReg src__2) dst__2)
+                 then code `snocOL` OR False g0 (RIReg src__2) dst__2
                  else code
     in
                  else code
     in
-    returnUs code__2
+    returnNat code__2
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -1684,22 +1822,22 @@ Floating-point assignments:
 #if alpha_TARGET_ARCH
 
 assignFltCode pk (StInd _ dst) src
 #if alpha_TARGET_ARCH
 
 assignFltCode pk (StInd _ dst) src
-  = getNewRegNCG pk                `thenUs` \ tmp ->
-    getAmode dst                   `thenUs` \ amode ->
-    getRegister src                        `thenUs` \ register ->
+  = getNewRegNCG pk                `thenNat` \ tmp ->
+    getAmode dst                   `thenNat` \ amode ->
+    getRegister src                        `thenNat` \ register ->
     let
     let
-       code1   = amodeCode amode asmVoid
+       code1   = amodeCode amode []
        dst__2  = amodeAddr amode
        dst__2  = amodeAddr amode
-       code2   = registerCode register tmp asmVoid
+       code2   = registerCode register tmp []
        src__2  = registerName register tmp
        sz      = primRepToSize pk
        src__2  = registerName register tmp
        sz      = primRepToSize pk
-       code__2 = asmParThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
+       code__2 = asmSeqThen [code1, code2] . mkSeqInstr (ST sz src__2 dst__2)
     in
     in
-    returnUs code__2
+    returnNat code__2
 
 assignFltCode pk dst src
 
 assignFltCode pk dst src
-  = getRegister dst                        `thenUs` \ register1 ->
-    getRegister src                        `thenUs` \ register2 ->
+  = getRegister dst                        `thenNat` \ register1 ->
+    getRegister src                        `thenNat` \ register2 ->
     let
        dst__2  = registerName register1 zeroh
        code    = registerCode register2 dst__2
     let
        dst__2  = registerName register1 zeroh
        code    = registerCode register2 dst__2
@@ -1708,106 +1846,94 @@ assignFltCode pk dst src
                  then code . mkSeqInstr (FMOV src__2 dst__2)
                  else code
     in
                  then code . mkSeqInstr (FMOV src__2 dst__2)
                  else code
     in
-    returnUs code__2
+    returnNat code__2
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-assignFltCode pk (StInd pk_dst dst) (StInd pk_src src)
-  = getNewRegNCG IntRep            `thenUs` \ tmp ->
-    getAmode src                   `thenUs` \ amodesrc ->
-    getAmode dst                   `thenUs` \ amodedst ->
-    let
-       codesrc1 = amodeCode amodesrc asmVoid
-       addrsrc1 = amodeAddr amodesrc
-       codedst1 = amodeCode amodedst asmVoid
-       addrdst1 = amodeAddr amodedst
-       addrsrc2 = case (addrOffset addrsrc1 4) of Just x -> x
-       addrdst2 = case (addrOffset addrdst1 4) of Just x -> x
-
-       code__2 = asmParThen [codesrc1, codedst1] .
-                 mkSeqInstrs ([MOV L (OpAddr addrsrc1) (OpReg tmp),
-                               MOV L (OpReg tmp) (OpAddr addrdst1)]
-                              ++
-                              if pk == DoubleRep
-                              then [MOV L (OpAddr addrsrc2) (OpReg tmp),
-                                    MOV L (OpReg tmp) (OpAddr addrdst2)]
-                              else [])
-    in
-    returnUs code__2
-
-assignFltCode pk (StInd _ dst) src
-  = getNewRegNCG pk                `thenUs` \ tmp ->
-    getAmode dst                   `thenUs` \ amode ->
-    getRegister src                `thenUs` \ register ->
+-- dst is memory
+assignFltCode pk (StInd pk_dst addr) src
+   | pk /= pk_dst
+   = pprPanic "assignFltCode(x86): src/ind sz mismatch" empty
+   | otherwise
+   = getRegister src      `thenNat`  \ reg_src  ->
+     getRegister addr     `thenNat`  \ reg_addr ->
+     getNewRegNCG pk      `thenNat`  \ tmp_src  ->
+     getNewRegNCG PtrRep  `thenNat`  \ tmp_addr ->
+     let r_src  = registerName reg_src tmp_src
+         c_src  = registerCode reg_src tmp_src
+         r_addr = registerName reg_addr tmp_addr
+         c_addr = registerCode reg_addr tmp_addr
+         sz     = primRepToSize pk
+
+         code = c_src  `appOL`
+                -- no need to preserve r_src across the addr computation,
+                -- since r_src must be a float reg 
+                -- whilst r_addr is an int reg
+                c_addr `snocOL`
+                GST sz r_src 
+                       (AddrBaseIndex (Just r_addr) Nothing (ImmInt 0))
+     in
+     returnNat code
+
+-- dst must be a (FP) register
+assignFltCode pk dst src
+  = getRegister dst                `thenNat` \ reg_dst ->
+    getRegister src                `thenNat` \ reg_src ->
+    getNewRegNCG pk                 `thenNat` \ tmp ->
     let
     let
-       sz      = primRepToSize pk
-       dst__2  = amodeAddr amode
-
-       code1   = amodeCode amode asmVoid
-       code2   = registerCode register tmp asmVoid
+       r_dst = registerName reg_dst tmp
+        c_dst = registerCode reg_dst tmp -- should be empty
 
 
-       src__2  = registerName register tmp
+       r_src = registerName reg_src r_dst
+       c_src = registerCode reg_src r_dst
 
 
-       code__2 = asmParThen [code1, code2] .
-                 mkSeqInstr (GST sz src__2 dst__2)
+       code | isNilOL c_dst
+             = if   isFixed reg_src
+               then c_src `snocOL` GMOV r_src r_dst
+               else c_src
+             | otherwise
+             = pprPanic "assignFltCode(x86): lhs is not mem or reg" 
+                        empty
     in
     in
-    returnUs code__2
-
-assignFltCode pk dst src
-  = getRegister dst                        `thenUs` \ register1 ->
-    getRegister src                        `thenUs` \ register2 ->
-    getNewRegNCG pk                         `thenUs` \ tmp ->
-    let
-        -- the register which is dst
-       dst__2  = registerName register1 tmp
-        -- the register into which src is computed, preferably dst__2
-       src__2  = registerName register2 dst__2
-        -- code to compute src into src__2
-       code    = registerCode register2 dst__2
+    returnNat code
 
 
-       code__2 = if isFixed register2
-                  then code . mkSeqInstr (GMOV src__2 dst__2)
-                  else code
-    in
-    returnUs code__2
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 assignFltCode pk (StInd _ dst) src
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 assignFltCode pk (StInd _ dst) src
-  = getNewRegNCG pk                `thenUs` \ tmp1 ->
-    getAmode dst                   `thenUs` \ amode ->
-    getRegister src                `thenUs` \ register ->
+  = getNewRegNCG pk                `thenNat` \ tmp1 ->
+    getAmode dst                   `thenNat` \ amode ->
+    getRegister src                `thenNat` \ register ->
     let
        sz      = primRepToSize pk
        dst__2  = amodeAddr amode
 
     let
        sz      = primRepToSize pk
        dst__2  = amodeAddr amode
 
-       code1   = amodeCode amode asmVoid
-       code2   = registerCode register tmp1 asmVoid
+       code1   = amodeCode amode
+       code2   = registerCode register tmp1
 
        src__2  = registerName register tmp1
        pk__2   = registerRep register
        sz__2   = primRepToSize pk__2
 
 
        src__2  = registerName register tmp1
        pk__2   = registerRep register
        sz__2   = primRepToSize pk__2
 
-       code__2 = asmParThen [code1, code2] .
-           if pk == pk__2 then
-                   mkSeqInstr (ST sz src__2 dst__2)
-           else
-               mkSeqInstrs [FxTOy sz__2 sz src__2 tmp1, ST sz tmp1 dst__2]
+       code__2 = code1 `appOL` code2 `appOL`
+           if   pk == pk__2 
+            then unitOL (ST sz src__2 dst__2)
+           else toOL [FxTOy sz__2 sz src__2 tmp1, ST sz tmp1 dst__2]
     in
     in
-    returnUs code__2
+    returnNat code__2
 
 assignFltCode pk dst src
 
 assignFltCode pk dst src
-  = getRegister dst                        `thenUs` \ register1 ->
-    getRegister src                        `thenUs` \ register2 ->
+  = getRegister dst                        `thenNat` \ register1 ->
+    getRegister src                        `thenNat` \ register2 ->
     let 
         pk__2   = registerRep register2 
         sz__2   = primRepToSize pk__2
     in
     let 
         pk__2   = registerRep register2 
         sz__2   = primRepToSize pk__2
     in
-    getNewRegNCG pk__2                      `thenUs` \ tmp ->
+    getNewRegNCG pk__2                      `thenNat` \ tmp ->
     let
        sz      = primRepToSize pk
        dst__2  = registerName register1 g0    -- must be Fixed
     let
        sz      = primRepToSize pk
        dst__2  = registerName register1 g0    -- must be Fixed
@@ -1821,13 +1947,13 @@ assignFltCode pk dst src
 
        code__2 = 
                if pk /= pk__2 then
 
        code__2 = 
                if pk /= pk__2 then
-                    code . mkSeqInstr (FxTOy sz__2 sz src__2 dst__2)
+                    code `snocOL` FxTOy sz__2 sz src__2 dst__2
                else if isFixed register2 then
                else if isFixed register2 then
-                    code . mkSeqInstr (FMOV sz src__2 dst__2)
+                    code `snocOL` FMOV sz src__2 dst__2
                else
                     code
     in
                else
                     code
     in
-    returnUs code__2
+    returnNat code__2
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -1847,7 +1973,7 @@ branch instruction.  Other CLabels are assumed to be far away.
 register allocator.
 
 \begin{code}
 register allocator.
 
 \begin{code}
-genJump :: StixTree{-the branch target-} -> UniqSM InstrBlock
+genJump :: StixTree{-the branch target-} -> NatM InstrBlock
 
 #if alpha_TARGET_ARCH
 
 
 #if alpha_TARGET_ARCH
 
@@ -1858,8 +1984,8 @@ genJump (StCLbl lbl)
     target = ImmCLbl lbl
 
 genJump tree
     target = ImmCLbl lbl
 
 genJump tree
-  = getRegister tree                       `thenUs` \ register ->
-    getNewRegNCG PtrRep            `thenUs` \ tmp ->
+  = getRegister tree                       `thenNat` \ register ->
+    getNewRegNCG PtrRep            `thenNat` \ tmp ->
     let
        dst    = registerName register pv
        code   = registerCode register pv
     let
        dst    = registerName register pv
        code   = registerCode register pv
@@ -1868,40 +1994,32 @@ genJump tree
     if isFixed register then
        returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
     else
     if isFixed register then
        returnSeq code [OR dst (RIReg dst) pv, JMP zeroh (AddrReg pv) 0]
     else
-    returnUs (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
+    returnNat (code . mkSeqInstr (JMP zeroh (AddrReg pv) 0))
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
-{-
-genJump (StCLbl lbl)
-  | isAsmTemp lbl = returnInstrs [JXX ALWAYS lbl]
-  | otherwise     = returnInstrs [JMP (OpImm target)]
-  where
-    target = ImmCLbl lbl
--}
-
 genJump (StInd pk mem)
 genJump (StInd pk mem)
-  = getAmode mem                   `thenUs` \ amode ->
+  = getAmode mem                   `thenNat` \ amode ->
     let
        code   = amodeCode amode
        target = amodeAddr amode
     in
     let
        code   = amodeCode amode
        target = amodeAddr amode
     in
-    returnSeq code [JMP (OpAddr target)]
+    returnNat (code `snocOL` JMP (OpAddr target))
 
 genJump tree
   | maybeToBool imm
 
 genJump tree
   | maybeToBool imm
-  = returnInstr (JMP (OpImm target))
+  = returnNat (unitOL (JMP (OpImm target)))
 
   | otherwise
 
   | otherwise
-  = getRegister tree                       `thenUs` \ register ->
-    getNewRegNCG PtrRep            `thenUs` \ tmp ->
+  = getRegister tree               `thenNat` \ register ->
+    getNewRegNCG PtrRep            `thenNat` \ tmp ->
     let
        code   = registerCode register tmp
        target = registerName register tmp
     in
     let
        code   = registerCode register tmp
        target = registerName register tmp
     in
-    returnSeq code [JMP (OpReg target)]
+    returnNat (code `snocOL` JMP (OpReg target))
   where
     imm    = maybeImm tree
     target = case imm of Just x -> x
   where
     imm    = maybeImm tree
     target = case imm of Just x -> x
@@ -1911,19 +2029,19 @@ genJump tree
 #if sparc_TARGET_ARCH
 
 genJump (StCLbl lbl)
 #if sparc_TARGET_ARCH
 
 genJump (StCLbl lbl)
-  | isAsmTemp lbl = returnInstrs [BI ALWAYS False target, NOP]
-  | otherwise     = returnInstrs [CALL target 0 True, NOP]
+  | isAsmTemp lbl = returnNat (toOL [BI ALWAYS False target, NOP])
+  | otherwise     = returnNat (toOL [CALL target 0 True, NOP])
   where
     target = ImmCLbl lbl
 
 genJump tree
   where
     target = ImmCLbl lbl
 
 genJump tree
-  = getRegister tree                       `thenUs` \ register ->
-    getNewRegNCG PtrRep            `thenUs` \ tmp ->
+  = getRegister tree                       `thenNat` \ register ->
+    getNewRegNCG PtrRep            `thenNat` \ tmp ->
     let
        code   = registerCode register tmp
        target = registerName register tmp
     in
     let
        code   = registerCode register tmp
        target = registerName register tmp
     in
-    returnSeq code [JMP (AddrRegReg target g0), NOP]
+    returnNat (code `snocOL` JMP (AddrRegReg target g0) `snocOL` NOP)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -1957,14 +2075,14 @@ allocator.
 genCondJump
     :: CLabel      -- the branch target
     -> StixTree     -- the condition on which to branch
 genCondJump
     :: CLabel      -- the branch target
     -> StixTree     -- the condition on which to branch
-    -> UniqSM InstrBlock
+    -> NatM InstrBlock
 
 #if alpha_TARGET_ARCH
 
 genCondJump lbl (StPrim op [x, StInt 0])
 
 #if alpha_TARGET_ARCH
 
 genCondJump lbl (StPrim op [x, StInt 0])
-  = getRegister x                          `thenUs` \ register ->
+  = getRegister x                          `thenNat` \ register ->
     getNewRegNCG (registerRep register)
     getNewRegNCG (registerRep register)
-                                   `thenUs` \ tmp ->
+                                   `thenNat` \ tmp ->
     let
        code   = registerCode register tmp
        value  = registerName register tmp
     let
        code   = registerCode register tmp
        value  = registerName register tmp
@@ -1999,16 +2117,16 @@ genCondJump lbl (StPrim op [x, StInt 0])
     cmpOp AddrLeOp = EQQ
 
 genCondJump lbl (StPrim op [x, StDouble 0.0])
     cmpOp AddrLeOp = EQQ
 
 genCondJump lbl (StPrim op [x, StDouble 0.0])
-  = getRegister x                          `thenUs` \ register ->
+  = getRegister x                          `thenNat` \ register ->
     getNewRegNCG (registerRep register)
     getNewRegNCG (registerRep register)
-                                   `thenUs` \ tmp ->
+                                   `thenNat` \ tmp ->
     let
        code   = registerCode register tmp
        value  = registerName register tmp
        pk     = registerRep register
        target = ImmCLbl lbl
     in
     let
        code   = registerCode register tmp
        value  = registerName register tmp
        pk     = registerRep register
        target = ImmCLbl lbl
     in
-    returnUs (code . mkSeqInstr (BF (cmpOp op) value target))
+    returnNat (code . mkSeqInstr (BF (cmpOp op) value target))
   where
     cmpOp FloatGtOp = GTT
     cmpOp FloatGeOp = GE
   where
     cmpOp FloatGtOp = GTT
     cmpOp FloatGeOp = GE
@@ -2025,14 +2143,14 @@ genCondJump lbl (StPrim op [x, StDouble 0.0])
 
 genCondJump lbl (StPrim op [x, y])
   | fltCmpOp op
 
 genCondJump lbl (StPrim op [x, y])
   | fltCmpOp op
-  = trivialFCode pr instr x y      `thenUs` \ register ->
-    getNewRegNCG DoubleRep         `thenUs` \ tmp ->
+  = trivialFCode pr instr x y      `thenNat` \ register ->
+    getNewRegNCG DoubleRep         `thenNat` \ tmp ->
     let
        code   = registerCode register tmp
        result = registerName register tmp
        target = ImmCLbl lbl
     in
     let
        code   = registerCode register tmp
        result = registerName register tmp
        target = ImmCLbl lbl
     in
-    returnUs (code . mkSeqInstr (BF cond result target))
+    returnNat (code . mkSeqInstr (BF cond result target))
   where
     pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
 
   where
     pr = panic "trivialU?FCode: does not use PrimRep on Alpha"
 
@@ -2065,14 +2183,14 @@ genCondJump lbl (StPrim op [x, y])
        DoubleLeOp -> (FCMP TF LE, NE)
 
 genCondJump lbl (StPrim op [x, y])
        DoubleLeOp -> (FCMP TF LE, NE)
 
 genCondJump lbl (StPrim op [x, y])
-  = trivialCode instr x y          `thenUs` \ register ->
-    getNewRegNCG IntRep            `thenUs` \ tmp ->
+  = trivialCode instr x y          `thenNat` \ register ->
+    getNewRegNCG IntRep            `thenNat` \ tmp ->
     let
        code   = registerCode register tmp
        result = registerName register tmp
        target = ImmCLbl lbl
     in
     let
        code   = registerCode register tmp
        result = registerName register tmp
        target = ImmCLbl lbl
     in
-    returnUs (code . mkSeqInstr (BI cond result target))
+    returnNat (code . mkSeqInstr (BI cond result target))
   where
     (instr, cond) = case op of
        CharGtOp -> (CMP LE, EQQ)
   where
     (instr, cond) = case op of
        CharGtOp -> (CMP LE, EQQ)
@@ -2105,30 +2223,32 @@ genCondJump lbl (StPrim op [x, y])
 #if i386_TARGET_ARCH
 
 genCondJump lbl bool
 #if i386_TARGET_ARCH
 
 genCondJump lbl bool
-  = getCondCode bool               `thenUs` \ condition ->
+  = getCondCode bool               `thenNat` \ condition ->
     let
        code   = condCode condition
        cond   = condName condition
        target = ImmCLbl lbl
     in
     let
        code   = condCode condition
        cond   = condName condition
        target = ImmCLbl lbl
     in
-    returnSeq code [JXX cond lbl]
+    returnNat (code `snocOL` JXX cond lbl)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 genCondJump lbl bool
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 genCondJump lbl bool
-  = getCondCode bool               `thenUs` \ condition ->
+  = getCondCode bool               `thenNat` \ condition ->
     let
        code   = condCode condition
        cond   = condName condition
        target = ImmCLbl lbl
     in
     let
        code   = condCode condition
        cond   = condName condition
        target = ImmCLbl lbl
     in
-    returnSeq code (
-    if condFloat condition then
-       [NOP, BF cond False target, NOP]
-    else
-       [BI cond False target, NOP]
+    returnNat (
+       code `appOL` 
+       toOL (
+         if   condFloat condition 
+         then [NOP, BF cond False target, NOP]
+         else [BI cond False target, NOP]
+       )
     )
 
 #endif {- sparc_TARGET_ARCH -}
     )
 
 #endif {- sparc_TARGET_ARCH -}
@@ -2153,16 +2273,16 @@ genCCall
     -> CallConv
     -> PrimRep         -- type of the result
     -> [StixTree]      -- arguments (of mixed type)
     -> CallConv
     -> PrimRep         -- type of the result
     -> [StixTree]      -- arguments (of mixed type)
-    -> UniqSM InstrBlock
+    -> NatM InstrBlock
 
 #if alpha_TARGET_ARCH
 
 genCCall fn cconv kind args
 
 #if alpha_TARGET_ARCH
 
 genCCall fn cconv kind args
-  = mapAccumLUs get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
-                                   `thenUs` \ ((unused,_), argCode) ->
+  = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
+                         `thenNat` \ ((unused,_), argCode) ->
     let
        nRegs = length allArgRegs - length unused
     let
        nRegs = length allArgRegs - length unused
-       code = asmParThen (map ($ asmVoid) argCode)
+       code = asmSeqThen (map ($ []) argCode)
     in
        returnSeq code [
            LDA pv (AddrImm (ImmLab (ptext fn))),
     in
        returnSeq code [
            LDA pv (AddrImm (ImmLab (ptext fn))),
@@ -2179,24 +2299,24 @@ genCCall fn cconv kind args
        registers to be assigned for this call and the next stack
        offset to use for overflowing arguments.  This way,
        @get_Arg@ can be applied to all of a call's arguments using
        registers to be assigned for this call and the next stack
        offset to use for overflowing arguments.  This way,
        @get_Arg@ can be applied to all of a call's arguments using
-       @mapAccumLUs@.
+       @mapAccumLNat@.
     -}
     get_arg
        :: ([(Reg,Reg)], Int)   -- Argument registers and stack offset (accumulator)
        -> StixTree             -- Current argument
     -}
     get_arg
        :: ([(Reg,Reg)], Int)   -- Argument registers and stack offset (accumulator)
        -> StixTree             -- Current argument
-       -> UniqSM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code
+       -> NatM (([(Reg,Reg)],Int), InstrBlock) -- Updated accumulator and code
 
     -- We have to use up all of our argument registers first...
 
     get_arg ((iDst,fDst):dsts, offset) arg
 
     -- We have to use up all of our argument registers first...
 
     get_arg ((iDst,fDst):dsts, offset) arg
-      = getRegister arg                            `thenUs` \ register ->
+      = getRegister arg                            `thenNat` \ register ->
        let
            reg  = if isFloatingRep pk then fDst else iDst
            code = registerCode register reg
            src  = registerName register reg
            pk   = registerRep register
        in
        let
            reg  = if isFloatingRep pk then fDst else iDst
            code = registerCode register reg
            src  = registerName register reg
            pk   = registerRep register
        in
-       returnUs (
+       returnNat (
            if isFloatingRep pk then
                ((dsts, offset), if isFixed register then
                    code . mkSeqInstr (FMOV src fDst)
            if isFloatingRep pk then
                ((dsts, offset), if isFixed register then
                    code . mkSeqInstr (FMOV src fDst)
@@ -2210,16 +2330,16 @@ genCCall fn cconv kind args
     -- stack...
 
     get_arg ([], offset) arg
     -- stack...
 
     get_arg ([], offset) arg
-      = getRegister arg                        `thenUs` \ register ->
+      = getRegister arg                        `thenNat` \ register ->
        getNewRegNCG (registerRep register)
        getNewRegNCG (registerRep register)
-                                       `thenUs` \ tmp ->
+                                       `thenNat` \ tmp ->
        let
            code = registerCode register tmp
            src  = registerName register tmp
            pk   = registerRep register
            sz   = primRepToSize pk
        in
        let
            code = registerCode register tmp
            src  = registerName register tmp
            pk   = registerRep register
            sz   = primRepToSize pk
        in
-       returnUs (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
+       returnNat (([], offset + 1), code . mkSeqInstr (ST sz src (spRel offset)))
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -2227,24 +2347,31 @@ genCCall fn cconv kind args
 
 genCCall fn cconv kind [StInt i]
   | fn == SLIT ("PerformGC_wrapper")
 
 genCCall fn cconv kind [StInt i]
   | fn == SLIT ("PerformGC_wrapper")
-  = let call = [MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
-               CALL (ImmLit (ptext (if   underscorePrefix 
-                                     then (SLIT ("_PerformGC_wrapper"))
-                                     else (SLIT ("PerformGC_wrapper")))))]
+  = let call = toOL [
+                  MOV L (OpImm (ImmInt (fromInteger i))) (OpReg eax),
+                 CALL (ImmLit (ptext (if   underscorePrefix 
+                                       then (SLIT ("_PerformGC_wrapper"))
+                                       else (SLIT ("PerformGC_wrapper")))))
+               ]
     in
     in
-    returnInstrs call
+    returnNat call
 
 
 genCCall fn cconv kind args
 
 
 genCCall fn cconv kind args
-  = get_call_args args `thenUs` \ (tot_arg_size, argCode) ->
-    let
-       code2 = asmParThen (map ($ asmVoid) argCode)
-       call = [SUB L (OpImm (ImmInt tot_arg_size)) (OpReg esp),
-                CALL fn__2 ,
-               ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp)
+  = mapNat get_call_arg
+           (reverse args)  `thenNat` \ sizes_n_codes ->
+    getDeltaNat            `thenNat` \ delta ->
+    let (sizes, codes) = unzip sizes_n_codes
+        tot_arg_size   = sum sizes
+       code2          = concatOL codes
+       call = toOL [
+                  CALL fn__2,
+                 ADD L (OpImm (ImmInt tot_arg_size)) (OpReg esp),
+                  DELTA (delta + tot_arg_size)
                ]
     in
                ]
     in
-    returnSeq code2 call
+    setDeltaNat (delta + tot_arg_size) `thenNat` \ _ ->
+    returnNat (code2 `appOL` call)
 
   where
     -- function names that begin with '.' are assumed to be special
 
   where
     -- function names that begin with '.' are assumed to be special
@@ -2253,79 +2380,76 @@ genCCall fn cconv kind args
     -- ToDo:needed (WDP 96/03) ???
     fn__2 = case (_HEAD_ fn) of
              '.' -> ImmLit (ptext fn)
     -- ToDo:needed (WDP 96/03) ???
     fn__2 = case (_HEAD_ fn) of
              '.' -> ImmLit (ptext fn)
-             _   -> ImmLab (ptext fn)
+             _   -> ImmLab False (ptext fn)
 
     arg_size DF = 8
     arg_size F  = 8
     arg_size _  = 4
 
     ------------
 
     arg_size DF = 8
     arg_size F  = 8
     arg_size _  = 4
 
     ------------
-    -- do get_call_arg on each arg, threading the total arg size along
-    -- process the args right-to-left
-    get_call_args :: [StixTree] -> UniqSM (Int, [InstrBlock])
-    get_call_args args
-       = f 0 args
-         where
-            f curr_sz [] 
-               = returnUs (curr_sz, [])
-            f curr_sz (arg:args)             
-               = f curr_sz args          `thenUs` \ (new_sz, iblocks) ->
-                 get_call_arg arg new_sz `thenUs` \ (new_sz2, iblock) ->
-                 returnUs (new_sz2, iblock:iblocks)
-
-
-    ------------
     get_call_arg :: StixTree{-current argument-}
     get_call_arg :: StixTree{-current argument-}
-                    -> Int{-running total of arg sizes seen so far-}
-                    -> UniqSM (Int, InstrBlock)  -- updated tot argsz, code
-
-    get_call_arg arg old_sz
-      = get_op arg             `thenUs` \ (code, reg, sz) ->
-        let new_sz = old_sz + arg_size sz
-        in  if   (case sz of DF -> True; F -> True; _ -> False)
-            then returnUs (new_sz,
-                           code .
-                           mkSeqInstr (GST DF reg
-                                              (AddrBaseIndex (Just esp) 
-                                                  Nothing (ImmInt (- new_sz))))
-                          )
-           else returnUs (new_sz,
-                           code . 
-                           mkSeqInstr (MOV L (OpReg reg)
-                                             (OpAddr 
-                                                 (AddrBaseIndex (Just esp) 
-                                                    Nothing (ImmInt (- new_sz)))))
-                          )
+                    -> NatM (Int, InstrBlock)  -- argsz, code
+
+    get_call_arg arg
+      = get_op arg               `thenNat` \ (code, reg, sz) ->
+        getDeltaNat               `thenNat` \ delta ->
+        arg_size sz               `bind`    \ size ->
+        setDeltaNat (delta-size)  `thenNat` \ _ ->
+        if   (case sz of DF -> True; F -> True; _ -> False)
+        then returnNat (size,
+                        code `appOL`
+                        toOL [SUB L (OpImm (ImmInt 8)) (OpReg esp),
+                              DELTA (delta-size),
+                              GST DF reg (AddrBaseIndex (Just esp) 
+                                                        Nothing 
+                                                        (ImmInt 0))]
+                       )
+        else returnNat (size,
+                        code `snocOL`
+                        PUSH L (OpReg reg) `snocOL`
+                        DELTA (delta-size)
+                       )
     ------------
     get_op
        :: StixTree
     ------------
     get_op
        :: StixTree
-       -> UniqSM (InstrBlock, Reg, Size) -- code, reg, size
+       -> NatM (InstrBlock, Reg, Size) -- code, reg, size
 
     get_op op
 
     get_op op
-      = getRegister op         `thenUs` \ register ->
+      = getRegister op         `thenNat` \ register ->
        getNewRegNCG (registerRep register)
        getNewRegNCG (registerRep register)
-                               `thenUs` \ tmp ->
+                               `thenNat` \ tmp ->
        let
            code = registerCode register tmp
            reg  = registerName register tmp
            pk   = registerRep  register
            sz   = primRepToSize pk
        in
        let
            code = registerCode register tmp
            reg  = registerName register tmp
            pk   = registerRep  register
            sz   = primRepToSize pk
        in
-       returnUs (code, reg, sz)
+       returnNat (code, reg, sz)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
-
 genCCall fn cconv kind args
 genCCall fn cconv kind args
-  = mapAccumLUs get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
-                                   `thenUs` \ ((unused,_), argCode) ->
+  = mapAccumLNat get_arg (allArgRegs, eXTRA_STK_ARGS_HERE) args
+                         `thenNat` \ ((unused,_), argCode) ->
     let
     let
+
        nRegs = length allArgRegs - length unused
        nRegs = length allArgRegs - length unused
-       call = CALL fn__2 nRegs False
-       code = asmParThen (map ($ asmVoid) argCode)
-    in
-       returnSeq code [call, NOP]
+       call = unitOL (CALL fn__2 nRegs False)
+       code = concatOL argCode
+
+        -- 3 because in the worst case, %o0 .. %o5 will only use up 3 args
+        (move_sp_down, move_sp_up)
+           = let nn = length args - 3 
+             in  if   nn <= 0
+                 then (nilOL, nilOL)
+                 else (unitOL (moveSp (-(2*nn))), unitOL (moveSp (2*nn)))
+    in
+       returnNat (move_sp_down `appOL` 
+                   code         `appOL` 
+                   call         `appOL` 
+                   unitOL NOP   `appOL`
+                   move_sp_up)
   where
     -- function names that begin with '.' are assumed to be special
     -- internally generated names like '.mul,' which don't get an
   where
     -- function names that begin with '.' are assumed to be special
     -- internally generated names like '.mul,' which don't get an
@@ -2333,7 +2457,7 @@ genCCall fn cconv kind args
     -- ToDo:needed (WDP 96/03) ???
     fn__2 = case (_HEAD_ fn) of
              '.' -> ImmLit (ptext fn)
     -- ToDo:needed (WDP 96/03) ???
     fn__2 = case (_HEAD_ fn) of
              '.' -> ImmLit (ptext fn)
-             _   -> ImmLab (ptext fn)
+             _   -> ImmLab False (ptext fn)
 
     ------------------------------------
     {-  Try to get a value into a specific register (or registers) for
 
     ------------------------------------
     {-  Try to get a value into a specific register (or registers) for
@@ -2346,50 +2470,68 @@ genCCall fn cconv kind args
        offset to use for overflowing arguments.  This way,
        @get_arg@ can be applied to all of a call's arguments using
        @mapAccumL@.
        offset to use for overflowing arguments.  This way,
        @get_arg@ can be applied to all of a call's arguments using
        @mapAccumL@.
+
+        If we have to put args on the stack, move %o6==%sp down by
+        8 x the number of args, to ensure there's enough space.
     -}
     get_arg
        :: ([Reg],Int)  -- Argument registers and stack offset (accumulator)
        -> StixTree     -- Current argument
     -}
     get_arg
        :: ([Reg],Int)  -- Argument registers and stack offset (accumulator)
        -> StixTree     -- Current argument
-       -> UniqSM (([Reg],Int), InstrBlock) -- Updated accumulator and code
+       -> NatM (([Reg],Int), InstrBlock) -- Updated accumulator and code
 
     -- We have to use up all of our argument registers first...
 
     get_arg (dst:dsts, offset) arg
 
     -- We have to use up all of our argument registers first...
 
     get_arg (dst:dsts, offset) arg
-      = getRegister arg                        `thenUs` \ register ->
+      = getRegister arg                        `thenNat` \ register ->
        getNewRegNCG (registerRep register)
        getNewRegNCG (registerRep register)
-                                       `thenUs` \ tmp ->
+                                       `thenNat` \ tmp ->
        let
            reg  = if isFloatingRep pk then tmp else dst
            code = registerCode register reg
            src  = registerName register reg
            pk   = registerRep register
        in
        let
            reg  = if isFloatingRep pk then tmp else dst
            code = registerCode register reg
            src  = registerName register reg
            pk   = registerRep register
        in
-       returnUs (case pk of
+       returnNat (
+         case pk of
            DoubleRep ->
                case dsts of
            DoubleRep ->
                case dsts of
-                   [] -> (([], offset + 1), code . mkSeqInstrs [
-                           -- conveniently put the second part in the right stack
-                           -- location, and load the first part into %o5
-                           ST DF src (spRel (offset - 1)),
-                           LD W (spRel (offset - 1)) dst])
-                   (dst__2:dsts__2) -> ((dsts__2, offset), code . mkSeqInstrs [
-                           ST DF src (spRel (-2)),
-                           LD W (spRel (-2)) dst,
-                           LD W (spRel (-1)) dst__2])
-           FloatRep -> ((dsts, offset), code . mkSeqInstrs [
-                           ST F src (spRel (-2)),
-                           LD W (spRel (-2)) dst])
-           _ -> ((dsts, offset), if isFixed register then
-                                 code . mkSeqInstr (OR False g0 (RIReg src) dst)
-                                 else code))
-
+                  [] -> ( ([], offset + 1), 
+                            code `snocOL`
+                           -- put the second part in the right stack
+                           -- and load the first part into %o5
+                            FMOV DF src f0             `snocOL`
+                           ST   F  f0 (spRel offset)  `snocOL`
+                            LD   W  (spRel offset) dst `snocOL`
+                            ST   F  (fPair f0) (spRel offset)
+                         )
+                  (dst__2:dsts__2) 
+                       -> ( (dsts__2, offset), 
+                            code                          `snocOL`
+                            FMOV DF src f0                `snocOL`
+                            ST   F  f0 (spRel 16)         `snocOL`
+                            LD   W  (spRel 16) dst        `snocOL`
+                            ST   F  (fPair f0) (spRel 16) `snocOL`
+                            LD   W  (spRel 16) dst__2
+                          )
+           FloatRep 
+               -> ( (dsts, offset), 
+                    code `snocOL`
+                   ST F src (spRel 16) `snocOL`
+                   LD W (spRel 16) dst
+                  )
+           _  -> ( (dsts, offset), 
+                    if   isFixed register 
+                    then code `snocOL` OR False g0 (RIReg src) dst
+                   else code
+                  )
+        )
     -- Once we have run out of argument registers, we move to the
     -- stack...
 
     get_arg ([], offset) arg
     -- Once we have run out of argument registers, we move to the
     -- stack...
 
     get_arg ([], offset) arg
-      = getRegister arg                        `thenUs` \ register ->
+      = getRegister arg                        `thenNat` \ register ->
        getNewRegNCG (registerRep register)
        getNewRegNCG (registerRep register)
-                                       `thenUs` \ tmp ->
+                                       `thenNat` \ tmp ->
        let
            code  = registerCode register tmp
            src   = registerName register tmp
        let
            code  = registerCode register tmp
            src   = registerName register tmp
@@ -2397,7 +2539,8 @@ genCCall fn cconv kind args
            sz    = primRepToSize pk
            words = if pk == DoubleRep then 2 else 1
        in
            sz    = primRepToSize pk
            words = if pk == DoubleRep then 2 else 1
        in
-       returnUs (([], offset + words), code . mkSeqInstr (ST sz src (spRel offset)))
+       returnNat ( ([], offset + words), 
+                    code `snocOL` ST sz src (spRel offset) )
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -2421,7 +2564,7 @@ the right hand side of an assignment).
 register allocator.
 
 \begin{code}
 register allocator.
 
 \begin{code}
-condIntReg, condFltReg :: Cond -> StixTree -> StixTree -> UniqSM Register
+condIntReg, condFltReg :: Cond -> StixTree -> StixTree -> NatM Register
 
 #if alpha_TARGET_ARCH
 condIntReg = panic "MachCode.condIntReg (not on Alpha)"
 
 #if alpha_TARGET_ARCH
 condIntReg = panic "MachCode.condIntReg (not on Alpha)"
@@ -2432,30 +2575,26 @@ condFltReg = panic "MachCode.condFltReg (not on Alpha)"
 #if i386_TARGET_ARCH
 
 condIntReg cond x y
 #if i386_TARGET_ARCH
 
 condIntReg cond x y
-  = condIntCode cond x y       `thenUs` \ condition ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
-    --getRegister dst          `thenUs` \ register ->
+  = condIntCode cond x y       `thenNat` \ condition ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
     let
-       --code2 = registerCode register tmp asmVoid
-       --dst__2  = registerName register tmp
        code = condCode condition
        cond = condName condition
        code = condCode condition
        cond = condName condition
-       -- ToDo: if dst is eax, ebx, ecx, or edx we would not need the move.
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            SETCC cond (OpReg tmp),
            AND L (OpImm (ImmInt 1)) (OpReg tmp),
            MOV L (OpReg tmp) (OpReg dst)]
     in
            SETCC cond (OpReg tmp),
            AND L (OpImm (ImmInt 1)) (OpReg tmp),
            MOV L (OpReg tmp) (OpReg dst)]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 condFltReg cond x y
 
 condFltReg cond x y
-  = getUniqLabelNCG            `thenUs` \ lbl1 ->
-    getUniqLabelNCG            `thenUs` \ lbl2 ->
-    condFltCode cond x y       `thenUs` \ condition ->
+  = getNatLabelNCG             `thenNat` \ lbl1 ->
+    getNatLabelNCG             `thenNat` \ lbl2 ->
+    condFltCode cond x y       `thenNat` \ condition ->
     let
        code = condCode condition
        cond = condName condition
     let
        code = condCode condition
        cond = condName condition
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            JXX cond lbl1,
            MOV L (OpImm (ImmInt 0)) (OpReg dst),
            JXX ALWAYS lbl2,
            JXX cond lbl1,
            MOV L (OpImm (ImmInt 0)) (OpReg dst),
            JXX ALWAYS lbl2,
@@ -2463,78 +2602,78 @@ condFltReg cond x y
            MOV L (OpImm (ImmInt 1)) (OpReg dst),
            LABEL lbl2]
     in
            MOV L (OpImm (ImmInt 1)) (OpReg dst),
            LABEL lbl2]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 condIntReg EQQ x (StInt 0)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 condIntReg EQQ x (StInt 0)
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
     let
        code = registerCode register tmp
        src  = registerName register tmp
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            SUB False True g0 (RIReg src) g0,
            SUB True False g0 (RIImm (ImmInt (-1))) dst]
     in
            SUB False True g0 (RIReg src) g0,
            SUB True False g0 (RIImm (ImmInt (-1))) dst]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 condIntReg EQQ x y
 
 condIntReg EQQ x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
        src2  = registerName register2 tmp2
-       code__2 dst = asmParThen [code1, code2] . mkSeqInstrs [
+       code__2 dst = code1 `appOL` code2 `appOL` toOL [
            XOR False src1 (RIReg src2) dst,
            SUB False True g0 (RIReg dst) g0,
            SUB True False g0 (RIImm (ImmInt (-1))) dst]
     in
            XOR False src1 (RIReg src2) dst,
            SUB False True g0 (RIReg dst) g0,
            SUB True False g0 (RIImm (ImmInt (-1))) dst]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 condIntReg NE x (StInt 0)
 
 condIntReg NE x (StInt 0)
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep        `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep        `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
     let
        code = registerCode register tmp
        src  = registerName register tmp
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            SUB False True g0 (RIReg src) g0,
            ADD True False g0 (RIImm (ImmInt 0)) dst]
     in
            SUB False True g0 (RIReg src) g0,
            ADD True False g0 (RIImm (ImmInt 0)) dst]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 condIntReg NE x y
 
 condIntReg NE x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
        src2  = registerName register2 tmp2
-       code__2 dst = asmParThen [code1, code2] . mkSeqInstrs [
+       code__2 dst = code1 `appOL` code2 `appOL` toOL [
            XOR False src1 (RIReg src2) dst,
            SUB False True g0 (RIReg dst) g0,
            ADD True False g0 (RIImm (ImmInt 0)) dst]
     in
            XOR False src1 (RIReg src2) dst,
            SUB False True g0 (RIReg dst) g0,
            ADD True False g0 (RIImm (ImmInt 0)) dst]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 condIntReg cond x y
 
 condIntReg cond x y
-  = getUniqLabelNCG            `thenUs` \ lbl1 ->
-    getUniqLabelNCG            `thenUs` \ lbl2 ->
-    condIntCode cond x y       `thenUs` \ condition ->
+  = getNatLabelNCG             `thenNat` \ lbl1 ->
+    getNatLabelNCG             `thenNat` \ lbl2 ->
+    condIntCode cond x y       `thenNat` \ condition ->
     let
        code = condCode condition
        cond = condName condition
     let
        code = condCode condition
        cond = condName condition
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            BI cond False (ImmCLbl lbl1), NOP,
            OR False g0 (RIImm (ImmInt 0)) dst,
            BI ALWAYS False (ImmCLbl lbl2), NOP,
            BI cond False (ImmCLbl lbl1), NOP,
            OR False g0 (RIImm (ImmInt 0)) dst,
            BI ALWAYS False (ImmCLbl lbl2), NOP,
@@ -2542,16 +2681,16 @@ condIntReg cond x y
            OR False g0 (RIImm (ImmInt 1)) dst,
            LABEL lbl2]
     in
            OR False g0 (RIImm (ImmInt 1)) dst,
            LABEL lbl2]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 condFltReg cond x y
 
 condFltReg cond x y
-  = getUniqLabelNCG            `thenUs` \ lbl1 ->
-    getUniqLabelNCG            `thenUs` \ lbl2 ->
-    condFltCode cond x y       `thenUs` \ condition ->
+  = getNatLabelNCG             `thenNat` \ lbl1 ->
+    getNatLabelNCG             `thenNat` \ lbl2 ->
+    condFltCode cond x y       `thenNat` \ condition ->
     let
        code = condCode condition
        cond = condName condition
     let
        code = condCode condition
        cond = condName condition
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            NOP,
            BF cond False (ImmCLbl lbl1), NOP,
            OR False g0 (RIImm (ImmInt 0)) dst,
            NOP,
            BF cond False (ImmCLbl lbl1), NOP,
            OR False g0 (RIImm (ImmInt 0)) dst,
@@ -2560,7 +2699,7 @@ condFltReg cond x y
            OR False g0 (RIImm (ImmInt 1)) dst,
            LABEL lbl2]
     in
            OR False g0 (RIImm (ImmInt 1)) dst,
            LABEL lbl2]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -2583,11 +2722,12 @@ have handled the constant-folding.
 \begin{code}
 trivialCode
     :: IF_ARCH_alpha((Reg -> RI -> Reg -> Instr)
 \begin{code}
 trivialCode
     :: IF_ARCH_alpha((Reg -> RI -> Reg -> Instr)
-      ,IF_ARCH_i386 ((Operand -> Operand -> Instr)
+      ,IF_ARCH_i386 ((Operand -> Operand -> Instr) 
+                     -> Maybe (Operand -> Operand -> Instr)
       ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr)
       ,)))
     -> StixTree -> StixTree -- the two arguments
       ,IF_ARCH_sparc((Reg -> RI -> Reg -> Instr)
       ,)))
     -> StixTree -> StixTree -- the two arguments
-    -> UniqSM Register
+    -> NatM Register
 
 trivialFCode
     :: PrimRep
 
 trivialFCode
     :: PrimRep
@@ -2596,7 +2736,7 @@ trivialFCode
       ,IF_ARCH_i386 ((Size -> Reg -> Reg -> Reg -> Instr)
       ,)))
     -> StixTree -> StixTree -- the two arguments
       ,IF_ARCH_i386 ((Size -> Reg -> Reg -> Reg -> Instr)
       ,)))
     -> StixTree -> StixTree -- the two arguments
-    -> UniqSM Register
+    -> NatM Register
 
 trivialUCode
     :: IF_ARCH_alpha((RI -> Reg -> Instr)
 
 trivialUCode
     :: IF_ARCH_alpha((RI -> Reg -> Instr)
@@ -2604,7 +2744,7 @@ trivialUCode
       ,IF_ARCH_sparc((RI -> Reg -> Instr)
       ,)))
     -> StixTree        -- the one argument
       ,IF_ARCH_sparc((RI -> Reg -> Instr)
       ,)))
     -> StixTree        -- the one argument
-    -> UniqSM Register
+    -> NatM Register
 
 trivialUFCode
     :: PrimRep
 
 trivialUFCode
     :: PrimRep
@@ -2613,54 +2753,54 @@ trivialUFCode
       ,IF_ARCH_sparc((Reg -> Reg -> Instr)
       ,)))
     -> StixTree -- the one argument
       ,IF_ARCH_sparc((Reg -> Reg -> Instr)
       ,)))
     -> StixTree -- the one argument
-    -> UniqSM Register
+    -> NatM Register
 
 #if alpha_TARGET_ARCH
 
 trivialCode instr x (StInt y)
   | fits8Bits y
 
 #if alpha_TARGET_ARCH
 
 trivialCode instr x (StInt y)
   | fits8Bits y
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src1 = registerName register tmp
        src2 = ImmInt (fromInteger y)
        code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
     in
     let
        code = registerCode register tmp
        src1 = registerName register tmp
        src2 = ImmInt (fromInteger y)
        code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 trivialCode instr x y
 
 trivialCode instr x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1 []
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2 []
        src2  = registerName register2 tmp2
        src2  = registerName register2 tmp2
-       code__2 dst = asmParThen [code1, code2] .
+       code__2 dst = asmSeqThen [code1, code2] .
                     mkSeqInstr (instr src1 (RIReg src2) dst)
     in
                     mkSeqInstr (instr src1 (RIReg src2) dst)
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 ------------
 trivialUCode instr x
 
 ------------
 trivialUCode instr x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
        code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
     in
     let
        code = registerCode register tmp
        src  = registerName register tmp
        code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 ------------
 trivialFCode _ instr x y
 
 ------------
 trivialFCode _ instr x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp1 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp1 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp2 ->
     let
        code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
     let
        code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
@@ -2668,82 +2808,165 @@ trivialFCode _ instr x y
        code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
 
        code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
 
-       code__2 dst = asmParThen [code1 asmVoid, code2 asmVoid] .
+       code__2 dst = asmSeqThen [code1 [], code2 []] .
                      mkSeqInstr (instr src1 src2 dst)
     in
                      mkSeqInstr (instr src1 src2 dst)
     in
-    returnUs (Any DoubleRep code__2)
+    returnNat (Any DoubleRep code__2)
 
 trivialUFCode _ instr x
 
 trivialUFCode _ instr x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
        code__2 dst = code . mkSeqInstr (instr src dst)
     in
     let
        code = registerCode register tmp
        src  = registerName register tmp
        code__2 dst = code . mkSeqInstr (instr src dst)
     in
-    returnUs (Any DoubleRep code__2)
+    returnNat (Any DoubleRep code__2)
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
+\end{code}
+The Rules of the Game are:
 
 
-trivialCode instr x y
-  | maybeToBool imm
-  = getRegister x              `thenUs` \ register1 ->
-    let
-       code__2 dst = let code1 = registerCode register1 dst
-                         src1  = registerName register1 dst
-                     in code1 .
-                        if isFixed register1 && src1 /= dst
-                        then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
-                                          instr (OpImm imm__2) (OpReg dst)]
-                        else
-                               mkSeqInstrs [instr (OpImm imm__2) (OpReg src1)]
-    in
-    returnUs (Any IntRep code__2)
-  where
-    imm = maybeImm y
-    imm__2 = case imm of Just x -> x
+* You cannot assume anything about the destination register dst;
+  it may be anything, including a fixed reg.
+
+* You may compute an operand into a fixed reg, but you may not 
+  subsequently change the contents of that fixed reg.  If you
+  want to do so, first copy the value either to a temporary
+  or into dst.  You are free to modify dst even if it happens
+  to be a fixed reg -- that's not your problem.
+
+* You cannot assume that a fixed reg will stay live over an
+  arbitrary computation.  The same applies to the dst reg.
+
+* Temporary regs obtained from getNewRegNCG are distinct from 
+  each other and from all other regs, and stay live over 
+  arbitrary computations.
+
+\begin{code}
+
+trivialCode instr maybe_revinstr a b
+
+  | is_imm_b
+  = getRegister a                         `thenNat` \ rega ->
+    let mkcode dst
+          = if   isAny rega 
+            then registerCode rega dst      `bind` \ code_a ->
+                 code_a `snocOL`
+                 instr (OpImm imm_b) (OpReg dst)
+            else registerCodeF rega         `bind` \ code_a ->
+                 registerNameF rega         `bind` \ r_a ->
+                 code_a `snocOL`
+                 MOV L (OpReg r_a) (OpReg dst) `snocOL`
+                 instr (OpImm imm_b) (OpReg dst)
+    in
+    returnNat (Any IntRep mkcode)
+              
+  | is_imm_a
+  = getRegister b                         `thenNat` \ regb ->
+    getNewRegNCG IntRep                   `thenNat` \ tmp ->
+    let revinstr_avail = maybeToBool maybe_revinstr
+        revinstr       = case maybe_revinstr of Just ri -> ri
+        mkcode dst
+          | revinstr_avail
+          = if   isAny regb
+            then registerCode regb dst      `bind` \ code_b ->
+                 code_b `snocOL`
+                 revinstr (OpImm imm_a) (OpReg dst)
+            else registerCodeF regb         `bind` \ code_b ->
+                 registerNameF regb         `bind` \ r_b ->
+                 code_b `snocOL`
+                 MOV L (OpReg r_b) (OpReg dst) `snocOL`
+                 revinstr (OpImm imm_a) (OpReg dst)
+          
+          | otherwise
+          = if   isAny regb
+            then registerCode regb tmp      `bind` \ code_b ->
+                 code_b `snocOL`
+                 MOV L (OpImm imm_a) (OpReg dst) `snocOL`
+                 instr (OpReg tmp) (OpReg dst)
+            else registerCodeF regb         `bind` \ code_b ->
+                 registerNameF regb         `bind` \ r_b ->
+                 code_b `snocOL`
+                 MOV L (OpReg r_b) (OpReg tmp) `snocOL`
+                 MOV L (OpImm imm_a) (OpReg dst) `snocOL`
+                 instr (OpReg tmp) (OpReg dst)
+    in
+    returnNat (Any IntRep mkcode)
+
+  | otherwise
+  = getRegister a                         `thenNat` \ rega ->
+    getRegister b                         `thenNat` \ regb ->
+    getNewRegNCG IntRep                   `thenNat` \ tmp ->
+    let mkcode dst
+          = case (isAny rega, isAny regb) of
+              (True, True) 
+                 -> registerCode regb tmp   `bind` \ code_b ->
+                    registerCode rega dst   `bind` \ code_a ->
+                    code_b `appOL`
+                    code_a `snocOL`
+                    instr (OpReg tmp) (OpReg dst)
+              (True, False)
+                 -> registerCode  rega tmp  `bind` \ code_a ->
+                    registerCodeF regb      `bind` \ code_b ->
+                    registerNameF regb      `bind` \ r_b ->
+                    code_a `appOL`
+                    code_b `snocOL`
+                    instr (OpReg r_b) (OpReg tmp) `snocOL`
+                    MOV L (OpReg tmp) (OpReg dst)
+              (False, True)
+                 -> registerCode  regb tmp  `bind` \ code_b ->
+                    registerCodeF rega      `bind` \ code_a ->
+                    registerNameF rega      `bind` \ r_a ->
+                    code_b `appOL`
+                    code_a `snocOL`
+                    MOV L (OpReg r_a) (OpReg dst) `snocOL`
+                    instr (OpReg tmp) (OpReg dst)
+              (False, False)
+                 -> registerCodeF  rega     `bind` \ code_a ->
+                    registerNameF  rega     `bind` \ r_a ->
+                    registerCodeF  regb     `bind` \ code_b ->
+                    registerNameF  regb     `bind` \ r_b ->
+                    code_a `snocOL`
+                    MOV L (OpReg r_a) (OpReg tmp) `appOL`
+                    code_b `snocOL`
+                    instr (OpReg r_b) (OpReg tmp) `snocOL`
+                    MOV L (OpReg tmp) (OpReg dst)
+    in
+    returnNat (Any IntRep mkcode)
+
+    where
+       maybe_imm_a = maybeImm a
+       is_imm_a    = maybeToBool maybe_imm_a
+       imm_a       = case maybe_imm_a of Just imm -> imm
+
+       maybe_imm_b = maybeImm b
+       is_imm_b    = maybeToBool maybe_imm_b
+       imm_b       = case maybe_imm_b of Just imm -> imm
 
 
-trivialCode instr x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
-    let
-       code2 = registerCode register2 tmp2 asmVoid
-       src2  = registerName register2 tmp2
-       code__2 dst = let
-                         code1 = registerCode register1 dst asmVoid
-                         src1  = registerName register1 dst
-                     in asmParThen [code1, code2] .
-                        if isFixed register1 && src1 /= dst
-                        then mkSeqInstrs [MOV L (OpReg src1) (OpReg dst),
-                                          instr (OpReg src2)  (OpReg dst)]
-                        else
-                               mkSeqInstr (instr (OpReg src2) (OpReg src1))
-    in
-    returnUs (Any IntRep code__2)
 
 -----------
 trivialUCode instr x
 
 -----------
 trivialUCode instr x
-  = getRegister x              `thenUs` \ register ->
+  = getRegister x              `thenNat` \ register ->
     let
     let
-       code__2 dst = let
-                         code = registerCode register dst
+       code__2 dst = let code = registerCode register dst
                          src  = registerName register dst
                          src  = registerName register dst
-                     in code . if isFixed register && dst /= src
-                               then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
-                                                 instr (OpReg dst)]
-                               else mkSeqInstr (instr (OpReg src))
+                     in code `appOL`
+                         if   isFixed register && dst /= src
+                        then toOL [MOV L (OpReg src) (OpReg dst),
+                                   instr (OpReg dst)]
+                        else unitOL (instr (OpReg src))
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 -----------
 trivialFCode pk instr x y
 
 -----------
 trivialFCode pk instr x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp1 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp1 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp2 ->
     let
        code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
     let
        code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
@@ -2751,22 +2974,33 @@ trivialFCode pk instr x y
        code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
 
        code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
 
-       code__2 dst = asmParThen [code1 asmVoid, code2 asmVoid] .
-                     mkSeqInstr (instr (primRepToSize pk) src1 src2 dst)
+       code__2 dst
+           -- treat the common case specially: both operands in
+           -- non-fixed regs.
+           | isAny register1 && isAny register2
+           = code1 `appOL` 
+             code2 `snocOL`
+            instr (primRepToSize pk) src1 src2 dst
+
+           -- be paranoid (and inefficient)
+           | otherwise
+           = code1 `snocOL` GMOV src1 tmp1  `appOL`
+             code2 `snocOL`
+             instr (primRepToSize pk) tmp1 src2 dst
     in
     in
-    returnUs (Any DoubleRep code__2)
+    returnNat (Any DoubleRep code__2)
 
 
 -------------
 trivialUFCode pk instr x
 
 
 -------------
 trivialUFCode pk instr x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG pk            `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG pk            `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
     let
        code = registerCode register tmp
        src  = registerName register tmp
-       code__2 dst = code . mkSeqInstr (instr src dst)
+       code__2 dst = code `snocOL` instr src dst
     in
     in
-    returnUs (Any pk code__2)
+    returnNat (Any pk code__2)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -2774,42 +3008,42 @@ trivialUFCode pk instr x
 
 trivialCode instr x (StInt y)
   | fits13Bits y
 
 trivialCode instr x (StInt y)
   | fits13Bits y
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src1 = registerName register tmp
        src2 = ImmInt (fromInteger y)
     let
        code = registerCode register tmp
        src1 = registerName register tmp
        src2 = ImmInt (fromInteger y)
-       code__2 dst = code . mkSeqInstr (instr src1 (RIImm src2) dst)
+       code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 trivialCode instr x y
 
 trivialCode instr x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp1 ->
-    getNewRegNCG IntRep                `thenUs` \ tmp2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp1 ->
+    getNewRegNCG IntRep                `thenNat` \ tmp2 ->
     let
     let
-       code1 = registerCode register1 tmp1 asmVoid
+       code1 = registerCode register1 tmp1
        src1  = registerName register1 tmp1
        src1  = registerName register1 tmp1
-       code2 = registerCode register2 tmp2 asmVoid
+       code2 = registerCode register2 tmp2
        src2  = registerName register2 tmp2
        src2  = registerName register2 tmp2
-       code__2 dst = asmParThen [code1, code2] .
-                    mkSeqInstr (instr src1 (RIReg src2) dst)
+       code__2 dst = code1 `appOL` code2 `snocOL`
+                     instr src1 (RIReg src2) dst
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 ------------
 trivialFCode pk instr x y
 
 ------------
 trivialFCode pk instr x y
-  = getRegister x              `thenUs` \ register1 ->
-    getRegister y              `thenUs` \ register2 ->
+  = getRegister x              `thenNat` \ register1 ->
+    getRegister y              `thenNat` \ register2 ->
     getNewRegNCG (registerRep register1)
     getNewRegNCG (registerRep register1)
-                               `thenUs` \ tmp1 ->
+                               `thenNat` \ tmp1 ->
     getNewRegNCG (registerRep register2)
     getNewRegNCG (registerRep register2)
-                               `thenUs` \ tmp2 ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp ->
+                               `thenNat` \ tmp2 ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp ->
     let
     let
-       promote x = asmInstr (FxTOy F DF x tmp)
+       promote x = FxTOy F DF x tmp
 
        pk1   = registerRep register1
        code1 = registerCode register1 tmp1
 
        pk1   = registerRep register1
        code1 = registerCode register1 tmp1
@@ -2821,38 +3055,38 @@ trivialFCode pk instr x y
 
        code__2 dst =
                if pk1 == pk2 then
 
        code__2 dst =
                if pk1 == pk2 then
-                   asmParThen [code1 asmVoid, code2 asmVoid] .
-                   mkSeqInstr (instr (primRepToSize pk) src1 src2 dst)
+                   code1 `appOL` code2 `snocOL`
+                   instr (primRepToSize pk) src1 src2 dst
                else if pk1 == FloatRep then
                else if pk1 == FloatRep then
-                   asmParThen [code1 (promote src1), code2 asmVoid] .
-                   mkSeqInstr (instr DF tmp src2 dst)
+                   code1 `snocOL` promote src1 `appOL` code2 `snocOL`
+                   instr DF tmp src2 dst
                else
                else
-                   asmParThen [code1 asmVoid, code2 (promote src2)] .
-                   mkSeqInstr (instr DF src1 tmp dst)
+                   code1 `appOL` code2 `snocOL` promote src2 `snocOL`
+                   instr DF src1 tmp dst
     in
     in
-    returnUs (Any (if pk1 == pk2 then pk1 else DoubleRep) code__2)
+    returnNat (Any (if pk1 == pk2 then pk1 else DoubleRep) code__2)
 
 ------------
 trivialUCode instr x
 
 ------------
 trivialUCode instr x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
     let
        code = registerCode register tmp
        src  = registerName register tmp
-       code__2 dst = code . mkSeqInstr (instr (RIReg src) dst)
+       code__2 dst = code `snocOL` instr (RIReg src) dst
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 -------------
 trivialUFCode pk instr x
 
 -------------
 trivialUFCode pk instr x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG pk            `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG pk            `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
     let
        code = registerCode register tmp
        src  = registerName register tmp
-       code__2 dst = code . mkSeqInstr (instr src dst)
+       code__2 dst = code `snocOL` instr src dst
     in
     in
-    returnUs (Any pk code__2)
+    returnNat (Any pk code__2)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -2872,15 +3106,15 @@ conversions.  We have to store temporaries in memory to move
 between the integer and the floating point register sets.
 
 \begin{code}
 between the integer and the floating point register sets.
 
 \begin{code}
-coerceIntCode :: PrimRep -> StixTree -> UniqSM Register
-coerceFltCode ::           StixTree -> UniqSM Register
+coerceIntCode :: PrimRep -> StixTree -> NatM Register
+coerceFltCode ::           StixTree -> NatM Register
 
 
-coerceInt2FP :: PrimRep -> StixTree -> UniqSM Register
-coerceFP2Int ::           StixTree -> UniqSM Register
+coerceInt2FP :: PrimRep -> StixTree -> NatM Register
+coerceFP2Int ::           StixTree -> NatM Register
 
 coerceIntCode pk x
 
 coerceIntCode pk x
-  = getRegister x              `thenUs` \ register ->
-    returnUs (
+  = getRegister x              `thenNat` \ register ->
+    returnNat (
     case register of
        Fixed _ reg code -> Fixed pk reg code
        Any   _ code     -> Any   pk code
     case register of
        Fixed _ reg code -> Fixed pk reg code
        Any   _ code     -> Any   pk code
@@ -2888,8 +3122,8 @@ coerceIntCode pk x
 
 -------------
 coerceFltCode x
 
 -------------
 coerceFltCode x
-  = getRegister x              `thenUs` \ register ->
-    returnUs (
+  = getRegister x              `thenNat` \ register ->
+    returnNat (
     case register of
        Fixed _ reg code -> Fixed DoubleRep reg code
        Any   _ code     -> Any   DoubleRep code
     case register of
        Fixed _ reg code -> Fixed DoubleRep reg code
        Any   _ code     -> Any   DoubleRep code
@@ -2900,8 +3134,8 @@ coerceFltCode x
 #if alpha_TARGET_ARCH
 
 coerceInt2FP _ x
 #if alpha_TARGET_ARCH
 
 coerceInt2FP _ x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ reg ->
     let
        code = registerCode register reg
        src  = registerName register reg
     let
        code = registerCode register reg
        src  = registerName register reg
@@ -2911,12 +3145,12 @@ coerceInt2FP _ x
            LD TF dst (spRel 0),
            CVTxy Q TF dst dst]
     in
            LD TF dst (spRel 0),
            CVTxy Q TF dst dst]
     in
-    returnUs (Any DoubleRep code__2)
+    returnNat (Any DoubleRep code__2)
 
 -------------
 coerceFP2Int x
 
 -------------
 coerceFP2Int x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
     let
        code = registerCode register tmp
        src  = registerName register tmp
@@ -2926,73 +3160,71 @@ coerceFP2Int x
            ST TF tmp (spRel 0),
            LD Q dst (spRel 0)]
     in
            ST TF tmp (spRel 0),
            LD Q dst (spRel 0)]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 coerceInt2FP pk x
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 coerceInt2FP pk x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ reg ->
     let
        code = registerCode register reg
        src  = registerName register reg
         opc  = case pk of FloatRep -> GITOF ; DoubleRep -> GITOD
     let
        code = registerCode register reg
        src  = registerName register reg
         opc  = case pk of FloatRep -> GITOF ; DoubleRep -> GITOD
-        code__2 dst = code . 
-                      mkSeqInstr (opc src dst)
+        code__2 dst = code `snocOL` opc src dst
     in
     in
-    returnUs (Any pk code__2)
+    returnNat (Any pk code__2)
 
 ------------
 coerceFP2Int x
 
 ------------
 coerceFP2Int x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG DoubleRep     `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG DoubleRep     `thenNat` \ tmp ->
     let
        code = registerCode register tmp
        src  = registerName register tmp
        pk   = registerRep register
 
         opc  = case pk of FloatRep -> GFTOI ; DoubleRep -> GDTOI
     let
        code = registerCode register tmp
        src  = registerName register tmp
        pk   = registerRep register
 
         opc  = case pk of FloatRep -> GFTOI ; DoubleRep -> GDTOI
-        code__2 dst = code . 
-                      mkSeqInstr (opc src dst)
+        code__2 dst = code `snocOL` opc src dst
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 coerceInt2FP pk x
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 coerceInt2FP pk x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ reg ->
     let
        code = registerCode register reg
        src  = registerName register reg
 
     let
        code = registerCode register reg
        src  = registerName register reg
 
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            ST W src (spRel (-2)),
            LD W (spRel (-2)) dst,
            FxTOy W (primRepToSize pk) dst dst]
     in
            ST W src (spRel (-2)),
            LD W (spRel (-2)) dst,
            FxTOy W (primRepToSize pk) dst dst]
     in
-    returnUs (Any pk code__2)
+    returnNat (Any pk code__2)
 
 ------------
 coerceFP2Int x
 
 ------------
 coerceFP2Int x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
-    getNewRegNCG FloatRep      `thenUs` \ tmp ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ reg ->
+    getNewRegNCG FloatRep      `thenNat` \ tmp ->
     let
        code = registerCode register reg
        src  = registerName register reg
        pk   = registerRep  register
 
     let
        code = registerCode register reg
        src  = registerName register reg
        pk   = registerRep  register
 
-       code__2 dst = code . mkSeqInstrs [
+       code__2 dst = code `appOL` toOL [
            FxTOy (primRepToSize pk) W src tmp,
            ST W tmp (spRel (-2)),
            LD W (spRel (-2)) dst]
     in
            FxTOy (primRepToSize pk) W src tmp,
            ST W tmp (spRel (-2)),
            LD W (spRel (-2)) dst]
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
@@ -3007,67 +3239,67 @@ Integer to character conversion.  Where applicable, we try to do this
 in one step if the original object is in memory.
 
 \begin{code}
 in one step if the original object is in memory.
 
 \begin{code}
-chrCode :: StixTree -> UniqSM Register
+chrCode :: StixTree -> NatM Register
 
 #if alpha_TARGET_ARCH
 
 chrCode x
 
 #if alpha_TARGET_ARCH
 
 chrCode x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ reg ->
     let
        code = registerCode register reg
        src  = registerName register reg
        code__2 dst = code . mkSeqInstr (ZAPNOT src (RIImm (ImmInt 1)) dst)
     in
     let
        code = registerCode register reg
        src  = registerName register reg
        code__2 dst = code . mkSeqInstr (ZAPNOT src (RIImm (ImmInt 1)) dst)
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 chrCode x
 
 #endif {- alpha_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if i386_TARGET_ARCH
 
 chrCode x
-  = getRegister x              `thenUs` \ register ->
+  = getRegister x              `thenNat` \ register ->
     let
        code__2 dst = let
                          code = registerCode register dst
                          src  = registerName register dst
     let
        code__2 dst = let
                          code = registerCode register dst
                          src  = registerName register dst
-                     in code .
-                        if isFixed register && src /= dst
-                        then mkSeqInstrs [MOV L (OpReg src) (OpReg dst),
-                                          AND L (OpImm (ImmInt 255)) (OpReg dst)]
-                        else mkSeqInstr (AND L (OpImm (ImmInt 255)) (OpReg src))
+                     in code `appOL`
+                        if   isFixed register && src /= dst
+                        then toOL [MOV L (OpReg src) (OpReg dst),
+                                   AND L (OpImm (ImmInt 255)) (OpReg dst)]
+                        else unitOL (AND L (OpImm (ImmInt 255)) (OpReg src))
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 chrCode (StInd pk mem)
 
 #endif {- i386_TARGET_ARCH -}
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 #if sparc_TARGET_ARCH
 
 chrCode (StInd pk mem)
-  = getAmode mem               `thenUs` \ amode ->
+  = getAmode mem               `thenNat` \ amode ->
     let
        code    = amodeCode amode
        src     = amodeAddr amode
        src_off = addrOffset src 3
        src__2  = case src_off of Just x -> x
        code__2 dst = if maybeToBool src_off then
     let
        code    = amodeCode amode
        src     = amodeAddr amode
        src_off = addrOffset src 3
        src__2  = case src_off of Just x -> x
        code__2 dst = if maybeToBool src_off then
-                       code . mkSeqInstr (LD BU src__2 dst)
+                       code `snocOL` LD BU src__2 dst
                    else
                    else
-                       code . mkSeqInstrs [
-                           LD (primRepToSize pk) src dst,
-                           AND False dst (RIImm (ImmInt 255)) dst]
+                       code `snocOL`
+                       LD (primRepToSize pk) src dst  `snocOL`
+                       AND False dst (RIImm (ImmInt 255)) dst
     in
     in
-    returnUs (Any pk code__2)
+    returnNat (Any pk code__2)
 
 chrCode x
 
 chrCode x
-  = getRegister x              `thenUs` \ register ->
-    getNewRegNCG IntRep                `thenUs` \ reg ->
+  = getRegister x              `thenNat` \ register ->
+    getNewRegNCG IntRep                `thenNat` \ reg ->
     let
        code = registerCode register reg
        src  = registerName register reg
     let
        code = registerCode register reg
        src  = registerName register reg
-       code__2 dst = code . mkSeqInstr (AND False src (RIImm (ImmInt 255)) dst)
+       code__2 dst = code `snocOL` AND False src (RIImm (ImmInt 255)) dst
     in
     in
-    returnUs (Any IntRep code__2)
+    returnNat (Any IntRep code__2)
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}
 
 #endif {- sparc_TARGET_ARCH -}
 \end{code}