126 lines
3.1 KiB
Haskell
126 lines
3.1 KiB
Haskell
module Gyehoek.Wasm.Syntax
|
|
( Module(..)
|
|
, Type
|
|
, Import
|
|
, Tag
|
|
, Global
|
|
, Mem
|
|
, Table
|
|
, Func
|
|
, Data
|
|
, Elem
|
|
, Export
|
|
, Idx
|
|
, TypeIdx
|
|
, FuncIdx
|
|
, GlobalIdx
|
|
, TableIdx
|
|
, MemIdx
|
|
, TagIdx
|
|
, ElemIdx
|
|
, DataIdx
|
|
, LabelIdx
|
|
, LocalIdx
|
|
, FieldIdx
|
|
) where
|
|
|
|
import Data.Vector (Vector)
|
|
import Data.Word (Word32)
|
|
import Data.Binary
|
|
import Data.Bits
|
|
import Data.Int (Int8)
|
|
import Data.Binary
|
|
|
|
|
|
data Type
|
|
data Import
|
|
data Tag
|
|
data Global
|
|
data Mem
|
|
data Table
|
|
data Func
|
|
data Data
|
|
data Elem
|
|
data Export
|
|
|
|
type Idx = Word32
|
|
newtype TypeIdx = MkType Idx
|
|
newtype FuncIdx = MkFunc Idx
|
|
newtype GlobalIdx = MkGlobal Idx
|
|
newtype TableIdx = MkTable Idx
|
|
newtype MemIdx = MkMem Idx
|
|
newtype TagIdx = MkTag Idx
|
|
newtype ElemIdx = MkElem Idx
|
|
newtype DataIdx = MkData Idx
|
|
newtype LabelIdx = MkLabel Idx
|
|
newtype LocalIdx = MkLocal Idx
|
|
newtype FieldIdx = MkField Idx
|
|
|
|
data Module = MkModule
|
|
{ types :: Vector Type
|
|
, imports :: Vector Import
|
|
, tags :: Vector Tag
|
|
, globals :: Vector Global
|
|
, mems :: Vector Mem
|
|
, tables :: Vector Table
|
|
, funcs :: Vector Func
|
|
, datas :: Vector Data
|
|
, elems :: Vector Elem
|
|
, start :: Maybe FuncIdx
|
|
, exports :: Vector Export
|
|
}
|
|
|
|
|
|
|
|
getULEB128 :: (Integral a, Bits a) => Int -> Get a
|
|
getULEB128 bitsBudget = do
|
|
if bitsBudget > 0 then return () else fail "integer representation too long"
|
|
val <- getWord8
|
|
if bitsBudget >= 7 || val .&. 0x7F < 1 `shiftL` bitsBudget then return () else fail "integer too large"
|
|
if not (testBit val 7)
|
|
then return $ fromIntegral val
|
|
else do
|
|
rest <- getULEB128 (bitsBudget - 7)
|
|
return $ (fromIntegral $ val .&. 0x7F) .|. (rest `shiftL` 7)
|
|
|
|
putULEB128 :: (Integral a, Bits a) => a -> Put
|
|
putULEB128 val =
|
|
if val < 128
|
|
then putWord8 $ fromIntegral val
|
|
else do
|
|
putWord8 $ 0x80 + (0x7F .&. fromIntegral val)
|
|
putULEB128 $ val `shiftR` 7
|
|
|
|
getSLEB128 :: (Integral a, Bits a) => Int -> Get a
|
|
getSLEB128 bitsBudget = do
|
|
if bitsBudget > 0 then return () else fail "integer representation too long"
|
|
let toInt8 :: Word8 -> Int8
|
|
toInt8 = fromIntegral
|
|
a <- getWord8
|
|
let mask = (0xFF `shiftL` (bitsBudget - 1)) .&. 0x7F
|
|
if bitsBudget >= 7 || a .&. mask == 0 || a .&. mask == mask then return () else fail "integer too large"
|
|
if not (testBit a 7)
|
|
then return . fromIntegral . toInt8 $ (a .&. 0x7f) .|. ((a .&. 0x40) `shiftL` 1)
|
|
else do
|
|
b <- getSLEB128 (bitsBudget - 7)
|
|
return $ (b `shiftL` 7) .|. (fromIntegral (a .&. 0x7f))
|
|
|
|
putSLEB128 :: (Integral a, Bits a) => a -> Put
|
|
putSLEB128 a = go a
|
|
where
|
|
ext = if a >= 0 then 0 else complement 0
|
|
go x = do
|
|
let
|
|
r = x `shiftR` 7
|
|
w = x .&. 0x7f
|
|
if r /= ext
|
|
then do
|
|
putWord8 (fromIntegral w .|. 0x80)
|
|
go r
|
|
else
|
|
if (testBit w 6 && a < 0) || (not (testBit w 6) && a >= 0)
|
|
then putWord8 (fromIntegral w)
|
|
else do
|
|
putWord8 (fromIntegral w .|. 0x80)
|
|
putWord8 (fromIntegral ext .&. 0x7F)
|