Add support for sized literals in the bytecode interpreter.

The bytecode interpreter only has branching instructions for
word-sized values. These are used for pattern matching.
Branching instructions for other types (e.g. Int16# or Word8#)
weren't needed, since unoptimized Core or STG never requires
branching on types like this.

It's now possible for optimized STG to reach the bytecode
generator (e.g. fat interface files or certain compiler flag
combinations), which requires dealing with various sized
literals in branches.

This patch improves support for generating bytecode from
optimized STG by adding the following new bytecode
instructions:

    TESTLT_I64
    TESTEQ_I64
    TESTLT_I32
    TESTEQ_I32
    TESTLT_I16
    TESTEQ_I16
    TESTLT_I8
    TESTEQ_I8
    TESTLT_W64
    TESTEQ_W64
    TESTLT_W32
    TESTEQ_W32
    TESTLT_W16
    TESTEQ_W16
    TESTLT_W8
    TESTEQ_W8

Fixes #21945

3 files changed, 303 insertions, 6 deletions

diff --git a/rts/Disassembler.c b/rts/Disassembler.c
index 2abb4e1b8d..ae6d7ac9f7 100644
--- a/rts/Disassembler.c
+++ b/rts/Disassembler.c
@@ -254,26 +254,135 @@ disInstr ( StgBCO *bco, int pc )
           debugBelch("TESTLT_I  %" FMT_Int ", fail to %d\n", literals[discr], failto);
           break;
       }
+
+      case bci_TESTLT_I64: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_I64  %" FMT_Int64 ", fail to %d\n", *((StgInt64*)(literals+discr)), failto);
+          break;
+      }
+
+      case bci_TESTLT_I32: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_I32  %" FMT_Int ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
+      case bci_TESTLT_I16: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_I16  %" FMT_Int ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
+      case bci_TESTLT_I8: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_I8  %" FMT_Int ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
       case bci_TESTEQ_I:
          debugBelch("TESTEQ_I  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
                                                       instrs[pc+1]);
          pc += 2; break;
 
