Added tests for Cmm and CPS (they are currently skipped)

Also the test driver doesn't understand 'cmm' files
so something will have to be written before these tests
can even run.

testsuite/tests/ghc-regress/cps/all.T

+# Leave these off until the CPS pass is finished and integrated.
+#
+# These tests are not in their final format yet, but they provide
+# a starting point.
+
+test('cmm001', skip, compile, ['-O -fasm -ddump-cps-cmm'])
+test('cmm002', skip, compile, ['-fasm -ddump-cps-cmm'])
+
+test('cps001', skip, compile, ['-ddump-cps-cmm'])
+test('cps002', skip, compile, ['-ddump-cps-cmm'])
+test('cps003', skip, compile, ['-ddump-cps-cmm'])
+test('cps004', skip, compile, ['-ddump-cps-cmm'])
+test('cps005', skip, compile, ['-ddump-cps-cmm'])
+test('cps006', skip, compile, ['-ddump-cps-cmm'])
+test('cps007', skip, compile, ['-ddump-cps-cmm'])
+test('cps008', skip, compile, ['-ddump-cps-cmm'])
+test('cps009', skip, compile, ['-ddump-cps-cmm'])
+test('cps010', skip, compile, ['-ddump-cps-cmm'])
+test('cps011', skip, compile, ['-ddump-cps-cmm'])
+test('cps012', skip, compile, ['-ddump-cps-cmm'])
+test('cps013', skip, compile, ['-ddump-cps-cmm'])
+test('cps014', skip, compile, ['-ddump-cps-cmm'])
+test('cps015', skip, compile, ['-ddump-cps-cmm'])
+test('cps016', skip, compile, ['-ddump-cps-cmm'])
+test('cps017', skip, compile, ['-ddump-cps-cmm'])
+test('cps018', skip, compile, ['-ddump-cps-cmm'])
+test('cps019', skip, compile, ['-ddump-cps-cmm'])
+test('cps020', skip, compile, ['-ddump-cps-cmm'])
+test('cps021', skip, compile, ['-ddump-cps-cmm'])
+test('cps022', skip, compile, ['-ddump-cps-cmm'])
+test('cps023', skip, compile, ['-ddump-cps-cmm'])
+test('cps024', skip, compile, ['-ddump-cps-cmm'])
+test('cps025', skip, compile, ['-ddump-cps-cmm'])
+test('cps026', skip, compile, ['-ddump-cps-cmm'])
+

testsuite/tests/ghc-regress/cps/cmm001.cmm

+// This puts GHC into an infinite loop(!) when -O is on
+
+foo {
+ L: goto L;
+}

testsuite/tests/ghc-regress/cps/cmm002.cmm

+// Reduced cps012.cmm to the key part that makes it crash
+// in RegisterAlloc.joinToTargets
+
+stg_ap_0_fast {
+    bits32 y, x;
+    c7: y = bits32[x];
+        goto c7;
+}

testsuite/tests/ghc-regress/cps/cps001.cmm

+// Basic function with a call
+
+foo1 {
+  bits32 x;
+ B:
+  foreign "C--" bar() "safe";
+  x = 3;
+  goto B;
+}

testsuite/tests/ghc-regress/cps/cps002.cmm

+// Basic function with a call
+
+foo1 {
+ B:
+  foreign "C--" bar() "safe";
+  goto B;
+}

testsuite/tests/ghc-regress/cps/cps003.cmm

+// Basic function with a heap check
+// The GC block should only be one instruction
+// (or rather it should be after assignment optimizations)
+
+foo1 {
+  bits32 r;
+ B:
+  (r) = foreign "C--" bar() "safe";
+ L:
+  if (Hp > HpLim) {
+    (r) = foreign "C--" stg_gc_ret_p(r) "safe";
+    goto L;
+  }
+  return (r);
+}

testsuite/tests/ghc-regress/cps/cps004.cmm

+// Test basic function parameters and return values
+
+foo2 (bits16 a, bits16 b, "ptr" bits16 c) {
+  bits32 x, y;
+  x = R1;
+  (y) = foreign "C--" bar(x) "safe";
+  goto L;
+ L:
+  foreign "C--" baz(x) "safe";
+  //jump 12;
+  goto M;
+ M:
+  return (12);
+  //goto L;
+  //goto L;
+}
+

testsuite/tests/ghc-regress/cps/cps005.cmm

+// Basic test of return
+
+foo3 {
+  foreign "C--" glap() "safe";
+  return (12);
+}
+

testsuite/tests/ghc-regress/cps/cps006.cmm

+// Basic test of return with extra block
+
+foo4{
+B:
+   foreign "C--" palg() "safe";
+   return (14);
+}

testsuite/tests/ghc-regress/cps/cps007.cmm

+// Test that empty functions stay empty (and stay alive)
+
+foo5 {
+}

