Allow packing constructor fields

This is another step for fixing #13825 and is based on D38 by Simon
Marlow.

The change allows storing multiple constructor fields within the same
word. This currently applies only to `Float`s, e.g.,
```
data Foo = Foo {-# UNPACK #-} !Float {-# UNPACK #-} !Float
```
on 64-bit arch, will now store both fields within the same constructor
word. For `WordX/IntX` we'll need to introduce new primop types.

Main changes:

- We now use sizes in bytes when we compute the offsets for
  constructor fields in `StgCmmLayout` and introduce padding if
  necessary (word-sized fields are still word-aligned)

- `ByteCodeGen` had to be updated to correctly construct the data
  types. This required some new bytecode instructions to allow pushing
  things that are not full words onto the stack (and updating
  `Interpreter.c`). Note that we only use the packed stuff when
  constructing data types (i.e., for `PACK`), in all other cases the
  behavior should not change.

- `RtClosureInspect` was changed to handle the new layout when
  extracting subterms. This seems to be used by things like `:print`.
  I've also added a test for this.

- I deviated slightly from Simon's approach and use `PrimRep` instead
  of `ArgRep` for computing the size of fields.  This seemed more
  natural and in the future we'll probably want to introduce new
  primitive types (e.g., `Int8#`) and `PrimRep` seems like a better
  place to do that (where we already have `Int64Rep` for example).
  `ArgRep` on the other hand seems to be more focused on calling
  functions.

Signed-off-by: Michal Terepeta <michal.terepeta@gmail.com>

Test Plan: ./validate

Reviewers: bgamari, simonmar, austin, hvr, goldfire, erikd

Reviewed By: bgamari

Subscribers: maoe, rwbarton, thomie

GHC Trac Issues: #13825

Differential Revision: https://phabricator.haskell.org/D3809

2 files changed, 126 insertions, 2 deletions

diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index e133e3a6ff..8c84e13ef3 100644
--- a/rts/Disassembler.c
+++ b/rts/Disassembler.c
@@ -94,11 +94,28 @@ disInstr ( StgBCO *bco, int pc )
          debugBelch("PUSH_LLL %d %d %d\n", instrs[pc], instrs[pc+1],
                                                             instrs[pc+2] );
          pc += 3; break;
+      case bci_PUSH8:
+         debugBelch("PUSH8    %d\n", instrs[pc] );
+         pc += 1; break;
+      case bci_PUSH16:
+         debugBelch("PUSH16   %d\n", instrs[pc] );
+         pc += 1; break;
+      case bci_PUSH32:
+         debugBelch("PUSH32   %d\n", instrs[pc] );
+         pc += 1; break;
+      case bci_PUSH8_W:
+         debugBelch("PUSH8_W  %d\n", instrs[pc] );
+         pc += 1; break;
+      case bci_PUSH16_W:
+         debugBelch("PUSH16_W %d\n", instrs[pc] );
+         pc += 1; break;
+      case bci_PUSH32_W:
+         debugBelch("PUSH32_W %d\n", instrs[pc] );
+         pc += 1; break;
       case bci_PUSH_G:
          debugBelch("PUSH_G   " ); printPtr( ptrs[instrs[pc]] );
          debugBelch("\n" );
          pc += 1; break;
-
       case bci_PUSH_ALTS:
          debugBelch("PUSH_ALTS  " ); printPtr( ptrs[instrs[pc]] );
          debugBelch("\n");
@@ -127,7 +144,33 @@ disInstr ( StgBCO *bco, int pc )
          debugBelch("PUSH_ALTS_V  " ); printPtr( ptrs[instrs[pc]] );
          debugBelch("\n");
          pc += 1; break;
