ghc-lib-0.20221201: The GHC API, decoupled from GHC versions
Safe HaskellSafe-Inferred
LanguageHaskell2010

GHC.CmmToAsm.Wasm.FromCmm

Synopsis

Documentation

someWasmTypeFromCmmType :: CmmType -> SomeWasmType Source #

Calculate the wasm representation type from a CmmType. This is a lossy conversion, and sometimes we need to pass the original CmmType or at least its Width around, so to properly add subword truncation or extension logic.

wasmMemoryNarrowing :: WasmTypeTag t -> CmmType -> Maybe Int Source #

Calculate the optional memory narrowing of a CmmLoad or CmmStore.

symNameFromCLabel :: CLabel -> SymName Source #

Despite this is used by the WebAssembly native codegen, we use pprCLabel instead of pprAsmLabel when emitting the textual symbol name. Either one would work, but pprCLabel makes the output assembly code looks closer to the unregisterised codegen output, which can be handy when using the unregisterised codegen as a source of truth when debugging the native codegen.

symVisibilityFromCLabel :: CLabel -> SymVisibility Source #

Calculate a symbol's visibility.

symKindFromCLabel :: CLabel -> SymKind Source #

Calculate a symbol's kind, see haddock docs of SymKind for more explanation.

dataSectionKindFromCmmSection :: Section -> DataSectionKind Source #

Calculate a data section's kind, see haddock docs of DataSectionKind for more explanation.

alignmentFromWordType :: WasmTypeTag w -> Alignment Source #

Calculate the natural alignment size given the platform word type.

alignmentFromCmmSection :: WasmTypeTag w -> CLabel -> Alignment Source #

Calculate a data section's alignment. Closures needs to be naturally aligned; info tables need to align to 2, so to get 1 tag bit as forwarding pointer marker. The rest have no alignment requirements.

allocDataSection :: DataSection -> WasmCodeGenM w SymName Source #

Allocate a fresh symbol for an internal data section.

wasmDebugMsg :: String -> WasmCodeGenM w (WasmStatements w) Source #

Print a debug message to stderr by calling fputs(). We don't bother to check fputs() return value.

truncSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t Source #

Truncate a subword.

extendSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t Source #

Sign-extend a subword.