testsuite/tests/ghc-regress/cps/cps008.cmm

+// Test basic general case for heap check
+
+foo6_gc_slow {
+  if (Hp + 5 > HpLim) {
+    foreign "C--" do_gc_gen() "safe";
+    jump foo6_gc_slow(1, 2, 3);
+  }
+  return (7);
+}

testsuite/tests/ghc-regress/cps/cps009.cmm

+// Test basic stack check
+
+foo6_gc_slow("ptr" bits32 f) goto GC {
+  return (7);
+GC:
+  jump stg_gc_fun_v(f);
+}

testsuite/tests/ghc-regress/cps/cps010.cmm

+// Test general stack check
+// Note, the GC block shouldn't trigger the stack limit
+
+foo6_gc_slow("ptr" bits32 f, bits32 x) goto GC {
+  return (7);
+GC:
+  foreign "C--" stg_gc_gen() "safe";
+  jump foo6_gc_slow(f, x);
+}

testsuite/tests/ghc-regress/cps/cps011.cmm

+// Yet another basic function
+
+foo7 {
+  bits32 x;
+  (x) = foreign "C--" get_time() "safe";
+  return (x);
+}

testsuite/tests/ghc-regress/cps/cps012.cmm

+// A real world example from the RTS
+// Should be checked later to see if it is right
+
+stg_ap_0_fast ("ptr" bits32 fun, "ptr" bits32 arg) {
+    bits32 _c8;
+    c6: goto c7;
+    c7: _c8 = bits32[x]; // TODO: allow I32 or print bits32
+        switch [0 .. 71] (bits16[_c8 - 4]) {
+            case 0,1,2,3,4,5,6,7,8 : { goto c9; }
+            case 9,10,11,12,13,14,15 : { goto ca; }
+            case 16,17,18,19,20,21,22,23 : { goto c9; }
+            case 24 : {goto ca;}
+            case 25 : {goto c9;}
+            case 26 : {goto ca;}
+            case 27 : {goto c9;}
+            case 28,29,30,31,32 : {goto cb;}
+            case 33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71 : {goto c9;}
+        }
+    c9: jump _c8 ();
+    cb: R1 = bits32[fun + 4 + 0];
+        goto c7;
+    ca: jump (bits32[arg + 0 * 4]) ();
+}

testsuite/tests/ghc-regress/cps/cps013.cmm

+// Test the calling conventions
+
+// Test the default calling convention
+// which is "unsafe" but will change soon to "safe"
+foo1() {
+  foreign "C--" bar(x, y);
+  return (1);
+}
+
+// Test the "unsafe" calling convention
+foo2() {
+  foreign "C--" bar(x, y) "unsafe";
+  return (1);
+}
+
+// Test the "safe" calling convention
+foo3() {
+  bits32 x, y, z;
+  foreign "C--" bar(x, y, z) "safe";
+  return (1);
+}

testsuite/tests/ghc-regress/cps/cps014.cmm

+// Test explicit continuations.
+
+// Note, we might want to check about suffix on foo2 (i.e. "_entry").
+// I'm not sure that that is right.
+
+foo1 (bits32 update) jump foo2(update) {
+  bits32 x;
+  return (x);
+}
+
+INFO_TABLE_RET (foo2, 0, bits32 update) (bits32 x) {
+  bits32[update] = x;
+  return (x);
+}

testsuite/tests/ghc-regress/cps/cps015.cmm

+// Test whether a stack check is performed even when
+// the existing stack due to on-stack arguments is big enough.
+
+// With space for a return address
+foo1 (bits32 x, bits32 y) goto GC {
+  foreign "C--" bar(x) "safe";
+  return (1);
+GC:
+  return (1);
+}
+
+// No space needed for a return address
+foo2 (bits32 x, bits32 y) goto GC {
+  jump bar(x, y);
+GC:
+  return (1);
+}

testsuite/tests/ghc-regress/cps/cps016.cmm

+// Test whether extra proc-points are generated
+// by a label after a call such as with a heap check.
+
+foo1 () {
+  bits32 p, q;
+  bits32 x, y, z;
+  (p, q) = foreign "C--" bar(1, 2) "safe";
+L:
+  if (Hp < HpLim) {
+    (p, q) = foreign "C--" do_gc() "safe";
+    goto L;
+  }
+  return (p+q+x+y+z);
+}

testsuite/tests/ghc-regress/cps/cps017.cmm

+// Test whether extra proc-points are generated
+// by a label after a call such as with a heap check,
+// but where the return signature is different.
+// The extra proc-point should be generated in this case.
+
+foo1 () {
+  bits32 p, q;
+  bits32 x, y, z;
+  (p, q) = foreign "C--" bar(1, 2) "safe";
+L:
+  if (Hp < HpLim) {
+    (p) = foreign "C--" do_gc() "safe";
+    goto L;
+  }
+  return (p+q+x+y+z);
+}