Produce new-style Cmm from the Cmm parser

The main change here is that the Cmm parser now allows high-level cmm
code with argument-passing and function calls.  For example:

foo ( gcptr a, bits32 b )
{
  if (b > 0) {
     // we can make tail calls passing arguments:
     jump stg_ap_0_fast(a);
  }

  return (x,y);
}

More details on the new cmm syntax are in Note [Syntax of .cmm files]
in CmmParse.y.

The old syntax is still more-or-less supported for those occasional
code fragments that really need to explicitly manipulate the stack.
However there are a couple of differences: it is now obligatory to
give a list of live GlobalRegs on every jump, e.g.

  jump %ENTRY_CODE(Sp(0)) [R1];

Again, more details in Note [Syntax of .cmm files].

I have rewritten most of the .cmm files in the RTS into the new
syntax, except for AutoApply.cmm which is generated by the genapply
program: this file could be generated in the new syntax instead and
would probably be better off for it, but I ran out of enthusiasm.

Some other changes in this batch:

 - The PrimOp calling convention is gone, primops now use the ordinary
   NativeNodeCall convention.  This means that primops and "foreign
   import prim" code must be written in high-level cmm, but they can
   now take more than 10 arguments.

 - CmmSink now does constant-folding (should fix #7219)

 - .cmm files now go through the cmmPipeline, and as a result we
   generate better code in many cases.  All the object files generated
   for the RTS .cmm files are now smaller.  Performance should be
   better too, but I haven't measured it yet.

 - RET_DYN frames are removed from the RTS, lots of code goes away

 - we now have some more canned GC points to cover unboxed-tuples with
   2-4 pointers, which will reduce code size a little.

1 files changed, 25 insertions, 21 deletions

diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index 6aa4d6cbfa..dec6b5d09d 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -155,7 +155,7 @@ type InfoTableContents = ( [CmmLit]	     -- The standard part
 
 mkInfoTableContents :: DynFlags
                     -> CmmInfoTable
-                    -> Maybe StgHalfWord    -- Override default RTS type tag?
+                    -> Maybe Int               -- Override default RTS type tag?
                     -> UniqSM ([RawCmmDecl],             -- Auxiliary top decls
                                InfoTableContents)	-- Info tbl + extra bits
 
@@ -178,22 +178,19 @@ mkInfoTableContents dflags
        ; let
              std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
              rts_tag | Just tag <- mb_rts_tag = tag
-                     | null liveness_data     = rET_SMALL dflags -- Fits in extra_bits
-                     | otherwise              = rET_BIG   dflags -- Does not; extra_bits is
-                                                                 -- a label
+                     | null liveness_data     = rET_SMALL -- Fits in extra_bits
+                     | otherwise              = rET_BIG   -- Does not; extra_bits is
+                                                          -- a label
        ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
 
   | HeapRep _ ptrs nonptrs closure_type <- smrep
-  = do { let layout  = packHalfWordsCLit
-                           dflags
-                           (toStgHalfWord dflags (toInteger ptrs))
-                           (toStgHalfWord dflags (toInteger nonptrs))
+  = do { let layout  = packIntsCLit dflags ptrs nonptrs
        ; (prof_lits, prof_data) <- mkProfLits dflags prof
        ; let (srt_label, srt_bitmap) = mkSRTLit dflags srt
        ; (mb_srt_field, mb_layout, extra_bits, ct_data)
                                 <- mk_pieces closure_type srt_label
        ; let std_info = mkStdInfoTable dflags prof_lits
-                                       (mb_rts_tag   `orElse` rtsClosureType dflags smrep)
+                                       (mb_rts_tag   `orElse` rtsClosureType smrep)
                                        (mb_srt_field `orElse` srt_bitmap)
                                        (mb_layout    `orElse` layout)
        ; return (prof_data ++ ct_data, (std_info, extra_bits)) }
@@ -205,24 +202,25 @@ mkInfoTableContents dflags
                  	, [RawCmmDecl])	     -- Auxiliary data decls 
     mk_pieces (Constr con_tag con_descr) _no_srt    -- A data constructor
       = do { (descr_lit, decl) <- newStringLit con_descr
-      	   ; return (Just con_tag, Nothing, [descr_lit], [decl]) }
+           ; return ( Just (toStgHalfWord dflags (fromIntegral con_tag))
+                    , Nothing, [descr_lit], [decl]) }
 
     mk_pieces Thunk srt_label
       = return (Nothing, Nothing, srt_label, [])
 
     mk_pieces (ThunkSelector offset) _no_srt
-      = return (Just (toStgHalfWord dflags 0), Just (mkWordCLit dflags offset), [], [])
+      = return (Just (toStgHalfWord dflags 0), Just (mkWordCLit dflags (fromIntegral offset)), [], [])
          -- Layout known (one free var); we use the layout field for offset
 
     mk_pieces (Fun arity (ArgSpec fun_type)) srt_label 
-      = do { let extra_bits = packHalfWordsCLit dflags fun_type arity : srt_label
+      = do { let extra_bits = packIntsCLit dflags fun_type arity : srt_label
            ; return (Nothing, Nothing,  extra_bits, []) }
 
     mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
       = do { (liveness_lit, liveness_data) <- mkLivenessBits dflags arg_bits
-           ; let fun_type | null liveness_data = aRG_GEN     dflags
-                          | otherwise          = aRG_GEN_BIG dflags
-                 extra_bits = [ packHalfWordsCLit dflags fun_type arity
+           ; let fun_type | null liveness_data = aRG_GEN
+                          | otherwise          = aRG_GEN_BIG
+                 extra_bits = [ packIntsCLit dflags fun_type arity
                               , srt_lit, liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
       where
@@ -233,9 +231,14 @@ mkInfoTableContents dflags
 
     mk_pieces BlackHole _ = panic "mk_pieces: BlackHole"
 
-
 mkInfoTableContents _ _ _ = panic "mkInfoTableContents"   -- NonInfoTable dealt with earlier
 
+packIntsCLit :: DynFlags -> Int -> Int -> CmmLit
+packIntsCLit dflags a b = packHalfWordsCLit dflags
+                           (toStgHalfWord dflags (fromIntegral a))
+                           (toStgHalfWord dflags (fromIntegral b))
+
+
 mkSRTLit :: DynFlags
          -> C_SRT
          -> ([CmmLit],    -- srt_label, if any
@@ -314,7 +317,7 @@ mkLivenessBits dflags liveness
                  [mkRODataLits bitmap_lbl lits]) }
 
   | otherwise -- Fits in one word
-  = return (mkWordCLit dflags bitmap_word, [])
+  = return (mkStgWordCLit dflags bitmap_word, [])
   where
     n_bits = length liveness
 
@@ -328,7 +331,8 @@ mkLivenessBits dflags liveness
     bitmap_word = toStgWord dflags (fromIntegral n_bits)
               .|. (small_bitmap `shiftL` bITMAP_BITS_SHIFT dflags)
 
-    lits = mkWordCLit dflags (toStgWord dflags (fromIntegral n_bits)) : map (mkWordCLit dflags) bitmap
+    lits = mkWordCLit dflags (fromIntegral n_bits)
+         : map (mkStgWordCLit dflags) bitmap
       -- The first word is the size.  The structure must match
       -- StgLargeBitmap in includes/rts/storage/InfoTable.h
 
@@ -348,8 +352,8 @@ mkLivenessBits dflags liveness
 mkStdInfoTable
    :: DynFlags
    -> (CmmLit,CmmLit)	-- Closure type descr and closure descr  (profiling)
-   -> StgHalfWord	-- Closure RTS tag 
-   -> StgHalfWord	-- SRT length
+   -> Int               -- Closure RTS tag
+   -> StgHalfWord       -- SRT length
    -> CmmLit		-- layout field
    -> [CmmLit]
 
@@ -365,7 +369,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit
 	| dopt Opt_SccProfilingOn dflags = [type_descr, closure_descr]
 	| otherwise = []
 
-    type_lit = packHalfWordsCLit dflags cl_type srt_len
+    type_lit = packHalfWordsCLit dflags (toStgHalfWord dflags (fromIntegral cl_type)) srt_len
 
 -------------------------------------------------------------------------
 --