diff --git a/testsuite/tests/cmm/should_run/machops/Makefile b/testsuite/tests/cmm/should_run/machops/Makefile new file mode 100644 index 0000000000000000000000000000000000000000..1c39d1c1fed04f14cab76d17579c1e97343590f0 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/Makefile @@ -0,0 +1,3 @@ +TOP=../../../.. +include $(TOP)/mk/boilerplate.mk +include $(TOP)/mk/test.mk diff --git a/testsuite/tests/cmm/should_run/machops/T20626a.cmm b/testsuite/tests/cmm/should_run/machops/T20626a.cmm new file mode 100644 index 0000000000000000000000000000000000000000..0544e73dd3d9e4167233ef9dc78003775321b670 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20626a.cmm @@ -0,0 +1,3 @@ +test(bits64 buffer) { + return (%zx64(%shra(242::bits8, 1))); +} diff --git a/testsuite/tests/cmm/should_run/machops/T20626a.stdout b/testsuite/tests/cmm/should_run/machops/T20626a.stdout new file mode 100644 index 0000000000000000000000000000000000000000..720fe955f1892233d6eff5149c06582508931924 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20626a.stdout @@ -0,0 +1 @@ +249 diff --git a/testsuite/tests/cmm/should_run/machops/T20626b.cmm b/testsuite/tests/cmm/should_run/machops/T20626b.cmm new file mode 100644 index 0000000000000000000000000000000000000000..e54b2e1691dcd28d71537b4169640ea15c2c600e --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20626b.cmm @@ -0,0 +1,4 @@ +test(bits64 buffer) { + return (%sx64((~(bits32[buffer])) >> (31::bits64))); +} + diff --git a/testsuite/tests/cmm/should_run/machops/T20626b.stdout b/testsuite/tests/cmm/should_run/machops/T20626b.stdout new file mode 100644 index 0000000000000000000000000000000000000000..d00491fd7e5bb6fa28c517a0bb32b8b506539d4d --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20626b.stdout @@ -0,0 +1 @@ +1 diff --git a/testsuite/tests/cmm/should_run/machops/T20634.cmm b/testsuite/tests/cmm/should_run/machops/T20634.cmm new file mode 100644 index 0000000000000000000000000000000000000000..c04a86b1c7e37c259264e9d45c51c027dda396e1 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20634.cmm @@ -0,0 +1,11 @@ +test(bits64 buffer) { + bits64 ret; + ret = %zx64(%quot(%lobits8(0x00e1::bits16), 3::bits8)); + // ^^^^^^^^^^^^^^^^^^^^^^ + // == -31 signed + // ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + // == -10 signed + // ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + // == 0xf6 unsigned + return (ret); +} diff --git a/testsuite/tests/cmm/should_run/machops/T20634.stdout b/testsuite/tests/cmm/should_run/machops/T20634.stdout new file mode 100644 index 0000000000000000000000000000000000000000..5d165ff2850935ca781091f7a6163eaae863a4c5 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20634.stdout @@ -0,0 +1 @@ +246 diff --git a/testsuite/tests/cmm/should_run/machops/T20638.cmm b/testsuite/tests/cmm/should_run/machops/T20638.cmm new file mode 100644 index 0000000000000000000000000000000000000000..51fe449a767bd74e75c8c77c20c40c7628d850e8 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20638.cmm @@ -0,0 +1,4 @@ +test(bits64 buffer) { + return (%zx64(%shrl(bits16[buffer + (128 :: bits64)], (1 :: bits64))) & (64711 :: bits64)); +} + diff --git a/testsuite/tests/cmm/should_run/machops/T20638.stdout b/testsuite/tests/cmm/should_run/machops/T20638.stdout new file mode 100644 index 0000000000000000000000000000000000000000..5a54842902527d6f004ccdde6c237a356c953be1 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/T20638.stdout @@ -0,0 +1 @@ +16576 diff --git a/testsuite/tests/cmm/should_run/machops/TestMachOp.hs b/testsuite/tests/cmm/should_run/machops/TestMachOp.hs new file mode 100644 index 0000000000000000000000000000000000000000..08a81e9b63d81e42a4412cc933638099b8917604 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/TestMachOp.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE MagicHash #-} + +-- | This module is the driver for the Cmm machop tests. It expects to be +-- linked with an object file (typically compiled Cmm) exposing a procedure +-- named `test` which' +-- +-- - takes a single pointer argument pointing to a buffer containing +-- [0..bufferSz] (truncated to Word8). +-- +-- - returns a Word# +-- +-- The driver will print the returned result. + +module Main where + +import GHC.Exts +import GHC.Ptr +import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BS + +foreign import prim "test" test :: Addr# -> Word# + +bufferSz :: Int +bufferSz = 1*1024*1024 + +main :: IO () +main = do + let buf = BS.pack $ map fromIntegral [0..bufferSz] + BS.unsafeUseAsCString buf $ \(Ptr p) -> do + print $ W# (test p) + diff --git a/testsuite/tests/cmm/should_run/machops/all.T b/testsuite/tests/cmm/should_run/machops/all.T new file mode 100644 index 0000000000000000000000000000000000000000..faad54a2ce3f6e57b1d4ecb7956c1b70bd3d2a67 --- /dev/null +++ b/testsuite/tests/cmm/should_run/machops/all.T @@ -0,0 +1,10 @@ +setTestOpts(extra_files(['TestMachOp.hs'])) + +def cmm_test(name): + test(name, normal, multi_compile_and_run, + ['TestMachOp', [(name+'.cmm', '')], '']) + +cmm_test('T20626a') +cmm_test('T20626b') +cmm_test('T20638') +cmm_test('T20634')