lower_MO_Bin_Homo :: (forall pre t. WasmTypeTag t -> WasmInstr w (t ': (t ': pre)) (t ': pre)) -> CLabel -> CmmType -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a binary homogeneous operation. Homogeneous: result type is the same with operand types.

lower_MO_Bin_Homo_Trunc :: (forall pre t. WasmTypeTag t -> WasmInstr w (t ': (t ': pre)) (t ': pre)) -> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a binary homogeneous operation, and truncate the result if it's a subword.

lower_MO_Bin_Homo_Ext_Trunc :: (forall pre t. WasmTypeTag t -> WasmInstr w (t ': (t ': pre)) (t ': pre)) -> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a binary homogeneous operation, first sign extending the operands, then truncating the result.

lower_MO_Bin_Rel_Ext :: (forall pre t. WasmTypeTag t -> WasmInstr w (t ': (t ': pre)) (w ': pre)) -> CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a relational binary operation, first sign extending the operands. Relational: result type is a boolean (word type).

lower_MO_Bin_Rel :: (forall pre t. WasmTypeTag t -> WasmInstr w (t ': (t ': pre)) (w ': pre)) -> CLabel -> CmmType -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a relational binary operation.

shiftRHSCast :: CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t) Source #

Cast a shiftL/shiftR RHS to the same type as LHS. Because we may have a 64-bit LHS and 32-bit RHS, but wasm shift operators are homogeneous.

lower_MO_Shl :: CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a MO_Shl operation, truncating the result.

lower_MO_S_Shr :: CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a MO_S_Shr operation, first sign-extending the LHS, then truncating the result.

lower_MO_MulMayOflo :: CLabel -> Width -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a MO_MulMayOflo operation. It's translated to a ccall to hs_mulIntMayOflo function in ghc-primcbitsmulIntMayOflo, otherwise it's quite non-trivial to implement as inline assembly.

lower_MO_Un_Conv :: (forall pre t0 t1. WasmTypeTag t0 -> WasmTypeTag t1 -> WasmInstr w (t0 ': pre) (t1 ': pre)) -> CLabel -> CmmType -> CmmType -> [CmmExpr] -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower an unary conversion operation.

lower_CmmLit :: CmmLit -> WasmCodeGenM w (SomeWasmExpr w) Source #

Lower a CmmLit. Note that we don't emit 'f32.const' or 'f64.const' for the time being, and instead emit their relative bit pattern as int literals, then use an reinterpret cast. This is simpler than dealing with textual representation of floating point values.

lower_CmmLoad_Typed :: CLabel -> CmmExpr -> WasmTypeTag t -> CmmType -> AlignmentSpec -> WasmCodeGenM w (WasmExpr w t) Source #

Lower a CmmLoad, passing in the expected wasm representation type, and also the Cmm type (which contains width info needed for memory narrowing).

The Cmm type system doesn't track signedness, so all CmmLoads are unsigned loads. However, as an optimization, we do emit signed loads when a CmmLoad result is immediately used as a MO_SS_Conv operand.

lower_CmmExpr_Typed :: CLabel -> WasmTypeTag t -> CmmExpr -> WasmCodeGenM w (WasmExpr w t) Source #

Lower a CmmExpr, passing in the expected wasm representation type.

lower_CmmExpr_Ptr :: CLabel -> CmmExpr -> WasmCodeGenM w (WasmExpr w w, Int) Source #

Lower a CmmExpr as a pointer, returning the pair of base pointer and non-negative offset.

type family WasmPushes (ts :: [WasmType]) (pre :: [WasmType]) :: [WasmType] where ... Source #

Push a series of values onto the wasm value stack, returning the result stack type.

Equations

WasmPushes '[] pre = pre 
WasmPushes (t ': ts) pre = WasmPushes ts (t ': pre) 

data SomeWasmPreCCall w where Source #

Push the arguments onto the wasm value stack before a ccall.

Constructors

SomeWasmPreCCall :: TypeList ts -> (forall pre. WasmInstr w pre (WasmPushes ts pre)) -> SomeWasmPreCCall w 

data SomeWasmPostCCall w where Source #

Pop the results into locals after a ccall.

Constructors

SomeWasmPostCCall :: TypeList ts -> (forall post. WasmInstr w (WasmPushes ts post) post) -> SomeWasmPostCCall w 

lower_CMO_Un_Homo :: CLabel -> SymName -> [CmmFormal] -> [CmmActual] -> WasmCodeGenM w (WasmStatements w) Source #

Lower an unary homogeneous CallishMachOp to a ccall.

lower_CMO_Un_Prim :: CLabel -> (forall pre t. WasmTypeTag t -> WasmInstr w (t ': pre) (t ': pre)) -> [CmmFormal] -> [CmmActual] -> WasmCodeGenM w (WasmStatements w) Source #

Lower an unary homogeneous CallishMachOp to inline assembly.

lower_CMO_Bin_Homo :: CLabel -> SymName -> [CmmFormal] -> [CmmActual] -> WasmCodeGenM w (WasmStatements w) Source #

Lower a binary homogeneous CallishMachOp to a ccall.

lower_MO_Cmpxchg :: CLabel -> Width -> [CmmFormal] -> [CmmActual] -> WasmCodeGenM w (WasmStatements w) Source #

Lower a MO_Cmpxchg operation to inline assembly. Currently we target wasm without atomics and threads, so it's just lowered to regular memory loads and stores.

lower_CmmUnsafeForeignCall_Drop :: CLabel -> SymName -> CmmType -> [CmmActual] -> WasmCodeGenM w (WasmStatements w) Source #

Lower a ccall, but drop the result by assigning it to an unused local. This is only used for lowering MO_Memcpy and such, where the libc functions do have a return value, but the corresponding CallishMachOp does not expect one.

lower_CmmUnsafeForeignCall :: CLabel -> Either SymName CmmExpr -> CmmReturnInfo -> [CmmFormal] -> [CmmActual] -> WasmCodeGenM w (WasmStatements w) Source #

Lower a CmmUnsafeForeignCall. The target is Either a symbol, which translates to a direct call, or an expression, which translates to a call_indirect. The callee function signature is inferred from the passed in arguments here.

lower_CmmAction :: CLabel -> CmmNode O O -> WasmCodeGenM w (WasmStatements w) Source #

Lower a single Cmm action.

lower_CmmActions :: CLabel -> Label -> Block CmmNode O O -> WasmCodeGenM w (WasmStatements w) Source #

Lower a block of Cmm actions.

onTopSym :: CLabel -> WasmCodeGenM w () Source #

Invoked once for each CLabel which indexes a CmmData or CmmProc.

onFuncSym :: SymName -> [CmmType] -> [CmmType] -> WasmCodeGenM w () Source #

Invoked for each function CLabel with known type (e.g. a CmmProc, or callee of CmmUnsafeForeignCall).

onAnySym :: CLabel -> WasmCodeGenM w () Source #

Invoked for all other CLabels along the way, e.g. in CmmStatics or CmmExprs.

onCmmLocalReg :: LocalReg -> WasmCodeGenM w LocalInfo Source #

Invoked for each LocalReg, returning its wasm local id and representation type.

onCmmLocalReg_Typed :: WasmTypeTag t -> LocalReg -> WasmCodeGenM w Int Source #

Invoked for each LocalReg with expected representation type, only returning its wasm local id.

onFini :: [SymName] -> WasmCodeGenM w () Source #

Invoked for dtors. We don't bother to implement dtors yet; there's no native .fini_array support for wasm, and the way clang handles dtors is generating a ctor that calls atexit() for dtors. Which makes some sense, but we don't need to do the same thing yet.

onCmmInitFini :: InitOrFini -> [CLabel] -> WasmCodeGenM w () Source #

Invoked for ctors and dtors.

onCmmData :: CLabel -> Section -> [CmmStatic] -> WasmCodeGenM w () Source #

Invoked for each data section.

onCmmProc :: CLabel -> CmmGraph -> WasmCodeGenM w () Source #

Invoked for each CmmProc.

onCmmDecl :: RawCmmDecl -> WasmCodeGenM w () Source #

Invoked for each RawCmmDecl.