+      case bci_TESTEQ_I64:
+         debugBelch("TESTEQ_I64  %" FMT_Int64 ", fail to %d\n", *((StgInt64*)(literals+instrs[pc])),
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_I32:
+         debugBelch("TESTEQ_I32  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_I16:
+         debugBelch("TESTEQ_I16  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_I8:
+         debugBelch("TESTEQ_I8  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTLT_W: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_W  %" FMT_Word ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
+      case bci_TESTLT_W64: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_W64  %" FMT_Word64 ", fail to %d\n", *((StgWord64*)(literals+discr)), failto);
+          break;
+      }
+
+      case bci_TESTLT_W32: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_W32  %" FMT_Word ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
+      case bci_TESTLT_W16: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_W16  %" FMT_Word ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
+      case bci_TESTLT_W8: {
+          unsigned int discr  = BCO_NEXT;
+          int failto = BCO_GET_LARGE_ARG;
+          debugBelch("TESTLT_W8  %" FMT_Word ", fail to %d\n", literals[discr], failto);
+          break;
+      }
+
+      case bci_TESTEQ_W:
+         debugBelch("TESTEQ_W  %" FMT_Word ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_W64:
+         debugBelch("TESTEQ_W64  %" FMT_Word64 ", fail to %d\n", *((StgWord64*)(literals+instrs[pc])),
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_W32:
+         debugBelch("TESTEQ_W32  %" FMT_Word ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_W16:
+         debugBelch("TESTEQ_W16  %" FMT_Word ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
+      case bci_TESTEQ_W8:
+         debugBelch("TESTEQ_W8  %" FMT_Word ", fail to %d\n", literals[instrs[pc]],
+                                                      instrs[pc+1]);
+         pc += 2; break;
+
       case bci_TESTLT_F:
-         debugBelch("TESTLT_F  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTLT_F  %f, fail to %d\n", *((StgFloat*)literals+instrs[pc]),
                                                       instrs[pc+1]);
          pc += 2; break;
       case bci_TESTEQ_F:
-         debugBelch("TESTEQ_F  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTEQ_F  %f, fail to %d\n", *((StgFloat*)literals+instrs[pc]),
                                                       instrs[pc+1]);
          pc += 2; break;
 
       case bci_TESTLT_D:
-         debugBelch("TESTLT_D  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTLT_D  %f, fail to %d\n", *((StgDouble*)(literals+instrs[pc])),
                                                       instrs[pc+1]);
          pc += 2; break;
       case bci_TESTEQ_D:
-         debugBelch("TESTEQ_D  %" FMT_Int ", fail to %d\n", literals[instrs[pc]],
+         debugBelch("TESTEQ_D  %f, fail to %d\n", *((StgDouble*)(literals+instrs[pc])),
                                                       instrs[pc+1]);
          pc += 2; break;
 
diff --git a/rts/Interpreter.c b/rts/Interpreter.c
index 00aced17f9..1108ca8ed0 100644
--- a/rts/Interpreter.c
+++ b/rts/Interpreter.c
@@ -75,6 +75,8 @@
 
 #define BCO_PTR(n)    (W_)ptrs[n]
 #define BCO_LIT(n)    literals[n]
+#define BCO_LITW64(n) (*(StgWord64*)(literals+n))
+#define BCO_LITI64(n) (*(StgInt64*)(literals+n))
 
 #define LOAD_STACK_POINTERS                                     \
     Sp = cap->r.rCurrentTSO->stackobj->sp;                      \
@@ -1728,6 +1730,46 @@ run_BCO:
             goto nextInsn;
         }
 
+        case bci_TESTLT_I64: {
+            // There should be an Int64 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt64 stackInt = (*(StgInt64*)Sp_plusW(1));
+            if (stackInt >= BCO_LITI64(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
+        case bci_TESTLT_I32: {
+            // There should be an Int32 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt32 stackInt = (*(StgInt32*)Sp_plusW(1));
+            if (stackInt >= (StgInt32)BCO_LIT(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
+        case bci_TESTLT_I16: {
+            // There should be an Int16 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt16 stackInt = (*(StgInt16*)Sp_plusW(1));
+            if (stackInt >= (StgInt16)BCO_LIT(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
+        case bci_TESTLT_I8: {
+            // There should be an Int8 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt8 stackInt = (*(StgInt8*)Sp_plusW(1));
+            if (stackInt >= (StgInt8)BCO_LIT(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
         case bci_TESTEQ_I: {
             // There should be an Int at SpW(1), and an info table at SpW(0).
             int discr   = BCO_GET_LARGE_ARG;
@@ -1739,8 +1781,52 @@ run_BCO:
             goto nextInsn;
         }
 
+        case bci_TESTEQ_I64: {
+            // There should be an Int64 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt64 stackInt = (*(StgInt64*)Sp_plusW(1));
+            if (stackInt != BCO_LITI64(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
+        case bci_TESTEQ_I32: {
+            // There should be an Int32 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt32 stackInt = (*(StgInt32*)Sp_plusW(1));
+            if (stackInt != (StgInt32)BCO_LIT(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
+        case bci_TESTEQ_I16: {
+            // There should be an Int16 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt16 stackInt = (*(StgInt16*)Sp_plusW(1));
+            if (stackInt != (StgInt16)BCO_LIT(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
+        case bci_TESTEQ_I8: {
+            // There should be an Int8 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgInt8 stackInt = (*(StgInt8*)Sp_plusW(1));
+            if (stackInt != (StgInt8)BCO_LIT(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
         case bci_TESTLT_W: {
-            // There should be an Int at SpW(1), and an info table at SpW(0).
+            // There should be a Word at SpW(1), and an info table at SpW(0).
             int discr   = BCO_GET_LARGE_ARG;
             int failto  = BCO_GET_LARGE_ARG;
             W_ stackWord = (W_)SpW(1);
@@ -1749,8 +1835,48 @@ run_BCO:
             goto nextInsn;
         }
 
+        case bci_TESTLT_W64: {
+            // There should be a Word64 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord64 stackWord = (*(StgWord64*)Sp_plusW(1));
+            if (stackWord >= BCO_LITW64(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
+        case bci_TESTLT_W32: {
+            // There should be a Word32 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord32 stackWord = (*(StgWord32*)Sp_plusW(1));
+            if (stackWord >= (StgWord32)BCO_LIT(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
+        case bci_TESTLT_W16: {
+            // There should be a Word16 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord16 stackWord = (*(StgWord16*)Sp_plusW(1));
+            if (stackWord >= (StgWord16)BCO_LIT(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
+        case bci_TESTLT_W8: {
+            // There should be a Word8 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord8 stackWord = (*(StgWord8*)Sp_plusW(1));
+            if (stackWord >= (StgWord8)BCO_LIT(discr))
+                bciPtr = failto;
+            goto nextInsn;
+        }
+
         case bci_TESTEQ_W: {
-            // There should be an Int at SpW(1), and an info table at SpW(0).
+            // There should be a Word at SpW(1), and an info table at SpW(0).
             int discr   = BCO_GET_LARGE_ARG;
             int failto  = BCO_GET_LARGE_ARG;
             W_ stackWord = (W_)SpW(1);
@@ -1760,6 +1886,50 @@ run_BCO:
             goto nextInsn;
         }
 
+        case bci_TESTEQ_W64: {
+            // There should be a Word64 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord64 stackWord = (*(StgWord64*)Sp_plusW(1));
+            if (stackWord != BCO_LITW64(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
+        case bci_TESTEQ_W32: {
+            // There should be a Word32 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord32 stackWord = (*(StgWord32*)Sp_plusW(1));
+            if (stackWord != (StgWord32)BCO_LIT(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
+        case bci_TESTEQ_W16: {
+            // There should be a Word16 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord16 stackWord = (*(StgWord16*)Sp_plusW(1));
+            if (stackWord != (StgWord16)BCO_LIT(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
+        case bci_TESTEQ_W8: {
+            // There should be a Word8 at SpW(1), and an info table at SpW(0).
+            int discr   = BCO_GET_LARGE_ARG;
+            int failto  = BCO_GET_LARGE_ARG;
+            StgWord8 stackWord = (*(StgWord8*)Sp_plusW(1));
+            if (stackWord != (StgWord8)BCO_LIT(discr)) {
+                bciPtr = failto;
+            }
+            goto nextInsn;
+        }
+
         case bci_TESTLT_D: {
             // There should be a Double at SpW(1), and an info table at SpW(0).
             int discr   = BCO_GET_LARGE_ARG;
diff --git a/rts/include/rts/Bytecodes.h b/rts/include/rts/Bytecodes.h
index b97d4d4f60..960fc454ee 100644
--- a/rts/include/rts/Bytecodes.h
+++ b/rts/include/rts/Bytecodes.h
@@ -94,6 +94,24 @@
 
 #define bci_RETURN_T                    69
 #define bci_PUSH_ALTS_T                 70
+
+#define bci_TESTLT_I64                  71
+#define bci_TESTEQ_I64                  72
+#define bci_TESTLT_I32                  73
+#define bci_TESTEQ_I32                  74
+#define bci_TESTLT_I16                  75
+#define bci_TESTEQ_I16                  76
+#define bci_TESTLT_I8                   77
+#define bci_TESTEQ_I8                   78
+#define bci_TESTLT_W64                  79
+#define bci_TESTEQ_W64                  80
+#define bci_TESTLT_W32                  81
+#define bci_TESTEQ_W32                  82
+#define bci_TESTLT_W16                  83
+#define bci_TESTEQ_W16                  84
+#define bci_TESTLT_W8                   85
+#define bci_TESTEQ_W8                   86
+
 /* If you need to go past 255 then you will run into the flags */
 
 /* If you need to go below 0x0100 then you will run into the instructions */