From 0029c6811522f0bd66dafc2109a832e9e6b45dc6 Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Mon, 19 Feb 2018 09:37:02 -0800 Subject: [PATCH] add put implememntation for insturction --- src/Language/Wasm/Binary.hs | 234 ++++++++++++++++++++++++++++++++- src/Language/Wasm/Structure.hs | 5 +- 2 files changed, 233 insertions(+), 6 deletions(-) diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs index a30baa2..498d48c 100644 --- a/src/Language/Wasm/Binary.hs +++ b/src/Language/Wasm/Binary.hs @@ -69,6 +69,22 @@ getName = do bytes <- getLazyByteString $ fromIntegral len return $ TLEncoding.decodeUtf8 bytes +putResultType :: ResultType -> Put +putResultType [] = putWord8 0x40 +putResultType [valType] = put valType +putResultType _ = fail "Current WebAssembly spec does not support returning more then one value" + +getResultType :: Get ResultType +getResultType = do + op <- getWord8 + case op of + 0x40 -> return [] + 0x7F -> return [I32] + 0x7E -> return [I64] + 0x7D -> return [F32] + 0x7C -> return [F64] + _ -> fail "unexpected byte in result type position" + data SectionType = CustomSection | TypeSection @@ -190,9 +206,219 @@ instance Serialize Memory where put (Memory limit) = put limit get = Memory <$> get --- instance Serialize Global where --- put (Global globalType expr) = put globalType >> put expr --- get = Global <$> get <*> get +newtype Index = Index Natural deriving (Show, Eq) + +instance Serialize Index where + put (Index idx) = putULEB128 idx + get = Index <$> getULEB128 + +instance Serialize MemArg where + put (MemArg offset align) = putULEB128 align >> putULEB128 offset + get = MemArg <$> getULEB128 <*> getULEB128 + +instance Serialize Instruction where + put Unreachable = putWord8 0x00 + put Nop = putWord8 0x01 + put (Block result body) = do + putWord8 0x02 + putResultType result + mapM put body + putWord8 0x0B -- END + put (Loop result body) = do + putWord8 0x03 + putResultType result + mapM put body + putWord8 0x0B -- END + put If {result, true, false = []} = do + putWord8 0x04 + putResultType result + mapM put true + putWord8 0x0B -- END + put If {result, true, false} = do + putWord8 0x04 + putResultType result + mapM put true + putWord8 0x05 -- ELSE + mapM put false + putWord8 0x0B -- END + put (Br labelIdx) = putWord8 0x0C >> putULEB128 labelIdx + put (BrIf labelIdx) = putWord8 0x0D >> putULEB128 labelIdx + put (BrTable labels label) = putWord8 0x0E >> putVec (map Index labels) >> putULEB128 label + put Return = putWord8 0x0F + put (Call funcIdx) = putWord8 0x10 >> putULEB128 funcIdx + put (CallIndirect typeIdx) = putWord8 0x11 >> putULEB128 typeIdx >> putWord8 0x00 + -- Parametric instructions + put Drop = putWord8 0x1A + put Select = putWord8 0x1B + -- Variable instructions + put (GetLocal idx) = putWord8 0x20 >> putULEB128 idx + put (SetLocal idx) = putWord8 0x21 >> putULEB128 idx + put (TeeLocal idx) = putWord8 0x22 >> putULEB128 idx + put (GetGlobal idx) = putWord8 0x23 >> putULEB128 idx + put (SetGlobal idx) = putWord8 0x24 >> putULEB128 idx + -- Memory instructions + put (I32Load memArg) = putWord8 0x28 >> put memArg + put (I64Load memArg) = putWord8 0x29 >> put memArg + put (F32Load memArg) = putWord8 0x2A >> put memArg + put (F64Load memArg) = putWord8 0x2B >> put memArg + put (I32Load8S memArg) = putWord8 0x2C >> put memArg + put (I32Load8U memArg) = putWord8 0x2D >> put memArg + put (I32Load16S memArg) = putWord8 0x2E >> put memArg + put (I32Load16U memArg) = putWord8 0x2F >> put memArg + put (I64Load8S memArg) = putWord8 0x30 >> put memArg + put (I64Load8U memArg) = putWord8 0x31 >> put memArg + put (I64Load16S memArg) = putWord8 0x32 >> put memArg + put (I64Load16U memArg) = putWord8 0x33 >> put memArg + put (I64Load32S memArg) = putWord8 0x34 >> put memArg + put (I64Load32U memArg) = putWord8 0x35 >> put memArg + put (I32Store memArg) = putWord8 0x36 >> put memArg + put (I64Store memArg) = putWord8 0x37 >> put memArg + put (F32Store memArg) = putWord8 0x38 >> put memArg + put (F64Store memArg) = putWord8 0x39 >> put memArg + put (I32Store8 memArg) = putWord8 0x3A >> put memArg + put (I32Store16 memArg) = putWord8 0x3B >> put memArg + put (I64Store8 memArg) = putWord8 0x3C >> put memArg + put (I64Store16 memArg) = putWord8 0x3D >> put memArg + put (I64Store32 memArg) = putWord8 0x3E >> put memArg + put CurrentMemory = putWord8 0x3F >> putWord8 0x00 + put GrowMemory = putWord8 0x40 >> putWord8 0x00 + -- Numeric instructions + put (I32Const val) = putWord8 0x41 -- TODO: PACK VALUE AS SIGNED LEB128 + put (I64Const val) = putWord8 0x42 -- TODO: PACK VALUE AS SIGNED LEB128 + put (F32Const val) = putWord8 0x43 >> putFloat32le val + put (F64Const val) = putWord8 0x44 >> putFloat64le val + put I32Eqz = putWord8 0x45 + put (IRelOp BS32 IEq) = putWord8 0x46 + put (IRelOp BS32 INe) = putWord8 0x47 + put (IRelOp BS32 ILtS) = putWord8 0x48 + put (IRelOp BS32 ILtU) = putWord8 0x49 + put (IRelOp BS32 IGtS) = putWord8 0x4A + put (IRelOp BS32 IGtU) = putWord8 0x4B + put (IRelOp BS32 ILeS) = putWord8 0x4C + put (IRelOp BS32 ILeU) = putWord8 0x4D + put (IRelOp BS32 IGeS) = putWord8 0x4E + put (IRelOp BS32 IGeU) = putWord8 0x4F + put I64Eqz = putWord8 0x50 + put (IRelOp BS64 IEq) = putWord8 0x51 + put (IRelOp BS64 INe) = putWord8 0x52 + put (IRelOp BS64 ILtS) = putWord8 0x53 + put (IRelOp BS64 ILtU) = putWord8 0x54 + put (IRelOp BS64 IGtS) = putWord8 0x55 + put (IRelOp BS64 IGtU) = putWord8 0x56 + put (IRelOp BS64 ILeS) = putWord8 0x57 + put (IRelOp BS64 ILeU) = putWord8 0x58 + put (IRelOp BS64 IGeS) = putWord8 0x59 + put (IRelOp BS64 IGeU) = putWord8 0x5A + put (FRelOp BS32 FEq) = putWord8 0x5B + put (FRelOp BS32 FNe) = putWord8 0x5C + put (FRelOp BS32 FLt) = putWord8 0x5D + put (FRelOp BS32 FGt) = putWord8 0x5E + put (FRelOp BS32 FLe) = putWord8 0x5F + put (FRelOp BS32 FGe) = putWord8 0x60 + put (FRelOp BS64 FEq) = putWord8 0x61 + put (FRelOp BS64 FNe) = putWord8 0x62 + put (FRelOp BS64 FLt) = putWord8 0x63 + put (FRelOp BS64 FGt) = putWord8 0x64 + put (FRelOp BS64 FLe) = putWord8 0x65 + put (FRelOp BS64 FGe) = putWord8 0x66 + put (IUnOp BS32 IClz) = putWord8 0x67 + put (IUnOp BS32 ICtz) = putWord8 0x68 + put (IUnOp BS32 IPopcnt) = putWord8 0x69 + put (IBinOp BS32 IAdd) = putWord8 0x6A + put (IBinOp BS32 ISub) = putWord8 0x6B + put (IBinOp BS32 IMul) = putWord8 0x6C + put (IBinOp BS32 IDivS) = putWord8 0x6D + put (IBinOp BS32 IDivU) = putWord8 0x6E + put (IBinOp BS32 IRemS) = putWord8 0x6F + put (IBinOp BS32 IRemU) = putWord8 0x70 + put (IBinOp BS32 IAnd) = putWord8 0x71 + put (IBinOp BS32 IOr) = putWord8 0x72 + put (IBinOp BS32 IXor) = putWord8 0x73 + put (IBinOp BS32 IShl) = putWord8 0x74 + put (IBinOp BS32 IShrS) = putWord8 0x75 + put (IBinOp BS32 IShrU) = putWord8 0x76 + put (IBinOp BS32 IRotl) = putWord8 0x77 + put (IBinOp BS32 IRotr) = putWord8 0x78 + put (IUnOp BS64 IClz) = putWord8 0x79 + put (IUnOp BS64 ICtz) = putWord8 0x7A + put (IUnOp BS64 IPopcnt) = putWord8 0x7B + put (IBinOp BS64 IAdd) = putWord8 0x7C + put (IBinOp BS64 ISub) = putWord8 0x7D + put (IBinOp BS64 IMul) = putWord8 0x7E + put (IBinOp BS64 IDivS) = putWord8 0x7F + put (IBinOp BS64 IDivU) = putWord8 0x80 + put (IBinOp BS64 IRemS) = putWord8 0x81 + put (IBinOp BS64 IRemU) = putWord8 0x82 + put (IBinOp BS64 IAnd) = putWord8 0x83 + put (IBinOp BS64 IOr) = putWord8 0x84 + put (IBinOp BS64 IXor) = putWord8 0x85 + put (IBinOp BS64 IShl) = putWord8 0x86 + put (IBinOp BS64 IShrS) = putWord8 0x87 + put (IBinOp BS64 IShrU) = putWord8 0x88 + put (IBinOp BS64 IRotl) = putWord8 0x89 + put (IBinOp BS64 IRotr) = putWord8 0x8A + put (FUnOp BS32 FAbs) = putWord8 0x8B + put (FUnOp BS32 FNeg) = putWord8 0x8C + put (FUnOp BS32 FCeil) = putWord8 0x8D + put (FUnOp BS32 FFloor) = putWord8 0x8E + put (FUnOp BS32 FTrunc) = putWord8 0x8F + put (FUnOp BS32 FNearest) = putWord8 0x90 + put (FUnOp BS32 FSqrt) = putWord8 0x91 + put (FBinOp BS32 FAdd) = putWord8 0x92 + put (FBinOp BS32 FSub) = putWord8 0x93 + put (FBinOp BS32 FMul) = putWord8 0x94 + put (FBinOp BS32 FDiv) = putWord8 0x95 + put (FBinOp BS32 FMin) = putWord8 0x96 + put (FBinOp BS32 FMax) = putWord8 0x97 + put (FBinOp BS32 FCopySign) = putWord8 0x98 + put (FUnOp BS64 FAbs) = putWord8 0x99 + put (FUnOp BS64 FNeg) = putWord8 0x9A + put (FUnOp BS64 FCeil) = putWord8 0x9B + put (FUnOp BS64 FFloor) = putWord8 0x9C + put (FUnOp BS64 FTrunc) = putWord8 0x9D + put (FUnOp BS64 FNearest) = putWord8 0x9E + put (FUnOp BS64 FSqrt) = putWord8 0x9F + put (FBinOp BS64 FAdd) = putWord8 0xA0 + put (FBinOp BS64 FSub) = putWord8 0xA1 + put (FBinOp BS64 FMul) = putWord8 0xA2 + put (FBinOp BS64 FDiv) = putWord8 0xA3 + put (FBinOp BS64 FMin) = putWord8 0xA4 + put (FBinOp BS64 FMax) = putWord8 0xA5 + put (FBinOp BS64 FCopySign) = putWord8 0xA6 + put I32WrapI64 = putWord8 0xA7 + put (ITruncFS BS32 BS32) = putWord8 0xA8 + put (ITruncFU BS32 BS32) = putWord8 0xA9 + put (ITruncFS BS32 BS64) = putWord8 0xAA + put (ITruncFU BS32 BS64) = putWord8 0xAB + put I64ExtendSI32 = putWord8 0xAC + put I64ExtendUI32 = putWord8 0xAD + put (ITruncFS BS64 BS32) = putWord8 0xAE + put (ITruncFU BS64 BS32) = putWord8 0xAF + put (ITruncFS BS64 BS64) = putWord8 0xB0 + put (ITruncFU BS64 BS64) = putWord8 0xB1 + put (FConvertIS BS32 BS32) = putWord8 0xB2 + put (FConvertIU BS32 BS32) = putWord8 0xB3 + put (FConvertIS BS32 BS64) = putWord8 0xB4 + put (FConvertIU BS32 BS64) = putWord8 0xB4 + put F32DemoteF64 = putWord8 0xB6 + put (FConvertIS BS64 BS32) = putWord8 0xB7 + put (FConvertIU BS64 BS32) = putWord8 0xB8 + put (FConvertIS BS64 BS64) = putWord8 0xB9 + put (FConvertIU BS64 BS64) = putWord8 0xBA + put F64PromoteF32 = putWord8 0xBB + put (IReinterpretF BS32) = putWord8 0xBC + put (IReinterpretF BS64) = putWord8 0xBD + put (FReinterpretI BS32) = putWord8 0xBE + put (FReinterpretI BS64) = putWord8 0xBF + + get = undefined + +instance Serialize Global where + put (Global globalType expr) = do + put globalType + mapM put expr + putWord8 0x0B -- END + get = undefined -- Global <$> get <*> get instance Serialize Module where put mod = do @@ -212,5 +438,5 @@ instance Serialize Module where putSection FunctionSection $ map funcType $ functions mod putSection TableSection $ tables mod putSection MemorySection $ mems mod - -- putSection GlobalSection $ globals mod + putSection GlobalSection $ globals mod get = undefined \ No newline at end of file diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index d31e01e..d427648 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -28,6 +28,7 @@ module Language.Wasm.Structure ( GlobalType(..), FuncType(..), ValueType(..), + ResultType, emptyModule ) where @@ -59,13 +60,13 @@ data IBinOp = data IRelOp = IEq | INe | ILtU | ILtS | IGtU | IGtS | ILeU | ILeS | IGeU | IGeS deriving (Show, Eq) -data FUnOp = FAbs | FNeg | FSqrt | FCeil | FFloor | FTrunc | FNearest deriving (Show, Eq) +data FUnOp = FAbs | FNeg | FCeil | FFloor | FTrunc | FNearest | FSqrt deriving (Show, Eq) data FBinOp = FAdd | FSub | FMul | FDiv | FMin | FMax | FCopySign deriving (Show, Eq) data FRelOp = FEq | FNe | FLt | FGt | FLe | FGe deriving (Show, Eq) -data MemArg = MemArg { offset :: Natural, align :: Natural } deriving (Show, Eq) +data MemArg = MemArg { align :: Natural, offset :: Natural } deriving (Show, Eq) type LabelIndex = Natural type FuncIndex = Natural