Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • compiler/GHC/HsToCore/Foreign/Wasm.hs
    ... ... @@ -224,6 +224,25 @@ especially since leaving all the boxing/unboxing business to C unifies
    224 224 
     the implementation of JSFFI imports and exports
    225 225 
     (rts_mkJSVal/rts_getJSVal).
    226 226
    227 
    +We don't support unboxed FFI types like Int# etc. But we do support
    228 
    +one kind of unlifted FFI type for JSFFI import arguments:
    229 
    +ByteArray#/MutableByteArray#. The semantics is the same in C: the
    230 
    +pointer to the ByteArray# payload is passed instead of the ByteArray#
    231 
    +closure itself. This allows efficient zero-copy data exchange between
    232 
    +Haskell and JavaScript using unpinned ByteArray#, and the following
    233 
    +conditions must be met:
    234 
    +
    235 
    +- The JSFFI import itself must be a sync import marked as unsafe
    236 
    +- The JavaScript code must not re-enter Haskell when a ByteArray# is
    237 
    +  passed as argument
    238 
    +
    239 
    +There's no magic in the handling of ByteArray#/MutableByteArray#
    240 
    +arguments. When generating C stub, we treat them like Ptr that points
    241 
    +to the payload, just without the rts_getPtr() unboxing call. After
    242 
    +lowering to C import, the backend takes care of adding the offset, see
    243 
    +add_shim in GHC.StgToCmm.Foreign and
    244 
    +Note [Unlifted boxed arguments to foreign calls].
    245 
    +
    227 246 
     Now, each sync import calls a generated C function with a unique
    228 247 
     symbol. The C function uses rts_get* to unbox the arguments, call into
    229 248 
     JavaScript, then boxes the result with rts_mk* and returns it to
    ... ... @@ -517,8 +536,9 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
    517 536 
         cfun_ret
    518 537 
           | res_ty `eqType` unitTy = cfun_call_import <> semi
    519 538 
           | otherwise = text "return" <+> cfun_call_import <> semi
    520 
    -    cfun_make_arg arg_ty arg_val =
    521 
    -      text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
    539 
    +    cfun_make_arg arg_ty arg_val
    540 
    +      | isByteArrayPrimTy arg_ty = arg_val
    541 
    +      | otherwise = text ("rts_get" ++ ffiType arg_ty) <> parens arg_val
    522 542 
         cfun_make_ret ret_val
    523 543 
           | res_ty `eqType` unitTy = ret_val
    524 544 
           | otherwise =
    ... ... @@ -543,7 +563,11 @@ importCStub sync cfun_name arg_tys res_ty js_src = CStub c_doc [] []
    543 563 
           | res_ty `eqType` unitTy = text "void"
    544 564 
           | otherwise = text "HaskellObj"
    545 565 
         cfun_arg_list =
    546 
    -      [text "HaskellObj" <+> char 'a' <> int n | n <- [1 .. length arg_tys]]
    566 
    +      [ text (if isByteArrayPrimTy arg_ty then "HsPtr" else "HaskellObj")
    567 
    +          <+> char 'a'
    568 
    +          <> int n
    569 
    +      | (arg_ty, n) <- zip arg_tys [1 ..]
    570 
    +      ]
    547 571 
         cfun_args = case cfun_arg_list of
    548 572 
           [] -> text "void"
    549 573 
           _ -> hsep $ punctuate comma cfun_arg_list
    ... ... @@ -746,8 +770,18 @@ lookupGhcInternalTyCon m t = do
    746 770 
       n <- lookupOrig (mkGhcInternalModule m) (mkTcOcc t)
    747 771 
       dsLookupTyCon n
    748 772
    773 
    +isByteArrayPrimTy :: Type -> Bool
    774 
    +isByteArrayPrimTy ty
    775 
    +  | Just tc <- tyConAppTyCon_maybe ty,
    776 
    +    tc == byteArrayPrimTyCon || tc == mutableByteArrayPrimTyCon =
    777 
    +      True
    778 
    +  | otherwise =
    779 
    +      False
    780 
    +
    749 781 
     ffiType :: Type -> String
    750 
    -ffiType = occNameString . getOccName . fst . splitTyConApp
    782 
    +ffiType ty
    783 
    +  | isByteArrayPrimTy ty = "Ptr"
    784 
    +  | otherwise = occNameString $ getOccName $ tyConAppTyCon ty
    751 785
    752 786 
     commonCDecls :: SDoc
    753 787 
     commonCDecls =

  • docs/users_guide/wasm.rst
    ... ... @@ -265,7 +265,7 @@ backend’s JavaScript FFI, which we’ll now abbreviate as JSFFI.
    265 265 
     Marshalable types and ``JSVal``
    266 266 
     ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    267 267
    268 
    -JSFFI supports all boxed marshalable foreign types in C FFI:
    268 
    +JSFFI supports all lifted marshalable foreign types in C FFI:
    269 269
    270 270 
     -  ``Bool``
    271 271 
     -  ``Char``
    ... ... @@ -298,8 +298,14 @@ types in JSFFI. Some caveats to keep in mind:
    298 298 
        results in type errors, so keep this in mind. As for ``Int`` /
    299 299 
        ``Word``, they are 32-bit since the GHC wasm backend is based on
    300 300 
        ``wasm32`` .
    301 
    --  JSFFI doesn’t support unboxed foreign types like ``Int#``,
    302 
    -   ``ByteArray#``, etc, even when ``UnliftedFFITypes`` is enabled.
    301 
    +-  JSFFI doesn’t support unboxed foreign types like ``Int#``, even
    302 
    +   when ``UnliftedFFITypes`` is enabled. The only supported unlifted
    303 
    +   types are ``ByteArray#`` and ``MutableByteArray#``, they may only
    304 
    +   be used as JSFFI import argument types, with the same semantics in
    305 
    +   C FFI: the pointer to the payload is passed to JavaScript. Be
    306 
    +   careful and avoid calling back into Haskell in such cases,
    307 
    +   otherwise GC may occur and the pointer may be invalidated if it's
    308 
    +   unpinned!
    303 309
    304 310 
     In addition to the above types, JSFFI supports the ``JSVal`` type and
    305 311 
     its ``newtype``\ s as argument/result types. ``JSVal`` is defined in

  • testsuite/tests/jsffi/all.T
    ... ... @@ -25,4 +25,6 @@ test('jsffion', [], compile_and_run, ['-optl-Wl,--export=main'])
    25 25
    26 26 
     test('jsffisleep', [], compile_and_run, ['-optl-Wl,--export=testWouldBlock,--export=testLazySleep,--export=testThreadDelay,--export=testInterruptingSleep'])
    27 27
    28 
    +test('bytearrayarg', [], compile_and_run, ['-optl-Wl,--export=main'])
    29 
    +
    28 30 
     test('textconv', [], compile_and_run, ['-optl-Wl,--export=main'])

  • testsuite/tests/jsffi/bytearrayarg.hs
    1 
    +{-# LANGUAGE MagicHash #-}
    2 
    +{-# LANGUAGE UnboxedTuples #-}
    3 
    +{-# LANGUAGE UnliftedFFITypes #-}
    4 
    +
    5 
    +module Test where
    6 
    +
    7 
    +import GHC.Exts
    8 
    +import GHC.IO
    9 
    +import GHC.Word (Word8(W8#))
    10 
    +
    11 
    +foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
    12 
    +  js_check_mba :: MutableByteArray# RealWorld -> IO Int
    13 
    +
    14 
    +foreign import javascript unsafe "(() => { const u8 = new Uint8Array(__exports.memory.buffer, $1, 4); return (u8[0] === 0x12 && u8[1] === 0x34 && u8[2] === 0x56 && u8[3] === 0x78) ? 1 : 0; })()"
    15 
    +  js_check_ba :: ByteArray# -> IO Int
    16 
    +
    17 
    +foreign export javascript "main"
    18 
    +  main :: IO ()
    19 
    +
    20 
    +main :: IO ()
    21 
    +main =
    22 
    +  IO $ \s0 ->
    23 
    +    case newPinnedByteArray# 4# s0 of
    24 
    +      (# s1, mba# #) ->
    25 
    +        case (0x12 :: Word8) of { W8# b0# ->
    26 
    +        case (0x34 :: Word8) of { W8# b1# ->
    27 
    +        case (0x56 :: Word8) of { W8# b2# ->
    28 
    +        case (0x78 :: Word8) of { W8# b3# ->
    29 
    +          let s2 = writeWord8Array# mba# 0# b0# s1
    30 
    +              s3 = writeWord8Array# mba# 1# b1# s2
    31 
    +              s4 = writeWord8Array# mba# 2# b2# s3
    32 
    +              s5 = writeWord8Array# mba# 3# b3# s4
    33 
    +           in case unIO (js_check_mba mba#) s5 of
    34 
    +                (# s6, ok_mba #) -> case unsafeFreezeByteArray# mba# s6 of
    35 
    +                  (# s7, ba# #) -> case unIO (js_check_ba ba#) s7 of
    36 
    +                    (# s8, ok_ba #) -> case unIO (print ok_mba) s8 of
    37 
    +                      (# s9, _ #) -> case unIO (print ok_ba) s9 of
    38 
    +                        (# s10, _ #) -> (# s10, () #)
    39 
    +        }}}}

  • testsuite/tests/jsffi/bytearrayarg.mjs
    1 
    +export default async (__exports) => {
    2 
    +  await __exports.main();
    3 
    +  process.exit();
    4 
    +}

  • testsuite/tests/jsffi/bytearrayarg.stdout
    1 
    +1
    2 
    +1

  • testsuite/tests/perf/should_run/all.T
    ... ... @@ -420,6 +420,7 @@ test('T17949', [collect_stats('bytes allocated', 1), only_ways(['normal'])], com
    420 420 
     test('ByteCodeAsm',
    421 421 
                    [ extra_run_opts('"' + config.libdir + '"')
    422 422 
                    , js_broken(22261)
    423 
    +               , when(arch('wasm32'), run_timeout_multiplier(10))
    423 424 
                    , collect_stats('bytes allocated', 10),
    424 425 
                    ],
    425 426 
                    compile_and_run,

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help