From 51cf7e753bd19896712d71b0f50932d181852ad7 Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Sun, 30 Jan 2022 16:21:22 -0700 Subject: [PATCH] syntax support for ref.ops and pass ref_null.wast --- src/Language/Wasm/Interpreter.hs | 16 ++++++++++++++++ src/Language/Wasm/Parser.y | 27 +++++++++++++++++++++++++++ src/Language/Wasm/Script.hs | 4 ++++ src/Language/Wasm/Structure.hs | 8 +++++++- src/Language/Wasm/Validate.hs | 12 ++++++++++++ tests/Test.hs | 2 +- 6 files changed, 67 insertions(+), 2 deletions(-) diff --git a/src/Language/Wasm/Interpreter.hs b/src/Language/Wasm/Interpreter.hs index bcc9684..f33e757 100644 --- a/src/Language/Wasm/Interpreter.hs +++ b/src/Language/Wasm/Interpreter.hs @@ -74,6 +74,8 @@ data Value = | VI64 Word64 | VF32 Float | VF64 Double + | RF (Maybe Natural) + | RE (Maybe Natural) deriving (Eq, Show) asInt32 :: Word32 -> Int32 @@ -191,6 +193,8 @@ getValueType (VI32 _) = I32 getValueType (VI64 _) = I64 getValueType (VF32 _) = F32 getValueType (VF64 _) = F64 +getValueType (RF _) = Func +genValueType (RE _) = Extern data ExportInstance = ExportInstance TL.Text ExternalValue deriving (Eq, Show) @@ -426,6 +430,9 @@ evalConstExpr _ _ [I32Const v] = return $ VI32 v evalConstExpr _ _ [I64Const v] = return $ VI64 v evalConstExpr _ _ [F32Const v] = return $ VF32 v evalConstExpr _ _ [F64Const v] = return $ VF64 v +evalConstExpr _ _ [RefNull FuncRef] = return $ RF Nothing +evalConstExpr _ _ [RefNull ExternRef] = return $ RE Nothing +evalConstExpr _ _ [RefFunc idx] = return $ RF $ Just idx evalConstExpr inst store [GetGlobal i] = getGlobalValue inst store i evalConstExpr _ _ instrs = error $ "Global initializer contains unsupported instructions: " ++ show instrs @@ -722,6 +729,15 @@ eval budget store FunctionInstance { funcType, moduleInstance, code = Function { Just res -> return $ Done ctx { stack = reverse res ++ (drop (length params) rest) } Nothing -> return Trap Nothing -> return Trap + step ctx@EvalCtx{ stack = st } (RefNull FuncRef) = + return $ Done ctx { stack = RF Nothing : st } + step ctx@EvalCtx{ stack = st } (RefNull ExternRef) = + return $ Done ctx { stack = RE Nothing : st } + step ctx@EvalCtx{ stack = v:rest } RefIsNull = + let r = case v of { RE Nothing -> 1; RF Nothing -> 1; _ -> 0 } in + return $ Done ctx { stack = VI32 r : rest } + step ctx@EvalCtx{ stack = st } (RefFunc index) = + return $ Done ctx { stack = RF (Just index) : st } step ctx@EvalCtx{ stack = (_:rest) } Drop = return $ Done ctx { stack = rest } step ctx@EvalCtx{ stack = (VI32 test:val2:val1:rest) } Select = if test == 0 diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index c0f239a..665f1ae 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -119,6 +119,8 @@ import Language.Wasm.Lexer ( 'f64' { Lexeme _ (TKeyword "f64") } 'mut' { Lexeme _ (TKeyword "mut") } 'funcref' { Lexeme _ (TKeyword "funcref") } +'externref' { Lexeme _ (TKeyword "externref") } +'extern' { Lexeme _ (TKeyword "extern") } 'type' { Lexeme _ (TKeyword "type") } 'unreachable' { Lexeme _ (TKeyword "unreachable") } 'nop' { Lexeme _ (TKeyword "nop") } @@ -128,6 +130,9 @@ import Language.Wasm.Lexer ( 'return' { Lexeme _ (TKeyword "return") } 'call' { Lexeme _ (TKeyword "call") } 'call_indirect' { Lexeme _ (TKeyword "call_indirect") } +'ref.null' { Lexeme _ (TKeyword "ref.null") } +'ref.is_null' { Lexeme _ (TKeyword "ref.is_null") } +'ref.func' { Lexeme _ (TKeyword "ref.func") } 'drop' { Lexeme _ (TKeyword "drop") } 'select' { Lexeme _ (TKeyword "select") } 'get_local' { Lexeme _ (TKeyword "local.get") } @@ -363,6 +368,8 @@ valtype :: { ValueType } | 'i64' { I64 } | 'f32' { F32 } | 'f64' { F64 } + | 'funcref' { Func } + | 'externref' { Extern } index :: { Index } : u32 { Index $1 } @@ -418,6 +425,10 @@ plaininstr :: { PlainInstr } | 'call' index { Call $2 } | 'drop' { Drop } | 'select' { Select } + -- reference instructions + | 'ref.null' heaptype { RefNull $2 } + | 'ref.is_null' { RefIsNull } + | 'ref.func' index { RefFunc $2 } -- variable instructions | 'get_local' index { GetLocal $2 } | 'set_local' index { SetLocal $2 } @@ -856,6 +867,11 @@ limits :: { Limit } elemtype :: { ElemType } : 'funcref' { FuncRef } + | 'externref' { ExternRef } + +heaptype :: { ElemType } + : 'func' { FuncRef } + | 'extern' { ExternRef } tabletype :: { TableType } : limits elemtype { TableType $1 $2 } @@ -1116,6 +1132,10 @@ data PlainInstr = | Return | Call FuncIndex | CallIndirect TypeUse + -- Reference instructions + | RefNull ElemType + | RefIsNull + | RefFunc FuncIndex -- Parametric instructions | Drop | Select @@ -1376,6 +1396,7 @@ constInstructionToValue (PlainInstr (I32Const v)) = S.I32Const $ integerToWord32 constInstructionToValue (PlainInstr (F32Const v)) = S.F32Const v constInstructionToValue (PlainInstr (I64Const v)) = S.I64Const $ integerToWord64 v constInstructionToValue (PlainInstr (F64Const v)) = S.F64Const v +constInstructionToValue (PlainInstr (RefNull et)) = S.RefNull et constInstructionToValue _ = error "Only const instructions supported as arguments for actions" desugarize :: [ModuleField] -> Either String S.Module @@ -1562,6 +1583,12 @@ desugarize fields = do Nothing -> Left "unknown type" synInstrToStruct _ (PlainInstr Drop) = return $ S.Drop synInstrToStruct _ (PlainInstr Select) = return $ S.Select + synInstrToStruct _ (PlainInstr (RefNull elType)) = return $ S.RefNull elType + synInstrToStruct _ (PlainInstr RefIsNull) = return $ S.RefIsNull + synInstrToStruct FunCtx { ctxMod } (PlainInstr (RefFunc funIdx)) = + case getFuncIndex ctxMod funIdx of + Just idx -> return $ S.RefFunc idx + Nothing -> Left "unknown function" synInstrToStruct ctx (PlainInstr (GetLocal localIdx)) = case getLocalIndex ctx localIdx of Just idx -> return $ S.GetLocal idx diff --git a/src/Language/Wasm/Script.hs b/src/Language/Wasm/Script.hs index 08ced60..8cd175c 100644 --- a/src/Language/Wasm/Script.hs +++ b/src/Language/Wasm/Script.hs @@ -122,6 +122,8 @@ runScript onAssertFail script = do asArg [Struct.F32Const v] = Interpreter.VF32 v asArg [Struct.I64Const v] = Interpreter.VI64 v asArg [Struct.F64Const v] = Interpreter.VF64 v + asArg [Struct.RefNull Struct.FuncRef] = Interpreter.RF Nothing + asArg [Struct.RefNull Struct.ExternRef] = Interpreter.RE Nothing asArg _ = error "Only const instructions supported as arguments for actions" runAction :: ScriptState -> Action -> IO (Maybe [Interpreter.Value]) @@ -139,6 +141,8 @@ runScript onAssertFail script = do isValueEqual (Interpreter.VI64 v1) (Interpreter.VI64 v2) = v1 == v2 isValueEqual (Interpreter.VF32 v1) (Interpreter.VF32 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2 isValueEqual (Interpreter.VF64 v1) (Interpreter.VF64 v2) = (isNaN v1 && isNaN v2) || identicalIEEE v1 v2 + isValueEqual (Interpreter.RF f1) (Interpreter.RF f2) = f1 == f2 + isValueEqual (Interpreter.RE e1) (Interpreter.RE e2) = e1 == e2 isValueEqual _ _ = False isNaNReturned :: Action -> Assertion -> AssertM () diff --git a/src/Language/Wasm/Structure.hs b/src/Language/Wasm/Structure.hs index dcb8c16..0f8e4a4 100644 --- a/src/Language/Wasm/Structure.hs +++ b/src/Language/Wasm/Structure.hs @@ -108,6 +108,8 @@ data ValueType = | I64 | F32 | F64 + | Func + | Extern deriving (Show, Eq, Generic, NFData) type ResultType = [ValueType] @@ -134,6 +136,10 @@ data Instruction index = | Return | Call index | CallIndirect index + -- Reference instructions + | RefNull ElemType + | RefIsNull + | RefFunc index -- Parametric instructions | Drop | Select @@ -207,7 +213,7 @@ data Function = Function { data Limit = Limit Natural (Maybe Natural) deriving (Show, Eq, Generic, NFData) -data ElemType = FuncRef deriving (Show, Eq, Generic, NFData) +data ElemType = FuncRef | ExternRef deriving (Show, Eq, Generic, NFData) data TableType = TableType Limit ElemType deriving (Show, Eq, Generic, NFData) diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index 5741328..5979553 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -258,6 +258,16 @@ getInstrType Drop = do getInstrType Select = do var <- freshVar return $ [var, var, Val I32] ==> var +getInstrType (RefNull elType) = do + let t = case elType of { FuncRef -> Func; ExternRef -> Extern } + return $ empty ==> Val t +getInstrType RefIsNull = do + return $ empty ==> Val I32 +getInstrType (RefFunc funIdx) = do + Ctx { funcs } <- ask + if fromIntegral funIdx < length funcs + then return $ empty ==> Val I32 + else throwError FunctionIndexOutOfRange getInstrType (GetLocal local) = do Ctx { locals } <- ask t <- maybeToEither (LocalIndexOutOfRange local) $ locals !? local @@ -445,6 +455,8 @@ isConstExpression ((I32Const _):rest) = isConstExpression rest isConstExpression ((I64Const _):rest) = isConstExpression rest isConstExpression ((F32Const _):rest) = isConstExpression rest isConstExpression ((F64Const _):rest) = isConstExpression rest +isConstExpression ((RefNull _):rest) = isConstExpression rest +isConstExpression ((RefFunc _):rest) = isConstExpression rest isConstExpression ((GetGlobal idx):rest) = do Ctx {globals, importedGlobals} <- ask if importedGlobals <= idx diff --git a/tests/Test.hs b/tests/Test.hs index 7cccffe..b541ffe 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -17,7 +17,7 @@ import qualified Data.List as List main :: IO () main = do files <- filter (List.isSuffixOf ".wast") <$> Directory.listDirectory "tests/spec" - -- let files = ["const.wast"] + let files = ["ref_null.wast", "ref_is_null.wast"] scriptTestCases <- (`mapM` files) $ \file -> do test <- LBS.readFile ("tests/spec/" ++ file) return $ testCase file $ do