| (* Binary format version *) |
| |
| let version = 1l |
| |
| |
| (* Errors *) |
| |
| module Code = Error.Make () |
| exception Code = Code.Error |
| |
| let error = Code.error |
| |
| |
| (* Encoding stream *) |
| |
| type stream = |
| { |
| buf : Buffer.t; |
| patches : (int * char) list ref |
| } |
| |
| let stream () = {buf = Buffer.create 8192; patches = ref []} |
| let pos s = Buffer.length s.buf |
| let put s b = Buffer.add_char s.buf b |
| let put_string s bs = Buffer.add_string s.buf bs |
| let patch s pos b = s.patches := (pos, b) :: !(s.patches) |
| |
| let to_string s = |
| let bs = Buffer.to_bytes s.buf in |
| List.iter (fun (pos, b) -> Bytes.set bs pos b) !(s.patches); |
| Bytes.to_string bs |
| |
| |
| (* Encoding *) |
| |
| module E (S : sig val stream : stream end) = |
| struct |
| let s = S.stream |
| |
| |
| (* Generic values *) |
| |
| let byte i = put s (Char.chr (i land 0xff)) |
| let word16 i = byte (i land 0xff); byte (i lsr 8) |
| let word32 i = |
| Int32.(word16 (to_int (logand i 0xffffl)); |
| word16 (to_int (shift_right i 16))) |
| let word64 i = |
| Int64.(word32 (to_int32 (logand i 0xffffffffL)); |
| word32 (to_int32 (shift_right i 32))) |
| |
| let rec u64 i = |
| let b = Int64.(to_int (logand i 0x7fL)) in |
| if 0L <= i && i < 128L then byte b |
| else (byte (b lor 0x80); u64 (Int64.shift_right_logical i 7)) |
| |
| let rec s64 i = |
| let b = Int64.(to_int (logand i 0x7fL)) in |
| if -64L <= i && i < 64L then byte b |
| else (byte (b lor 0x80); s64 (Int64.shift_right i 7)) |
| |
| let u1 i = u64 Int64.(logand (of_int i) 1L) |
| let u32 i = u64 Int64.(logand (of_int32 i) 0xffffffffL) |
| let s7 i = s64 (Int64.of_int i) |
| let s32 i = s64 (Int64.of_int32 i) |
| let s33 i = s64 (I64_convert.extend_i32_s i) |
| let f32 x = word32 (F32.to_bits x) |
| let f64 x = word64 (F64.to_bits x) |
| let v128 v = String.iter (put s) (V128.to_bits v) |
| |
| let len i = |
| if Int32.to_int (Int32.of_int i) <> i then |
| Code.error Source.no_region "length out of bounds"; |
| u32 (Int32.of_int i) |
| |
| let bool b = u1 (if b then 1 else 0) |
| let string bs = len (String.length bs); put_string s bs |
| let name n = string (Utf8.encode n) |
| let list f xs = List.iter f xs |
| let opt f xo = Lib.Option.app f xo |
| let vec f xs = len (List.length xs); list f xs |
| |
| let gap32 () = let p = pos s in word32 0l; byte 0; p |
| let patch_gap32 p n = |
| assert (n <= 0x0fff_ffff); (* Strings cannot excess 2G anyway *) |
| let lsb i = Char.chr (i land 0xff) in |
| patch s p (lsb (n lor 0x80)); |
| patch s (p + 1) (lsb ((n lsr 7) lor 0x80)); |
| patch s (p + 2) (lsb ((n lsr 14) lor 0x80)); |
| patch s (p + 3) (lsb ((n lsr 21) lor 0x80)); |
| patch s (p + 4) (lsb (n lsr 28)) |
| |
| |
| (* Types *) |
| |
| open Types |
| |
| let num_type = function |
| | I32Type -> s7 (-0x01) |
| | I64Type -> s7 (-0x02) |
| | F32Type -> s7 (-0x03) |
| | F64Type -> s7 (-0x04) |
| |
| let vec_type = function |
| | V128Type -> s7 (-0x05) |
| |
| let ref_type = function |
| | FuncRefType -> s7 (-0x10) |
| | ExternRefType -> s7 (-0x11) |
| |
| let value_type = function |
| | NumType t -> num_type t |
| | VecType t -> vec_type t |
| | RefType t -> ref_type t |
| |
| let func_type = function |
| | FuncType (ts1, ts2) -> |
| s7 (-0x20); vec value_type ts1; vec value_type ts2 |
| |
| |
| let limits vu {min; max} = |
| bool (max <> None); vu min; opt vu max |
| |
| let table_type = function |
| | TableType (lim, t) -> ref_type t; limits u32 lim |
| |
| let memory_type = function |
| | MemoryType lim -> limits u32 lim |
| |
| let mutability = function |
| | Immutable -> byte 0 |
| | Mutable -> byte 1 |
| |
| let global_type = function |
| | GlobalType (t, mut) -> value_type t; mutability mut |
| |
| |
| (* Instructions *) |
| |
| open Source |
| open Ast |
| open Values |
| open V128 |
| |
| let op n = byte n |
| let vecop n = op 0xfd; u32 n |
| let end_ () = op 0x0b |
| |
| let memop {align; offset; _} = u32 (Int32.of_int align); u32 offset |
| |
| let var x = u32 x.it |
| |
| let block_type = function |
| | ValBlockType None -> s33 (-0x40l) |
| | ValBlockType (Some t) -> value_type t |
| | VarBlockType x -> s33 x.it |
| |
| let rec instr e = |
| match e.it with |
| | Unreachable -> op 0x00 |
| | Nop -> op 0x01 |
| |
| | Block (bt, es) -> op 0x02; block_type bt; list instr es; end_ () |
| | Loop (bt, es) -> op 0x03; block_type bt; list instr es; end_ () |
| | If (bt, es1, es2) -> |
| op 0x04; block_type bt; list instr es1; |
| if es2 <> [] then op 0x05; |
| list instr es2; end_ () |
| |
| | Br x -> op 0x0c; var x |
| | BrIf x -> op 0x0d; var x |
| | BrTable (xs, x) -> op 0x0e; vec var xs; var x |
| | Return -> op 0x0f |
| | Call x -> op 0x10; var x |
| | CallIndirect (x, y) -> op 0x11; var y; var x |
| |
| | Drop -> op 0x1a |
| | Select None -> op 0x1b |
| | Select (Some ts) -> op 0x1c; vec value_type ts |
| |
| | LocalGet x -> op 0x20; var x |
| | LocalSet x -> op 0x21; var x |
| | LocalTee x -> op 0x22; var x |
| | GlobalGet x -> op 0x23; var x |
| | GlobalSet x -> op 0x24; var x |
| |
| | TableGet x -> op 0x25; var x |
| | TableSet x -> op 0x26; var x |
| | TableSize x -> op 0xfc; u32 0x10l; var x |
| | TableGrow x -> op 0xfc; u32 0x0fl; var x |
| | TableFill x -> op 0xfc; u32 0x11l; var x |
| | TableCopy (x, y) -> op 0xfc; u32 0x0el; var x; var y |
| | TableInit (x, y) -> op 0xfc; u32 0x0cl; var y; var x |
| | ElemDrop x -> op 0xfc; u32 0x0dl; var x |
| |
| | Load ({ty = I32Type; pack = None; _} as mo) -> op 0x28; memop mo |
| | Load ({ty = I64Type; pack = None; _} as mo) -> op 0x29; memop mo |
| | Load ({ty = F32Type; pack = None; _} as mo) -> op 0x2a; memop mo |
| | Load ({ty = F64Type; pack = None; _} as mo) -> op 0x2b; memop mo |
| | Load ({ty = I32Type; pack = Some (Pack8, SX); _} as mo) -> |
| op 0x2c; memop mo |
| | Load ({ty = I32Type; pack = Some (Pack8, ZX); _} as mo) -> |
| op 0x2d; memop mo |
| | Load ({ty = I32Type; pack = Some (Pack16, SX); _} as mo) -> |
| op 0x2e; memop mo |
| | Load ({ty = I32Type; pack = Some (Pack16, ZX); _} as mo) -> |
| op 0x2f; memop mo |
| | Load {ty = I32Type; pack = Some (Pack32, _); _} -> |
| error e.at "illegal instruction i32.load32" |
| | Load ({ty = I64Type; pack = Some (Pack8, SX); _} as mo) -> |
| op 0x30; memop mo |
| | Load ({ty = I64Type; pack = Some (Pack8, ZX); _} as mo) -> |
| op 0x31; memop mo |
| | Load ({ty = I64Type; pack = Some (Pack16, SX); _} as mo) -> |
| op 0x32; memop mo |
| | Load ({ty = I64Type; pack = Some (Pack16, ZX); _} as mo) -> |
| op 0x33; memop mo |
| | Load ({ty = I64Type; pack = Some (Pack32, SX); _} as mo) -> |
| op 0x34; memop mo |
| | Load ({ty = I64Type; pack = Some (Pack32, ZX); _} as mo) -> |
| op 0x35; memop mo |
| | Load {ty = F32Type | F64Type; pack = Some _; _} -> |
| error e.at "illegal instruction fxx.loadN" |
| | Load {ty = I32Type | I64Type; pack = Some (Pack64, _); _} -> |
| error e.at "illegal instruction ixx.load64" |
| |
| | Store ({ty = I32Type; pack = None; _} as mo) -> op 0x36; memop mo |
| | Store ({ty = I64Type; pack = None; _} as mo) -> op 0x37; memop mo |
| | Store ({ty = F32Type; pack = None; _} as mo) -> op 0x38; memop mo |
| | Store ({ty = F64Type; pack = None; _} as mo) -> op 0x39; memop mo |
| | Store ({ty = I32Type; pack = Some Pack8; _} as mo) -> op 0x3a; memop mo |
| | Store ({ty = I32Type; pack = Some Pack16; _} as mo) -> op 0x3b; memop mo |
| | Store {ty = I32Type; pack = Some Pack32; _} -> |
| error e.at "illegal instruction i32.store32" |
| | Store ({ty = I64Type; pack = Some Pack8; _} as mo) -> op 0x3c; memop mo |
| | Store ({ty = I64Type; pack = Some Pack16; _} as mo) -> op 0x3d; memop mo |
| | Store ({ty = I64Type; pack = Some Pack32; _} as mo) -> op 0x3e; memop mo |
| | Store {ty = F32Type | F64Type; pack = Some _; _} -> |
| error e.at "illegal instruction fxx.storeN" |
| | Store {ty = (I32Type | I64Type); pack = Some Pack64; _} -> |
| error e.at "illegal instruction ixx.store64" |
| |
| | VecLoad ({ty = V128Type; pack = None; _} as mo) -> |
| vecop 0x00l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtLane (Pack8x8, SX)); _} as mo) -> |
| vecop 0x01l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtLane (Pack8x8, ZX)); _} as mo) -> |
| vecop 0x02l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtLane (Pack16x4, SX)); _} as mo) -> |
| vecop 0x03l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtLane (Pack16x4, ZX)); _} as mo) -> |
| vecop 0x04l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtLane (Pack32x2, SX)); _} as mo) -> |
| vecop 0x05l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtLane (Pack32x2, ZX)); _} as mo) -> |
| vecop 0x06l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack8, ExtSplat); _} as mo) -> |
| vecop 0x07l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack16, ExtSplat); _} as mo) -> |
| vecop 0x08l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack32, ExtSplat); _} as mo) -> |
| vecop 0x09l; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtSplat); _} as mo) -> |
| vecop 0x0al; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack32, ExtZero); _} as mo) -> |
| vecop 0x5cl; memop mo |
| | VecLoad ({ty = V128Type; pack = Some (Pack64, ExtZero); _} as mo) -> |
| vecop 0x5dl; memop mo |
| | VecLoad _ -> |
| error e.at "illegal instruction v128.loadNxM_<ext>" |
| |
| | VecLoadLane ({ty = V128Type; pack = Pack8; _} as mo, i) -> |
| vecop 0x54l; memop mo; byte i; |
| | VecLoadLane ({ty = V128Type; pack = Pack16; _} as mo, i) -> |
| vecop 0x55l; memop mo; byte i; |
| | VecLoadLane ({ty = V128Type; pack = Pack32; _} as mo, i) -> |
| vecop 0x56l; memop mo; byte i; |
| | VecLoadLane ({ty = V128Type; pack = Pack64; _} as mo, i) -> |
| vecop 0x57l; memop mo; byte i; |
| |
| | VecStore ({ty = V128Type; _} as mo) -> vecop 0x0bl; memop mo |
| |
| | VecStoreLane ({ty = V128Type; pack = Pack8; _} as mo, i) -> |
| vecop 0x58l; memop mo; byte i; |
| | VecStoreLane ({ty = V128Type; pack = Pack16; _} as mo, i) -> |
| vecop 0x59l; memop mo; byte i; |
| | VecStoreLane ({ty = V128Type; pack = Pack32; _} as mo, i) -> |
| vecop 0x5al; memop mo; byte i; |
| | VecStoreLane ({ty = V128Type; pack = Pack64; _} as mo, i) -> |
| vecop 0x5bl; memop mo; byte i; |
| |
| | MemorySize -> op 0x3f; byte 0x00 |
| | MemoryGrow -> op 0x40; byte 0x00 |
| | MemoryFill -> op 0xfc; u32 0x0bl; byte 0x00 |
| | MemoryCopy -> op 0xfc; u32 0x0al; byte 0x00; byte 0x00 |
| | MemoryInit x -> op 0xfc; u32 0x08l; var x; byte 0x00 |
| | DataDrop x -> op 0xfc; u32 0x09l; var x |
| |
| | RefNull t -> op 0xd0; ref_type t |
| | RefIsNull -> op 0xd1 |
| | RefFunc x -> op 0xd2; var x |
| |
| | Const {it = I32 c; _} -> op 0x41; s32 c |
| | Const {it = I64 c; _} -> op 0x42; s64 c |
| | Const {it = F32 c; _} -> op 0x43; f32 c |
| | Const {it = F64 c; _} -> op 0x44; f64 c |
| |
| | Test (I32 I32Op.Eqz) -> op 0x45 |
| | Test (I64 I64Op.Eqz) -> op 0x50 |
| | Test (F32 _ | F64 _) -> . |
| |
| | Compare (I32 I32Op.Eq) -> op 0x46 |
| | Compare (I32 I32Op.Ne) -> op 0x47 |
| | Compare (I32 I32Op.LtS) -> op 0x48 |
| | Compare (I32 I32Op.LtU) -> op 0x49 |
| | Compare (I32 I32Op.GtS) -> op 0x4a |
| | Compare (I32 I32Op.GtU) -> op 0x4b |
| | Compare (I32 I32Op.LeS) -> op 0x4c |
| | Compare (I32 I32Op.LeU) -> op 0x4d |
| | Compare (I32 I32Op.GeS) -> op 0x4e |
| | Compare (I32 I32Op.GeU) -> op 0x4f |
| |
| | Compare (I64 I64Op.Eq) -> op 0x51 |
| | Compare (I64 I64Op.Ne) -> op 0x52 |
| | Compare (I64 I64Op.LtS) -> op 0x53 |
| | Compare (I64 I64Op.LtU) -> op 0x54 |
| | Compare (I64 I64Op.GtS) -> op 0x55 |
| | Compare (I64 I64Op.GtU) -> op 0x56 |
| | Compare (I64 I64Op.LeS) -> op 0x57 |
| | Compare (I64 I64Op.LeU) -> op 0x58 |
| | Compare (I64 I64Op.GeS) -> op 0x59 |
| | Compare (I64 I64Op.GeU) -> op 0x5a |
| |
| | Compare (F32 F32Op.Eq) -> op 0x5b |
| | Compare (F32 F32Op.Ne) -> op 0x5c |
| | Compare (F32 F32Op.Lt) -> op 0x5d |
| | Compare (F32 F32Op.Gt) -> op 0x5e |
| | Compare (F32 F32Op.Le) -> op 0x5f |
| | Compare (F32 F32Op.Ge) -> op 0x60 |
| |
| | Compare (F64 F64Op.Eq) -> op 0x61 |
| | Compare (F64 F64Op.Ne) -> op 0x62 |
| | Compare (F64 F64Op.Lt) -> op 0x63 |
| | Compare (F64 F64Op.Gt) -> op 0x64 |
| | Compare (F64 F64Op.Le) -> op 0x65 |
| | Compare (F64 F64Op.Ge) -> op 0x66 |
| |
| | Unary (I32 I32Op.Clz) -> op 0x67 |
| | Unary (I32 I32Op.Ctz) -> op 0x68 |
| | Unary (I32 I32Op.Popcnt) -> op 0x69 |
| | Unary (I32 (I32Op.ExtendS Pack8)) -> op 0xc0 |
| | Unary (I32 (I32Op.ExtendS Pack16)) -> op 0xc1 |
| | Unary (I32 (I32Op.ExtendS (Pack32 | Pack64))) -> |
| error e.at "illegal instruction i32.extendN_s" |
| |
| | Unary (I64 I64Op.Clz) -> op 0x79 |
| | Unary (I64 I64Op.Ctz) -> op 0x7a |
| | Unary (I64 I64Op.Popcnt) -> op 0x7b |
| | Unary (I64 (I64Op.ExtendS Pack8)) -> op 0xc2 |
| | Unary (I64 (I64Op.ExtendS Pack16)) -> op 0xc3 |
| | Unary (I64 (I64Op.ExtendS Pack32)) -> op 0xc4 |
| | Unary (I64 (I64Op.ExtendS Pack64)) -> |
| error e.at "illegal instruction i64.extend64_s" |
| |
| | Unary (F32 F32Op.Abs) -> op 0x8b |
| | Unary (F32 F32Op.Neg) -> op 0x8c |
| | Unary (F32 F32Op.Ceil) -> op 0x8d |
| | Unary (F32 F32Op.Floor) -> op 0x8e |
| | Unary (F32 F32Op.Trunc) -> op 0x8f |
| | Unary (F32 F32Op.Nearest) -> op 0x90 |
| | Unary (F32 F32Op.Sqrt) -> op 0x91 |
| |
| | Unary (F64 F64Op.Abs) -> op 0x99 |
| | Unary (F64 F64Op.Neg) -> op 0x9a |
| | Unary (F64 F64Op.Ceil) -> op 0x9b |
| | Unary (F64 F64Op.Floor) -> op 0x9c |
| | Unary (F64 F64Op.Trunc) -> op 0x9d |
| | Unary (F64 F64Op.Nearest) -> op 0x9e |
| | Unary (F64 F64Op.Sqrt) -> op 0x9f |
| |
| | Binary (I32 I32Op.Add) -> op 0x6a |
| | Binary (I32 I32Op.Sub) -> op 0x6b |
| | Binary (I32 I32Op.Mul) -> op 0x6c |
| | Binary (I32 I32Op.DivS) -> op 0x6d |
| | Binary (I32 I32Op.DivU) -> op 0x6e |
| | Binary (I32 I32Op.RemS) -> op 0x6f |
| | Binary (I32 I32Op.RemU) -> op 0x70 |
| | Binary (I32 I32Op.And) -> op 0x71 |
| | Binary (I32 I32Op.Or) -> op 0x72 |
| | Binary (I32 I32Op.Xor) -> op 0x73 |
| | Binary (I32 I32Op.Shl) -> op 0x74 |
| | Binary (I32 I32Op.ShrS) -> op 0x75 |
| | Binary (I32 I32Op.ShrU) -> op 0x76 |
| | Binary (I32 I32Op.Rotl) -> op 0x77 |
| | Binary (I32 I32Op.Rotr) -> op 0x78 |
| |
| | Binary (I64 I64Op.Add) -> op 0x7c |
| | Binary (I64 I64Op.Sub) -> op 0x7d |
| | Binary (I64 I64Op.Mul) -> op 0x7e |
| | Binary (I64 I64Op.DivS) -> op 0x7f |
| | Binary (I64 I64Op.DivU) -> op 0x80 |
| | Binary (I64 I64Op.RemS) -> op 0x81 |
| | Binary (I64 I64Op.RemU) -> op 0x82 |
| | Binary (I64 I64Op.And) -> op 0x83 |
| | Binary (I64 I64Op.Or) -> op 0x84 |
| | Binary (I64 I64Op.Xor) -> op 0x85 |
| | Binary (I64 I64Op.Shl) -> op 0x86 |
| | Binary (I64 I64Op.ShrS) -> op 0x87 |
| | Binary (I64 I64Op.ShrU) -> op 0x88 |
| | Binary (I64 I64Op.Rotl) -> op 0x89 |
| | Binary (I64 I64Op.Rotr) -> op 0x8a |
| |
| | Binary (F32 F32Op.Add) -> op 0x92 |
| | Binary (F32 F32Op.Sub) -> op 0x93 |
| | Binary (F32 F32Op.Mul) -> op 0x94 |
| | Binary (F32 F32Op.Div) -> op 0x95 |
| | Binary (F32 F32Op.Min) -> op 0x96 |
| | Binary (F32 F32Op.Max) -> op 0x97 |
| | Binary (F32 F32Op.CopySign) -> op 0x98 |
| |
| | Binary (F64 F64Op.Add) -> op 0xa0 |
| | Binary (F64 F64Op.Sub) -> op 0xa1 |
| | Binary (F64 F64Op.Mul) -> op 0xa2 |
| | Binary (F64 F64Op.Div) -> op 0xa3 |
| | Binary (F64 F64Op.Min) -> op 0xa4 |
| | Binary (F64 F64Op.Max) -> op 0xa5 |
| | Binary (F64 F64Op.CopySign) -> op 0xa6 |
| |
| | Convert (I32 I32Op.ExtendSI32) -> |
| error e.at "illegal instruction i32.extend_i32_s" |
| | Convert (I32 I32Op.ExtendUI32) -> |
| error e.at "illegal instruction i32.extend_i32_u" |
| | Convert (I32 I32Op.WrapI64) -> op 0xa7 |
| | Convert (I32 I32Op.TruncSF32) -> op 0xa8 |
| | Convert (I32 I32Op.TruncUF32) -> op 0xa9 |
| | Convert (I32 I32Op.TruncSF64) -> op 0xaa |
| | Convert (I32 I32Op.TruncUF64) -> op 0xab |
| | Convert (I32 I32Op.TruncSatSF32) -> op 0xfc; u32 0x00l |
| | Convert (I32 I32Op.TruncSatUF32) -> op 0xfc; u32 0x01l |
| | Convert (I32 I32Op.TruncSatSF64) -> op 0xfc; u32 0x02l |
| | Convert (I32 I32Op.TruncSatUF64) -> op 0xfc; u32 0x03l |
| | Convert (I32 I32Op.ReinterpretFloat) -> op 0xbc |
| |
| | Convert (I64 I64Op.ExtendSI32) -> op 0xac |
| | Convert (I64 I64Op.ExtendUI32) -> op 0xad |
| | Convert (I64 I64Op.WrapI64) -> |
| error e.at "illegal instruction i64.wrap_i64" |
| | Convert (I64 I64Op.TruncSF32) -> op 0xae |
| | Convert (I64 I64Op.TruncUF32) -> op 0xaf |
| | Convert (I64 I64Op.TruncSF64) -> op 0xb0 |
| | Convert (I64 I64Op.TruncUF64) -> op 0xb1 |
| | Convert (I64 I64Op.TruncSatSF32) -> op 0xfc; u32 0x04l |
| | Convert (I64 I64Op.TruncSatUF32) -> op 0xfc; u32 0x05l |
| | Convert (I64 I64Op.TruncSatSF64) -> op 0xfc; u32 0x06l |
| | Convert (I64 I64Op.TruncSatUF64) -> op 0xfc; u32 0x07l |
| | Convert (I64 I64Op.ReinterpretFloat) -> op 0xbd |
| |
| | Convert (F32 F32Op.ConvertSI32) -> op 0xb2 |
| | Convert (F32 F32Op.ConvertUI32) -> op 0xb3 |
| | Convert (F32 F32Op.ConvertSI64) -> op 0xb4 |
| | Convert (F32 F32Op.ConvertUI64) -> op 0xb5 |
| | Convert (F32 F32Op.PromoteF32) -> |
| error e.at "illegal instruction f32.promote_f32" |
| | Convert (F32 F32Op.DemoteF64) -> op 0xb6 |
| | Convert (F32 F32Op.ReinterpretInt) -> op 0xbe |
| |
| | Convert (F64 F64Op.ConvertSI32) -> op 0xb7 |
| | Convert (F64 F64Op.ConvertUI32) -> op 0xb8 |
| | Convert (F64 F64Op.ConvertSI64) -> op 0xb9 |
| | Convert (F64 F64Op.ConvertUI64) -> op 0xba |
| | Convert (F64 F64Op.PromoteF32) -> op 0xbb |
| | Convert (F64 F64Op.DemoteF64) -> |
| error e.at "illegal instruction f64.demote_f64" |
| | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf |
| |
| | VecConst {it = V128 c; _} -> vecop 0x0cl; v128 c |
| |
| | VecTest (V128 (I8x16 V128Op.AllTrue)) -> vecop 0x63l |
| | VecTest (V128 (I16x8 V128Op.AllTrue)) -> vecop 0x83l |
| | VecTest (V128 (I32x4 V128Op.AllTrue)) -> vecop 0xa3l |
| | VecTest (V128 (I64x2 V128Op.AllTrue)) -> vecop 0xc3l |
| | VecTest (V128 _) -> . |
| |
| | VecUnary (V128 (I8x16 V128Op.Abs)) -> vecop 0x60l |
| | VecUnary (V128 (I8x16 V128Op.Neg)) -> vecop 0x61l |
| | VecUnary (V128 (I8x16 V128Op.Popcnt)) -> vecop 0x62l |
| | VecUnary (V128 (I16x8 V128Op.Abs)) -> vecop 0x80l |
| | VecUnary (V128 (I16x8 V128Op.Neg)) -> vecop 0x81l |
| | VecUnary (V128 (I16x8 V128Op.Popcnt)) -> |
| error e.at "illegal instruction i16x8.popcnt" |
| | VecUnary (V128 (I32x4 V128Op.Abs)) -> vecop 0xa0l |
| | VecUnary (V128 (I32x4 V128Op.Neg)) -> vecop 0xa1l |
| | VecUnary (V128 (I32x4 V128Op.Popcnt)) -> |
| error e.at "illegal instruction i32x4.popcnt" |
| | VecUnary (V128 (I64x2 V128Op.Abs)) -> vecop 0xc0l |
| | VecUnary (V128 (I64x2 V128Op.Neg)) -> vecop 0xc1l |
| | VecUnary (V128 (I64x2 V128Op.Popcnt)) -> |
| error e.at "illegal instruction i64x2.popcnt" |
| | VecUnary (V128 (F32x4 V128Op.Ceil)) -> vecop 0x67l |
| | VecUnary (V128 (F32x4 V128Op.Floor)) -> vecop 0x68l |
| | VecUnary (V128 (F32x4 V128Op.Trunc)) -> vecop 0x69l |
| | VecUnary (V128 (F32x4 V128Op.Nearest)) -> vecop 0x6al |
| | VecUnary (V128 (F64x2 V128Op.Ceil)) -> vecop 0x74l |
| | VecUnary (V128 (F64x2 V128Op.Floor)) -> vecop 0x75l |
| | VecUnary (V128 (F64x2 V128Op.Trunc)) -> vecop 0x7al |
| | VecUnary (V128 (F64x2 V128Op.Nearest)) -> vecop 0x94l |
| | VecUnary (V128 (F32x4 V128Op.Abs)) -> vecop 0xe0l |
| | VecUnary (V128 (F32x4 V128Op.Neg)) -> vecop 0xe1l |
| | VecUnary (V128 (F32x4 V128Op.Sqrt)) -> vecop 0xe3l |
| | VecUnary (V128 (F64x2 V128Op.Abs)) -> vecop 0xecl |
| | VecUnary (V128 (F64x2 V128Op.Neg)) -> vecop 0xedl |
| | VecUnary (V128 (F64x2 V128Op.Sqrt)) -> vecop 0xefl |
| |
| | VecCompare (V128 (I8x16 V128Op.Eq)) -> vecop 0x23l |
| | VecCompare (V128 (I8x16 V128Op.Ne)) -> vecop 0x24l |
| | VecCompare (V128 (I8x16 V128Op.LtS)) -> vecop 0x25l |
| | VecCompare (V128 (I8x16 V128Op.LtU)) -> vecop 0x26l |
| | VecCompare (V128 (I8x16 V128Op.GtS)) -> vecop 0x27l |
| | VecCompare (V128 (I8x16 V128Op.GtU)) -> vecop 0x28l |
| | VecCompare (V128 (I8x16 V128Op.LeS)) -> vecop 0x29l |
| | VecCompare (V128 (I8x16 V128Op.LeU)) -> vecop 0x2al |
| | VecCompare (V128 (I8x16 V128Op.GeS)) -> vecop 0x2bl |
| | VecCompare (V128 (I8x16 V128Op.GeU)) -> vecop 0x2cl |
| | VecCompare (V128 (I16x8 V128Op.Eq)) -> vecop 0x2dl |
| | VecCompare (V128 (I16x8 V128Op.Ne)) -> vecop 0x2el |
| | VecCompare (V128 (I16x8 V128Op.LtS)) -> vecop 0x2fl |
| | VecCompare (V128 (I16x8 V128Op.LtU)) -> vecop 0x30l |
| | VecCompare (V128 (I16x8 V128Op.GtS)) -> vecop 0x31l |
| | VecCompare (V128 (I16x8 V128Op.GtU)) -> vecop 0x32l |
| | VecCompare (V128 (I16x8 V128Op.LeS)) -> vecop 0x33l |
| | VecCompare (V128 (I16x8 V128Op.LeU)) -> vecop 0x34l |
| | VecCompare (V128 (I16x8 V128Op.GeS)) -> vecop 0x35l |
| | VecCompare (V128 (I16x8 V128Op.GeU)) -> vecop 0x36l |
| | VecCompare (V128 (I32x4 V128Op.Eq)) -> vecop 0x37l |
| | VecCompare (V128 (I32x4 V128Op.Ne)) -> vecop 0x38l |
| | VecCompare (V128 (I32x4 V128Op.LtS)) -> vecop 0x39l |
| | VecCompare (V128 (I32x4 V128Op.LtU)) -> vecop 0x3al |
| | VecCompare (V128 (I32x4 V128Op.GtS)) -> vecop 0x3bl |
| | VecCompare (V128 (I32x4 V128Op.GtU)) -> vecop 0x3cl |
| | VecCompare (V128 (I32x4 V128Op.LeS)) -> vecop 0x3dl |
| | VecCompare (V128 (I32x4 V128Op.LeU)) -> vecop 0x3el |
| | VecCompare (V128 (I32x4 V128Op.GeS)) -> vecop 0x3fl |
| | VecCompare (V128 (I32x4 V128Op.GeU)) -> vecop 0x40l |
| | VecCompare (V128 (I64x2 V128Op.Eq)) -> vecop 0xd6l |
| | VecCompare (V128 (I64x2 V128Op.Ne)) -> vecop 0xd7l |
| | VecCompare (V128 (I64x2 V128Op.LtS)) -> vecop 0xd8l |
| | VecCompare (V128 (I64x2 V128Op.LtU)) -> |
| error e.at "illegal instruction i64x2.lt_u" |
| | VecCompare (V128 (I64x2 V128Op.GtS)) -> vecop 0xd9l |
| | VecCompare (V128 (I64x2 V128Op.GtU)) -> |
| error e.at "illegal instruction i64x2.gt_u" |
| | VecCompare (V128 (I64x2 V128Op.LeS)) -> vecop 0xdal |
| | VecCompare (V128 (I64x2 V128Op.LeU)) -> |
| error e.at "illegal instruction i64x2.le_u" |
| | VecCompare (V128 (I64x2 V128Op.GeS)) -> vecop 0xdbl |
| | VecCompare (V128 (I64x2 V128Op.GeU)) -> |
| error e.at "illegal instruction i64x2.ge_u" |
| | VecCompare (V128 (F32x4 V128Op.Eq)) -> vecop 0x41l |
| | VecCompare (V128 (F32x4 V128Op.Ne)) -> vecop 0x42l |
| | VecCompare (V128 (F32x4 V128Op.Lt)) -> vecop 0x43l |
| | VecCompare (V128 (F32x4 V128Op.Gt)) -> vecop 0x44l |
| | VecCompare (V128 (F32x4 V128Op.Le)) -> vecop 0x45l |
| | VecCompare (V128 (F32x4 V128Op.Ge)) -> vecop 0x46l |
| | VecCompare (V128 (F64x2 V128Op.Eq)) -> vecop 0x47l |
| | VecCompare (V128 (F64x2 V128Op.Ne)) -> vecop 0x48l |
| | VecCompare (V128 (F64x2 V128Op.Lt)) -> vecop 0x49l |
| | VecCompare (V128 (F64x2 V128Op.Gt)) -> vecop 0x4al |
| | VecCompare (V128 (F64x2 V128Op.Le)) -> vecop 0x4bl |
| | VecCompare (V128 (F64x2 V128Op.Ge)) -> vecop 0x4cl |
| |
| | VecBinary (V128 (I8x16 (V128Op.Shuffle is))) -> vecop 0x0dl; List.iter byte is |
| | VecBinary (V128 (I8x16 V128Op.Swizzle)) -> vecop 0x0el |
| | VecBinary (V128 (I8x16 V128Op.NarrowS)) -> vecop 0x65l |
| | VecBinary (V128 (I8x16 V128Op.NarrowU)) -> vecop 0x66l |
| | VecBinary (V128 (I8x16 V128Op.Add)) -> vecop 0x6el |
| | VecBinary (V128 (I8x16 V128Op.AddSatS)) -> vecop 0x6fl |
| | VecBinary (V128 (I8x16 V128Op.AddSatU)) -> vecop 0x70l |
| | VecBinary (V128 (I8x16 V128Op.Sub)) -> vecop 0x71l |
| | VecBinary (V128 (I8x16 V128Op.SubSatS)) -> vecop 0x72l |
| | VecBinary (V128 (I8x16 V128Op.SubSatU)) -> vecop 0x73l |
| | VecBinary (V128 (I8x16 V128Op.MinS)) -> vecop 0x76l |
| | VecBinary (V128 (I8x16 V128Op.MinU)) -> vecop 0x77l |
| | VecBinary (V128 (I8x16 V128Op.MaxS)) -> vecop 0x78l |
| | VecBinary (V128 (I8x16 V128Op.MaxU)) -> vecop 0x79l |
| | VecBinary (V128 (I8x16 V128Op.AvgrU)) -> vecop 0x7bl |
| | VecBinary (V128 (I16x8 V128Op.NarrowS)) -> vecop 0x85l |
| | VecBinary (V128 (I16x8 V128Op.NarrowU)) -> vecop 0x86l |
| | VecBinary (V128 (I16x8 V128Op.Add)) -> vecop 0x8el |
| | VecBinary (V128 (I16x8 V128Op.AddSatS)) -> vecop 0x8fl |
| | VecBinary (V128 (I16x8 V128Op.AddSatU)) -> vecop 0x90l |
| | VecBinary (V128 (I16x8 V128Op.Sub)) -> vecop 0x91l |
| | VecBinary (V128 (I16x8 V128Op.SubSatS)) -> vecop 0x92l |
| | VecBinary (V128 (I16x8 V128Op.SubSatU)) -> vecop 0x93l |
| | VecBinary (V128 (I16x8 V128Op.Mul)) -> vecop 0x95l |
| | VecBinary (V128 (I16x8 V128Op.MinS)) -> vecop 0x96l |
| | VecBinary (V128 (I16x8 V128Op.MinU)) -> vecop 0x97l |
| | VecBinary (V128 (I16x8 V128Op.MaxS)) -> vecop 0x98l |
| | VecBinary (V128 (I16x8 V128Op.MaxU)) -> vecop 0x99l |
| | VecBinary (V128 (I16x8 V128Op.AvgrU)) -> vecop 0x9bl |
| | VecBinary (V128 (I16x8 V128Op.ExtMulLowS)) -> vecop 0x9cl |
| | VecBinary (V128 (I16x8 V128Op.ExtMulHighS)) -> vecop 0x9dl |
| | VecBinary (V128 (I16x8 V128Op.ExtMulLowU)) -> vecop 0x9el |
| | VecBinary (V128 (I16x8 V128Op.ExtMulHighU)) -> vecop 0x9fl |
| | VecBinary (V128 (I16x8 V128Op.Q15MulRSatS)) -> vecop 0x82l |
| | VecBinary (V128 (I32x4 V128Op.Add)) -> vecop 0xael |
| | VecBinary (V128 (I32x4 V128Op.Sub)) -> vecop 0xb1l |
| | VecBinary (V128 (I32x4 V128Op.MinS)) -> vecop 0xb6l |
| | VecBinary (V128 (I32x4 V128Op.MinU)) -> vecop 0xb7l |
| | VecBinary (V128 (I32x4 V128Op.MaxS)) -> vecop 0xb8l |
| | VecBinary (V128 (I32x4 V128Op.MaxU)) -> vecop 0xb9l |
| | VecBinary (V128 (I32x4 V128Op.DotS)) -> vecop 0xbal |
| | VecBinary (V128 (I32x4 V128Op.Mul)) -> vecop 0xb5l |
| | VecBinary (V128 (I32x4 V128Op.ExtMulLowS)) -> vecop 0xbcl |
| | VecBinary (V128 (I32x4 V128Op.ExtMulHighS)) -> vecop 0xbdl |
| | VecBinary (V128 (I32x4 V128Op.ExtMulLowU)) -> vecop 0xbel |
| | VecBinary (V128 (I32x4 V128Op.ExtMulHighU)) -> vecop 0xbfl |
| | VecBinary (V128 (I64x2 V128Op.Add)) -> vecop 0xcel |
| | VecBinary (V128 (I64x2 V128Op.Sub)) -> vecop 0xd1l |
| | VecBinary (V128 (I64x2 V128Op.Mul)) -> vecop 0xd5l |
| | VecBinary (V128 (I64x2 V128Op.ExtMulLowS)) -> vecop 0xdcl |
| | VecBinary (V128 (I64x2 V128Op.ExtMulHighS)) -> vecop 0xddl |
| | VecBinary (V128 (I64x2 V128Op.ExtMulLowU)) -> vecop 0xdel |
| | VecBinary (V128 (I64x2 V128Op.ExtMulHighU)) -> vecop 0xdfl |
| | VecBinary (V128 (F32x4 V128Op.Add)) -> vecop 0xe4l |
| | VecBinary (V128 (F32x4 V128Op.Sub)) -> vecop 0xe5l |
| | VecBinary (V128 (F32x4 V128Op.Mul)) -> vecop 0xe6l |
| | VecBinary (V128 (F32x4 V128Op.Div)) -> vecop 0xe7l |
| | VecBinary (V128 (F32x4 V128Op.Min)) -> vecop 0xe8l |
| | VecBinary (V128 (F32x4 V128Op.Max)) -> vecop 0xe9l |
| | VecBinary (V128 (F32x4 V128Op.Pmin)) -> vecop 0xeal |
| | VecBinary (V128 (F32x4 V128Op.Pmax)) -> vecop 0xebl |
| | VecBinary (V128 (F64x2 V128Op.Add)) -> vecop 0xf0l |
| | VecBinary (V128 (F64x2 V128Op.Sub)) -> vecop 0xf1l |
| | VecBinary (V128 (F64x2 V128Op.Mul)) -> vecop 0xf2l |
| | VecBinary (V128 (F64x2 V128Op.Div)) -> vecop 0xf3l |
| | VecBinary (V128 (F64x2 V128Op.Min)) -> vecop 0xf4l |
| | VecBinary (V128 (F64x2 V128Op.Max)) -> vecop 0xf5l |
| | VecBinary (V128 (F64x2 V128Op.Pmin)) -> vecop 0xf6l |
| | VecBinary (V128 (F64x2 V128Op.Pmax)) -> vecop 0xf7l |
| | VecBinary (V128 _) -> |
| error e.at "illegal binary vector instruction" |
| |
| | VecConvert (V128 (I8x16 _)) -> |
| error e.at "illegal i8x16 conversion instruction" |
| | VecConvert (V128 (I16x8 V128Op.ExtendLowS)) -> vecop 0x87l |
| | VecConvert (V128 (I16x8 V128Op.ExtendHighS)) -> vecop 0x88l |
| | VecConvert (V128 (I16x8 V128Op.ExtendLowU)) -> vecop 0x89l |
| | VecConvert (V128 (I16x8 V128Op.ExtendHighU)) -> vecop 0x8al |
| | VecConvert (V128 (I16x8 V128Op.ExtAddPairwiseS)) -> vecop 0x7cl |
| | VecConvert (V128 (I16x8 V128Op.ExtAddPairwiseU)) -> vecop 0x7dl |
| | VecConvert (V128 (I16x8 _)) -> |
| error e.at "illegal i16x8 conversion instruction" |
| | VecConvert (V128 (I32x4 V128Op.ExtendLowS)) -> vecop 0xa7l |
| | VecConvert (V128 (I32x4 V128Op.ExtendHighS)) -> vecop 0xa8l |
| | VecConvert (V128 (I32x4 V128Op.ExtendLowU)) -> vecop 0xa9l |
| | VecConvert (V128 (I32x4 V128Op.ExtendHighU)) -> vecop 0xaal |
| | VecConvert (V128 (I32x4 V128Op.ExtAddPairwiseS)) -> vecop 0x7el |
| | VecConvert (V128 (I32x4 V128Op.ExtAddPairwiseU)) -> vecop 0x7fl |
| | VecConvert (V128 (I32x4 V128Op.TruncSatSF32x4)) -> vecop 0xf8l |
| | VecConvert (V128 (I32x4 V128Op.TruncSatUF32x4)) -> vecop 0xf9l |
| | VecConvert (V128 (I32x4 V128Op.TruncSatSZeroF64x2)) -> vecop 0xfcl |
| | VecConvert (V128 (I32x4 V128Op.TruncSatUZeroF64x2)) -> vecop 0xfdl |
| | VecConvert (V128 (I64x2 V128Op.ExtendLowS)) -> vecop 0xc7l |
| | VecConvert (V128 (I64x2 V128Op.ExtendHighS)) -> vecop 0xc8l |
| | VecConvert (V128 (I64x2 V128Op.ExtendLowU)) -> vecop 0xc9l |
| | VecConvert (V128 (I64x2 V128Op.ExtendHighU)) -> vecop 0xcal |
| | VecConvert (V128 (I64x2 _)) -> |
| error e.at "illegal i64x2 conversion instruction" |
| | VecConvert (V128 (F32x4 V128Op.DemoteZeroF64x2)) -> vecop 0x5el |
| | VecConvert (V128 (F32x4 V128Op.PromoteLowF32x4)) -> |
| error e.at "illegal instruction f32x4.promote_low_f32x4" |
| | VecConvert (V128 (F32x4 V128Op.ConvertSI32x4)) -> vecop 0xfal |
| | VecConvert (V128 (F32x4 V128Op.ConvertUI32x4)) -> vecop 0xfbl |
| | VecConvert (V128 (F64x2 V128Op.DemoteZeroF64x2)) -> |
| error e.at "illegal instruction f64x2.demote_zero_f64x2" |
| | VecConvert (V128 (F64x2 V128Op.PromoteLowF32x4)) -> vecop 0x5fl |
| | VecConvert (V128 (F64x2 V128Op.ConvertSI32x4)) -> vecop 0xfel |
| | VecConvert (V128 (F64x2 V128Op.ConvertUI32x4)) -> vecop 0xffl |
| |
| | VecShift (V128 (I8x16 V128Op.Shl)) -> vecop 0x6bl |
| | VecShift (V128 (I8x16 V128Op.ShrS)) -> vecop 0x6cl |
| | VecShift (V128 (I8x16 V128Op.ShrU)) -> vecop 0x6dl |
| | VecShift (V128 (I16x8 V128Op.Shl)) -> vecop 0x8bl |
| | VecShift (V128 (I16x8 V128Op.ShrS)) -> vecop 0x8cl |
| | VecShift (V128 (I16x8 V128Op.ShrU)) -> vecop 0x8dl |
| | VecShift (V128 (I32x4 V128Op.Shl)) -> vecop 0xabl |
| | VecShift (V128 (I32x4 V128Op.ShrS)) -> vecop 0xacl |
| | VecShift (V128 (I32x4 V128Op.ShrU)) -> vecop 0xadl |
| | VecShift (V128 (I64x2 V128Op.Shl)) -> vecop 0xcbl |
| | VecShift (V128 (I64x2 V128Op.ShrS)) -> vecop 0xccl |
| | VecShift (V128 (I64x2 V128Op.ShrU)) -> vecop 0xcdl |
| | VecShift (V128 _) -> . |
| |
| | VecBitmask (V128 (I8x16 V128Op.Bitmask)) -> vecop 0x64l |
| | VecBitmask (V128 (I16x8 V128Op.Bitmask)) -> vecop 0x84l |
| | VecBitmask (V128 (I32x4 V128Op.Bitmask)) -> vecop 0xa4l |
| | VecBitmask (V128 (I64x2 V128Op.Bitmask)) -> vecop 0xc4l |
| | VecBitmask (V128 _) -> . |
| |
| | VecTestBits (V128 V128Op.AnyTrue) -> vecop 0x53l |
| | VecUnaryBits (V128 V128Op.Not) -> vecop 0x4dl |
| | VecBinaryBits (V128 V128Op.And) -> vecop 0x4el |
| | VecBinaryBits (V128 V128Op.AndNot) -> vecop 0x4fl |
| | VecBinaryBits (V128 V128Op.Or) -> vecop 0x50l |
| | VecBinaryBits (V128 V128Op.Xor) -> vecop 0x51l |
| | VecTernaryBits (V128 V128Op.Bitselect) -> vecop 0x52l |
| |
| | VecSplat (V128 ((I8x16 V128Op.Splat))) -> vecop 0x0fl |
| | VecSplat (V128 ((I16x8 V128Op.Splat))) -> vecop 0x10l |
| | VecSplat (V128 ((I32x4 V128Op.Splat))) -> vecop 0x11l |
| | VecSplat (V128 ((I64x2 V128Op.Splat))) -> vecop 0x12l |
| | VecSplat (V128 ((F32x4 V128Op.Splat))) -> vecop 0x13l |
| | VecSplat (V128 ((F64x2 V128Op.Splat))) -> vecop 0x14l |
| |
| | VecExtract (V128 (I8x16 (V128Op.Extract (i, SX)))) -> vecop 0x15l; byte i |
| | VecExtract (V128 (I8x16 (V128Op.Extract (i, ZX)))) -> vecop 0x16l; byte i |
| | VecExtract (V128 (I16x8 (V128Op.Extract (i, SX)))) -> vecop 0x18l; byte i |
| | VecExtract (V128 (I16x8 (V128Op.Extract (i, ZX)))) -> vecop 0x19l; byte i |
| | VecExtract (V128 (I32x4 (V128Op.Extract (i, ())))) -> vecop 0x1bl; byte i |
| | VecExtract (V128 (I64x2 (V128Op.Extract (i, ())))) -> vecop 0x1dl; byte i |
| | VecExtract (V128 (F32x4 (V128Op.Extract (i, ())))) -> vecop 0x1fl; byte i |
| | VecExtract (V128 (F64x2 (V128Op.Extract (i, ())))) -> vecop 0x21l; byte i |
| |
| | VecReplace (V128 (I8x16 (V128Op.Replace i))) -> vecop 0x17l; byte i |
| | VecReplace (V128 (I16x8 (V128Op.Replace i))) -> vecop 0x1al; byte i |
| | VecReplace (V128 (I32x4 (V128Op.Replace i))) -> vecop 0x1cl; byte i |
| | VecReplace (V128 (I64x2 (V128Op.Replace i))) -> vecop 0x1el; byte i |
| | VecReplace (V128 (F32x4 (V128Op.Replace i))) -> vecop 0x20l; byte i |
| | VecReplace (V128 (F64x2 (V128Op.Replace i))) -> vecop 0x22l; byte i |
| |
| let const c = |
| list instr c.it; end_ () |
| |
| |
| (* Sections *) |
| |
| let section id f x needed = |
| if needed then begin |
| byte id; |
| let g = gap32 () in |
| let p = pos s in |
| f x; |
| patch_gap32 g (pos s - p) |
| end |
| |
| |
| (* Type section *) |
| |
| let type_ t = func_type t.it |
| |
| let type_section ts = |
| section 1 (vec type_) ts (ts <> []) |
| |
| |
| (* Import section *) |
| |
| let import_desc d = |
| match d.it with |
| | FuncImport x -> byte 0x00; var x |
| | TableImport t -> byte 0x01; table_type t |
| | MemoryImport t -> byte 0x02; memory_type t |
| | GlobalImport t -> byte 0x03; global_type t |
| |
| let import im = |
| let {module_name; item_name; idesc} = im.it in |
| name module_name; name item_name; import_desc idesc |
| |
| let import_section ims = |
| section 2 (vec import) ims (ims <> []) |
| |
| |
| (* Function section *) |
| |
| let func f = var f.it.ftype |
| |
| let func_section fs = |
| section 3 (vec func) fs (fs <> []) |
| |
| |
| (* Table section *) |
| |
| let table tab = |
| let {ttype} = tab.it in |
| table_type ttype |
| |
| let table_section tabs = |
| section 4 (vec table) tabs (tabs <> []) |
| |
| |
| (* Memory section *) |
| |
| let memory mem = |
| let {mtype} = mem.it in |
| memory_type mtype |
| |
| let memory_section mems = |
| section 5 (vec memory) mems (mems <> []) |
| |
| |
| (* Global section *) |
| |
| let global g = |
| let {gtype; ginit} = g.it in |
| global_type gtype; const ginit |
| |
| let global_section gs = |
| section 6 (vec global) gs (gs <> []) |
| |
| |
| (* Export section *) |
| |
| let export_desc d = |
| match d.it with |
| | FuncExport x -> byte 0; var x |
| | TableExport x -> byte 1; var x |
| | MemoryExport x -> byte 2; var x |
| | GlobalExport x -> byte 3; var x |
| |
| let export ex = |
| let {name = n; edesc} = ex.it in |
| name n; export_desc edesc |
| |
| let export_section exs = |
| section 7 (vec export) exs (exs <> []) |
| |
| |
| (* Start section *) |
| |
| let start st = |
| let {sfunc} = st.it in |
| var sfunc |
| |
| let start_section xo = |
| section 8 (opt start) xo (xo <> None) |
| |
| |
| (* Code section *) |
| |
| let local (t, n) = len n; value_type t |
| |
| let locals locs = |
| let combine t = function |
| | (t', n) :: ts when t = t' -> (t, n + 1) :: ts |
| | ts -> (t, 1) :: ts |
| in vec local (List.fold_right combine locs []) |
| |
| let code f = |
| let {locals = locs; body; _} = f.it in |
| let g = gap32 () in |
| let p = pos s in |
| locals locs; |
| list instr body; |
| end_ (); |
| patch_gap32 g (pos s - p) |
| |
| let code_section fs = |
| section 10 (vec code) fs (fs <> []) |
| |
| |
| (* Element section *) |
| |
| let is_elem_kind = function |
| | FuncRefType -> true |
| | _ -> false |
| |
| let elem_kind = function |
| | FuncRefType -> byte 0x00 |
| | _ -> assert false |
| |
| let is_elem_index e = |
| match e.it with |
| | [{it = RefFunc _; _}] -> true |
| | _ -> false |
| |
| let elem_index e = |
| match e.it with |
| | [{it = RefFunc x; _}] -> var x |
| | _ -> assert false |
| |
| let elem seg = |
| let {etype; einit; emode} = seg.it in |
| if is_elem_kind etype && List.for_all is_elem_index einit then |
| match emode.it with |
| | Passive -> |
| u32 0x01l; elem_kind etype; vec elem_index einit |
| | Active {index; offset} when index.it = 0l && is_elem_kind etype -> |
| u32 0x00l; const offset; vec elem_index einit |
| | Active {index; offset} -> |
| u32 0x02l; |
| var index; const offset; elem_kind etype; vec elem_index einit |
| | Declarative -> |
| u32 0x03l; elem_kind etype; vec elem_index einit |
| else |
| match emode.it with |
| | Passive -> |
| u32 0x05l; ref_type etype; vec const einit |
| | Active {index; offset} when index.it = 0l && is_elem_kind etype -> |
| u32 0x04l; const offset; vec const einit |
| | Active {index; offset} -> |
| u32 0x06l; var index; const offset; ref_type etype; vec const einit |
| | Declarative -> |
| u32 0x07l; ref_type etype; vec const einit |
| |
| let elem_section elems = |
| section 9 (vec elem) elems (elems <> []) |
| |
| |
| (* Data section *) |
| |
| let data seg = |
| let {dinit; dmode} = seg.it in |
| match dmode.it with |
| | Passive -> |
| u32 0x01l; string dinit |
| | Active {index; offset} when index.it = 0l -> |
| u32 0x00l; const offset; string dinit |
| | Active {index; offset} -> |
| u32 0x02l; var index; const offset; string dinit |
| | Declarative -> |
| error dmode.at "illegal declarative data segment" |
| |
| let data_section datas = |
| section 11 (vec data) datas (datas <> []) |
| |
| |
| (* Data count section *) |
| |
| let data_count_section datas m = |
| section 12 len (List.length datas) Free.((module_ m).datas <> Set.empty) |
| |
| |
| (* Custom section *) |
| |
| let custom (n, bs) = |
| name n; |
| put_string s bs |
| |
| let custom_section n bs = |
| section 0 custom (n, bs) true |
| |
| |
| (* Module *) |
| |
| let module_ m = |
| word32 0x6d736100l; |
| word32 version; |
| type_section m.it.types; |
| import_section m.it.imports; |
| func_section m.it.funcs; |
| table_section m.it.tables; |
| memory_section m.it.memories; |
| global_section m.it.globals; |
| export_section m.it.exports; |
| start_section m.it.start; |
| elem_section m.it.elems; |
| data_count_section m.it.datas m; |
| code_section m.it.funcs; |
| data_section m.it.datas |
| end |
| |
| |
| let encode m = |
| let module E = E (struct let stream = stream () end) in |
| E.module_ m; to_string E.s |
| |
| let encode_custom name content = |
| let module E = E (struct let stream = stream () end) in |
| E.custom_section name content; to_string E.s |