-
+      case bci_PUSH_PAD8:
+         debugBelch("PUSH_PAD8\n");
+         pc += 1; break;
+      case bci_PUSH_PAD16:
+         debugBelch("PUSH_PAD16\n");
+         pc += 1; break;
+      case bci_PUSH_PAD32:
+         debugBelch("PUSH_PAD32\n");
+         pc += 1; break;
+      case bci_PUSH_UBX8:
+         debugBelch(
+             "PUSH_UBX8 0x%" FMT_Word8 " ",
+             (StgWord8) literals[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_UBX16:
+         debugBelch(
+             "PUSH_UBX16 0x%" FMT_Word16 " ",
+             (StgWord16) literals[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
+      case bci_PUSH_UBX32:
+         debugBelch(
+             "PUSH_UBX32 0x%" FMT_Word32 " ",
+             (StgWord32) literals[instrs[pc]] );
+         debugBelch("\n");
+         pc += 1; break;
       case bci_PUSH_UBX:
          debugBelch("PUSH_UBX ");
          for (i = 0; i < instrs[pc+1]; i++)
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 165511b24c..0e80593d07 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -1181,6 +1181,48 @@ run_BCO:
             goto nextInsn;
         }
 
+        case bci_PUSH8: {
+            int off = BCO_NEXT;
+            Sp_subB(1);
+            *(StgWord8*)Sp = *(StgWord8*)(Sp_plusB(off+1));
+            goto nextInsn;
+        }
+
+        case bci_PUSH16: {
+            int off = BCO_NEXT;
+            Sp_subB(2);
+            *(StgWord16*)Sp = *(StgWord16*)(Sp_plusB(off+2));
+            goto nextInsn;
+        }
+
+        case bci_PUSH32: {
+            int off = BCO_NEXT;
+            Sp_subB(4);
+            *(StgWord32*)Sp = *(StgWord32*)(Sp_plusB(off+4));
+            goto nextInsn;
+        }
+
+        case bci_PUSH8_W: {
+            int off = BCO_NEXT;
+            *(StgWord*)(Sp_minusW(1)) = *(StgWord8*)(Sp_plusB(off));
+            Sp_subW(1);
+            goto nextInsn;
+        }
+
+        case bci_PUSH16_W: {
+            int off = BCO_NEXT;
+            *(StgWord*)(Sp_minusW(1)) = *(StgWord16*)(Sp_plusB(off));
+            Sp_subW(1);
+            goto nextInsn;
+        }
+
+        case bci_PUSH32_W: {
+            int off = BCO_NEXT;
+            *(StgWord*)(Sp_minusW(1)) = *(StgWord32*)(Sp_plusB(off));
+            Sp_subW(1);
+            goto nextInsn;
+        }
+
         case bci_PUSH_G: {
             int o1 = BCO_GET_LARGE_ARG;
             SpW(-1) = BCO_PTR(o1);
@@ -1313,6 +1355,45 @@ run_BCO:
             Sp_subW(1); SpW(0) = (W_)&stg_ap_pppppp_info;
             goto nextInsn;
 
+        case bci_PUSH_PAD8: {
+            Sp_subB(1);
+            *(StgWord8*)Sp = 0;
+            goto nextInsn;
+        }
+
+        case bci_PUSH_PAD16: {
+            Sp_subB(2);
+            *(StgWord16*)Sp = 0;
+            goto nextInsn;
+        }
+
+        case bci_PUSH_PAD32: {
+            Sp_subB(4);
+            *(StgWord32*)Sp = 0;
+            goto nextInsn;
+        }
+
+        case bci_PUSH_UBX8: {
+            int o_lit = BCO_GET_LARGE_ARG;
+            Sp_subB(1);
+            *(StgWord8*)Sp = *(StgWord8*)(literals+o_lit);
+            goto nextInsn;
+        }
+
+        case bci_PUSH_UBX16: {
+            int o_lit = BCO_GET_LARGE_ARG;
+            Sp_subB(2);
+            *(StgWord16*)Sp = *(StgWord16*)(literals+o_lit);
+            goto nextInsn;
+        }
+
+        case bci_PUSH_UBX32: {
+            int o_lit = BCO_GET_LARGE_ARG;
+            Sp_subB(4);
+            *(StgWord32*)Sp = *(StgWord32*)(literals+o_lit);
+            goto nextInsn;
+        }
+
         case bci_PUSH_UBX: {
             int i;
             int o_lits = BCO_GET_LARGE_ARG;