├── LICENSE ├── README.md └── main.rkt /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "{}" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright {yyyy} {name of copyright owner} 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | 203 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | wasm-redex 2 | ---------- 3 | 4 | This is a (unofficial) Redex model of the WebAssembly formalism from the paper 5 | 6 | ["Bringing the Web up to Speed with WebAssembly"](https://dl.acm.org/citation.cfm?doid=3062341.3062363) by Haas et al. 7 | 8 | It aims to model the reduction semantics of wasm but it doesn't quite cover 9 | everything in the paper. It's missing the following at least: 10 | 11 | * module instantiation semantics 12 | * static type system / validation 13 | 14 | and of course likely has various bugs. 15 | 16 | See also: the wasm [reference interpreter & spec](https://github.com/WebAssembly/spec). 17 | 18 | --- 19 | 20 | Copyright © 2019 Asumu Takikawa 21 | 22 | Licensed under Apache License 2.0, the same as the [reference interpreter & tests](https://github.com/WebAssembly/spec/blob/master/LICENSE). 23 | 24 | Attribution: many of the tests are derived from the reference tests. 25 | -------------------------------------------------------------------------------- /main.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | ;; This is a redex model of the semantics of webassembly from the paper 4 | ;; "Bringing the Web up to Speed with WebAssembly" 5 | ;; Haas et al. 6 | 7 | (require redex 8 | data/bit-vector 9 | pict 10 | pict/snip 11 | racket/draw 12 | racket/fixnum 13 | rnrs/arithmetic/bitwise-6) 14 | 15 | ;; wasm defines memory for module instances in 64Ki increments, but this is 16 | ;; unwieldly in redex so we define the increment in bytes here 17 | (define *page-size* 20) 18 | 19 | ;; some non-terminals (like for modules) differ from the paper due to redex 20 | ;; constraints on non-terminals appearing as keywords, and some forms have 21 | ;; extra keywords for ease of identification 22 | (define-language wasm-lang 23 | ;; types 24 | (t ::= t-i t-f) 25 | (t-f ::= f32 f64) 26 | (t-i ::= i32 i64) 27 | (tp ::= i8 i16 i32) 28 | (sx ::= sx-s sx-u) ; renamed to avoid conflict with s non-terminal 29 | (tf ::= (-> (t ...) (t ...))) 30 | (tg ::= t (mut t)) 31 | 32 | ;; instructions 33 | (e-no-v ::= unreachable 34 | nop 35 | drop 36 | select 37 | (block tf e*) 38 | (loop tf e*) 39 | (if tf e* else e*) 40 | (br i) 41 | (br-if i) 42 | (br-table i i ...) 43 | return 44 | (call i) 45 | (call-indirect tf) 46 | (get-local i) 47 | (set-local i) 48 | (tee-local i) 49 | (get-global i) 50 | (set-global i) 51 | (load t a o) 52 | (load t tp sx a o) 53 | (store t a o) 54 | (store t tp a o) 55 | current-memory 56 | grow-memory 57 | ;; prim ops become a little verbose due to type constraints 58 | (unop-i t-i) 59 | (unop-f t-f) 60 | (binop-i t-i) 61 | (binop-f t-f) 62 | (testop-i t-i) 63 | (relop-i t-i) 64 | (relop-f t-f) 65 | (cvtop t t) 66 | (cvtop t t sx)) 67 | (e ::= e-no-v 68 | (const t c)) 69 | 70 | ;; primitive operations 71 | [unop ::= unop-i unop-f] 72 | (unop-i ::= clz ctz popcnt) 73 | (unop-f ::= neg abs ceil floor trunc nearest sqrt) 74 | [binop ::= binop-i binop-f] 75 | (binop-i ::= add sub mul div-s div-u rem-s rem-u and 76 | or xor shl shr-s shr-u rotl rotr) 77 | (binop-f ::= add sub mul div min max copysign) 78 | (testop ::= testop-i) 79 | (testop-i ::= eqz) 80 | (relop ::= relop-i relop-f) 81 | (relop-i ::= eq ne lt-u lt-s gt-u gt-s le-u le-s ge-u ge-s) 82 | (relop-f ::= eq ne lt gt le ge) 83 | (cvtop ::= convert reinterpret) 84 | 85 | ;; sequences of expressions 86 | ;; (we use this to avoid splicing) 87 | (e* ::= ϵ 88 | (e e*)) 89 | 90 | (c ::= number) 91 | 92 | ;; constant numerals 93 | ((i j l k m n a o) integer) 94 | 95 | ;; bytes 96 | (b ::= integer) 97 | 98 | ;; modules & functions 99 | (f ::= (func (ex ...) tf local (t ...) e*) 100 | (func (ex ...) tf im)) 101 | (m-glob ::= (global (ex ...) tg e ...) 102 | (global (ex ...) tg im)) 103 | (m-tab ::= (table (ex ...) n i ...) 104 | (table (ex ...) n im)) 105 | (m-mem ::= (memory (ex ...) n) 106 | (memory (ex ...) n im)) 107 | (im ::= (import string string)) 108 | (ex ::= (export string)) 109 | (mod ::= (module f ... m-glob ...) 110 | (module f ... m-glob ... m-tab) 111 | (module f ... m-glob ... m-mem) 112 | (module f ... m-glob ... m-tab m-mem))) 113 | 114 | (define-extended-language wasm-runtime-lang wasm-lang 115 | ;; administrative expressions 116 | (e-no-v ::= .... 117 | trap 118 | (call cl) 119 | (label n {e*} e*) 120 | (local n {i (v ...)} e*)) 121 | 122 | ;; runtime 123 | (s ::= {(inst modinst ...) (tab tabinst ...) (mem meminst ...)}) 124 | (modinst ::= {(func cl ...) (glob v ...)} 125 | {(func cl ...) (glob v ...) (tab i)} 126 | {(func cl ...) (glob v ...) (mem i)} 127 | {(func cl ...) (glob v ...) (tab i) (mem i)}) 128 | (tabinst ::= (cl ...)) 129 | (meminst ::= (b ...)) 130 | (cl ::= {(inst i) (code f)}) 131 | 132 | (F ::= (v ...)) 133 | ;; this is needed for the actual spec 134 | #; 135 | (F ::= {(locals v ...) (module modinst)}) 136 | 137 | (v ::= (const t c)) 138 | (v* ::= ϵ 139 | (v v*)) 140 | 141 | ;; evaluation contexts 142 | ;; using an inductive definition instead of using sequences because 143 | ;; we would need splicing holes otherwise 144 | (E ::= hole 145 | (v E) 146 | ((label n (e*) E) e*))) 147 | 148 | ;; helper for constructing instruction sequences 149 | (define-metafunction wasm-runtime-lang 150 | seq : e ... -> e* 151 | [(seq) ϵ] 152 | [(seq e_0 e_1 ...) 153 | (e_0 (seq e_1 ...))]) 154 | 155 | (define-metafunction wasm-runtime-lang 156 | seq* : e ... e* -> e* 157 | [(seq* e*) e*] 158 | [(seq* e_0 e_1 ... e*_2) 159 | (e_0 (seq* e_1 ... e*_2))]) 160 | 161 | ;; append two e* expression lists 162 | (define-metafunction wasm-runtime-lang 163 | e*-append : e* e* -> e* 164 | [(e*-append ϵ e*) e*] 165 | [(e*-append (e_0 e*_0) e*_1) 166 | (e_0 (e*-append e*_0 e*_1))]) 167 | 168 | (module+ test 169 | (test-equal (term (e*-append ϵ (drop ϵ))) 170 | (term (drop ϵ))) 171 | (test-equal (term (e*-append ((const i32 0) ϵ) (drop ϵ))) 172 | (term ((const i32 0) (drop ϵ))))) 173 | 174 | ;; find the nesting depth of values around the hole in the eval context 175 | (define-metafunction wasm-runtime-lang 176 | v-depth : E -> number 177 | [(v-depth hole) 0] 178 | [(v-depth (in-hole E (v hole))) 179 | ,(add1 (term (v-depth E)))] 180 | [(v-depth (in-hole E ((label n {e*_0} hole) e*_1))) 181 | 0]) 182 | 183 | (module+ test 184 | (test-equal (term (v-depth hole)) (term 0)) 185 | (test-equal (term (v-depth ((const i32 2) ((const i32 1) hole)))) 186 | (term 2)) 187 | (test-equal (term (v-depth ((label 1 {ϵ} ((const i32 1) hole)) ϵ))) 188 | (term 1)) 189 | (test-equal (term (v-depth ((const i32 2) ((label 1 {ϵ} ((const i32 1) hole)) ϵ)))) 190 | (term 1))) 191 | 192 | ;; split an eval context into two contexts: 193 | ;; - an outer context surrounding the second 194 | ;; - an inner context with nested values around a hole 195 | ;; precondition: E actually has l-nested values when called 196 | (define-metafunction wasm-runtime-lang 197 | v-split : E number -> (E E) 198 | [(v-split hole l) 199 | (hole hole)] 200 | [(v-split (in-hole E (v hole)) 0) 201 | ((in-hole E_outer (v hole)) hole) 202 | (where (E_outer hole) (v-split E 0))] 203 | [(v-split (in-hole E (v hole)) l) 204 | (E_outer (in-hole E_v (v hole))) 205 | (where (E_outer E_v) (v-split E ,(sub1 (term l))))] 206 | [(v-split (in-hole E ((label n {e*_0} hole) e*_2)) 0) 207 | ((in-hole E_outer ((label n {e*_0} hole) e*_2)) 208 | hole) 209 | (where (E_outer hole) (v-split E 0))]) 210 | 211 | (module+ test 212 | (test-equal (term (v-split hole 0)) 213 | (term (hole hole))) 214 | (test-equal (term (v-split ((const i32 2) ((const i32 1) hole)) 1)) 215 | (term (((const i32 2) hole) 216 | ((const i32 1) hole)))) 217 | (test-equal (term (v-split ((label 1 {ϵ} ((const i32 0) ((const i32 1) hole))) ϵ) 1)) 218 | (term (((label 1 {ϵ} ((const i32 0) hole)) ϵ) 219 | ((const i32 1) hole))))) 220 | 221 | ;; find the depth of label nestings in E 222 | (define-metafunction wasm-runtime-lang 223 | label-depth : E -> number 224 | [(label-depth hole) 0] 225 | [(label-depth (v E)) (label-depth E)] 226 | [(label-depth ((label n {e*_0} E) e*_1)) 227 | ,(add1 (term (label-depth E)))]) 228 | 229 | (module+ test 230 | (test-equal (term (label-depth hole)) 0) 231 | (test-equal (term (label-depth ((const i32 2) ((const i32 1) hole)))) 232 | 0) 233 | (test-equal (term (label-depth ((label 1 {ϵ} ((const i32 0) ((const i32 1) hole))) ϵ))) 234 | 1) 235 | (test-equal (term (label-depth ((label 1 {ϵ} ((const i32 0) ((const i32 1) ((label 1 {ϵ} hole) ϵ)))) ϵ))) 236 | 2)) 237 | 238 | ;; extract a closure out of the func part of store 239 | (define-metafunction wasm-runtime-lang 240 | store-func : s i j -> cl 241 | [(store-func {(inst modinst_0 ... modinst modinst_1 ...) any_0 ...} i j) 242 | cl 243 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 244 | (where {(func cl_0 ... cl cl_1 ...) any_1 ...} modinst) 245 | (side-condition (= (length (term (cl_0 ...))) (term j)))]) 246 | 247 | (module+ test 248 | (let () 249 | (define f1 (term (func () (-> () ()) local () (seq nop)))) 250 | (define modinst1 (term {(func {(inst 0) (code ,f1)}) (glob)})) 251 | (test-equal (term (store-func {(inst ,modinst1) (tab) (mem)} 0 0)) 252 | (term {(inst 0) (code ,f1)})))) 253 | 254 | ;; extract a closure from the tab part of store 255 | (define-metafunction wasm-runtime-lang 256 | store-tab : s i j -> cl 257 | [(store-tab {(inst modinst_0 ... modinst modinst_1 ...) 258 | (tab tabinst_0 ... tabinst tabinst_1 ...) 259 | any_0 ...} 260 | i j) 261 | cl 262 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 263 | (where {any_1 ... (tab i_tab) any_2 ...} modinst) 264 | (side-condition (= (length (term (tabinst_0 ...))) (term i_tab))) 265 | (where (cl_0 ... cl cl_1 ...) tabinst) 266 | (side-condition (= (length (term (cl_0 ...))) (term j)))]) 267 | 268 | ;; read a global value 269 | (define-metafunction wasm-runtime-lang 270 | store-glob : s i j -> v 271 | [(store-glob {(inst modinst_0 ... modinst modinst_1 ...) any_0 ...} i j) 272 | v 273 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 274 | (where {any_f (glob v_0 ... v v_1 ...) any_1 ...} modinst) 275 | (side-condition (= (length (term (v_0 ...))) (term j)))]) 276 | 277 | ;; write a global value 278 | (define-metafunction wasm-runtime-lang 279 | store-glob= : s i j v -> s 280 | [(store-glob= {(inst modinst_0 ... modinst modinst_1 ...) any_0 ...} i j v_new) 281 | {(inst modinst_0 ... modinst_new modinst_1 ...) any_0 ...} 282 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 283 | (where {any_f (glob v_0 ... v v_1 ...) any_1 ...} modinst) 284 | (side-condition (= (length (term (v_0 ...))) (term j))) 285 | (where modinst_new {any_f (glob v_0 ... v_new v_1 ...) any_1 ...})]) 286 | 287 | ;; read from memory 288 | (define-metafunction wasm-runtime-lang 289 | store-mem : s i j n -> (b ...) or #false 290 | [(store-mem {(inst modinst_0 ... modinst modinst_1 ...) 291 | any_1 292 | (mem meminst_0 ... meminst meminst_1 ...)} 293 | i j n) 294 | (b ...) 295 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 296 | (where {any_i ... (mem i_mem)} modinst) 297 | (side-condition (= (length (term (meminst_0 ...))) (term i_mem))) 298 | (where (b_0 ... b_rest ...) meminst) 299 | (side-condition (= (length (term (b_0 ...))) (term j))) 300 | (where (b ... b_end ...) (b_rest ...)) 301 | (side-condition (= (length (term (b ...))) (term n)))] 302 | [(store-mem any ...) 303 | #false]) 304 | 305 | (define-metafunction wasm-runtime-lang 306 | sizeof : any -> n 307 | [(sizeof i8) 1] 308 | [(sizeof i16) 2] 309 | [(sizeof i32) 4] 310 | [(sizeof i64) 8] 311 | [(sizeof f32) 4] 312 | [(sizeof f64) 8]) 313 | 314 | (define-metafunction wasm-runtime-lang 315 | const-reinterpret-packed : t (b ...) sx -> c 316 | [(const-reinterpret-packed t (b ...) sx-s) 317 | ,(integer-bytes->integer (list->bytes (term (b ...))) #t)] 318 | [(const-reinterpret-packed t (b ...) sx-u) 319 | ,(integer-bytes->integer (list->bytes (term (b ...))) #f)]) 320 | 321 | (define-metafunction wasm-runtime-lang 322 | const-reinterpret : t (b ...) -> c 323 | [(const-reinterpret t-i (b ...)) 324 | ,(integer-bytes->integer (list->bytes (term (b ...))) #t)] 325 | [(const-reinterpret t-f (b ...)) 326 | ,(floating-point-bytes->real (list->bytes (term (b ...))))]) 327 | 328 | (define-metafunction wasm-runtime-lang 329 | bits : n t c -> (b ...) 330 | [(bits n i32 i) 331 | ,(take (bytes->list (integer->integer-bytes (term i) 4 #t)) (term n))] 332 | [(bits n i64 i) 333 | ,(take (bytes->list (integer->integer-bytes (term i) 8 #t)) (term n))] 334 | [(bits n f32 float) 335 | ,(take (bytes->list (real->floating-point-bytes (term float) 4)) (term n))] 336 | [(bits n f64 float) 337 | ,(take (bytes->list (real->floating-point-bytes (term float) 8)) (term n))]) 338 | 339 | (define-metafunction wasm-runtime-lang 340 | store-mem= : s i j n (b ...) -> s or #false 341 | [(store-mem= {(name any_0 (inst modinst_0 ... modinst modinst_1 ...)) 342 | any_1 343 | (mem meminst_0 ... meminst meminst_1 ...)} 344 | i j n (b_new ...)) 345 | {any_0 any_1 (mem meminst_0 ... meminst_new meminst_1 ...)} 346 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 347 | (where {any_i ... (mem i_mem)} modinst) 348 | (side-condition (= (length (term (meminst_0 ...))) (term i_mem))) 349 | (where (b_0 ... b_rest ...) meminst) 350 | (side-condition (= (length (term (b_0 ...))) (term j))) 351 | (where (b ... b_end ...) (b_rest ...)) 352 | (side-condition (= (length (term (b ...))) (term n))) 353 | (where meminst_new (b_0 ... b_new ... b_end ...))] 354 | [(store-mem= any ...) #false]) 355 | 356 | ;; metafunctions for manipulating memory size 357 | (define-metafunction wasm-runtime-lang 358 | memory-size : s i -> n 359 | [(memory-size {(name any_0 (inst modinst_0 ... modinst modinst_1 ...)) 360 | any_1 361 | (mem meminst_0 ... meminst meminst_1 ...)} 362 | i) 363 | n_size 364 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 365 | (where {any_i ... (mem i_mem)} modinst) 366 | (side-condition (= (length (term (meminst_0 ...))) (term i_mem))) 367 | (where n_size ,(/ (length (term meminst)) *page-size*))]) 368 | 369 | (define-metafunction wasm-runtime-lang 370 | expand-memory : s i k -> (s n) 371 | [(expand-memory {(name any_0 (inst modinst_0 ... modinst modinst_1 ...)) 372 | any_1 373 | (mem meminst_0 ... meminst meminst_1 ...)} 374 | i k) 375 | (s_new n_size) 376 | (side-condition (= (length (term (modinst_0 ...))) (term i))) 377 | (where {any_i ... (mem i_mem)} modinst) 378 | (side-condition (= (length (term (meminst_0 ...))) (term i_mem))) 379 | (where meminst_new ,(append (term meminst) 380 | (flatten (make-list (term k) (make-list *page-size* 0))))) 381 | (where n_size ,(/ (length (term meminst_new)) *page-size*)) 382 | (where s_new {any_0 any_1 (mem meminst_0 ... meminst_new meminst_1 ...)})]) 383 | 384 | ;; conversion between types 385 | ;; precondition: validation passed 386 | ;; FIXME: this is probably not quite right 387 | (define-metafunction wasm-runtime-lang 388 | cvt : t t c -> c 389 | [(cvt t-i_1 t-i_2 c) 390 | ,(integer-bytes->integer 391 | (integer->integer-bytes (term c) (term (sizeof t-i)) #t) 392 | #t)] 393 | [(cvt t i32 c) ,(real->single-flonum (term c))] 394 | [(cvt t i64 c) ,(real->double-flonum (term c))] 395 | [(cvt f32 t-i c) ,(fl->fx (real->single-flonum (term c)))] 396 | [(cvt f64 t-i c) ,(fl->fx (real->double-flonum (term c)))]) 397 | 398 | ;; TODO: implement properly 399 | (define-metafunction wasm-runtime-lang 400 | cvt-sx : t t c -> c) 401 | 402 | ;; extract the code from a closure 403 | (define-metafunction wasm-runtime-lang 404 | cl-code : cl -> f 405 | [(cl-code {any (code f)}) f]) 406 | 407 | ;; extract the instance index from a closure 408 | (define-metafunction wasm-runtime-lang 409 | cl-inst : cl -> i 410 | [(cl-inst {(inst i) any}) i]) 411 | 412 | ;; append two Fs together 413 | (define-metafunction wasm-runtime-lang 414 | F-append : F F -> F 415 | [(F-append () F) F] 416 | [(F-append (v_1 ... v) (v_2 ...)) 417 | (F-append (v_1 ...) (v v_2 ...))]) 418 | 419 | ;; convert a nested v* to a (v ...), uses accumulator 420 | (define-metafunction wasm-runtime-lang 421 | v*->F : v* -> F 422 | [(v*->F v*) (v*->F-helper v* ())]) 423 | 424 | (define-metafunction wasm-runtime-lang 425 | v*->F-helper : v* F -> F 426 | [(v*->F-helper ϵ F) F] 427 | [(v*->F-helper (v v*) (v_acc ...)) 428 | (v*->F-helper v* (v_acc ... v))]) 429 | 430 | ;; the opposite of v*->F, just used for visualization 431 | (define-metafunction wasm-runtime-lang 432 | F->v* : F -> v* 433 | [(F->v* ()) ϵ] 434 | [(F->v* (v v_0 ...)) (v (F->v* (v_0 ...)))]) 435 | 436 | ;; ctz / clz 437 | (define (clz n width) 438 | (let loop ([pos (sub1 width)] [count 0]) 439 | (cond [(< pos 0) count] 440 | [(not (bitwise-bit-set? n pos)) 441 | (loop (sub1 pos) (add1 count))] 442 | [else count]))) 443 | 444 | (define (ctz n width) 445 | (let loop ([pos 0] [count 0]) 446 | (cond [(> pos (sub1 width)) count] 447 | [(not (bitwise-bit-set? n pos)) 448 | (loop (add1 pos) (add1 count))] 449 | [else count]))) 450 | 451 | ;; implement primitives 452 | (define-metafunction wasm-runtime-lang 453 | do-unop : unop t c -> c 454 | [(do-unop clz i32 c) ,(clz (term c) 32)] 455 | [(do-unop clz i64 c) ,(clz (term c) 64)] 456 | [(do-unop ctz i32 c) ,(ctz (term c) 32)] 457 | [(do-unop ctz i32 c) ,(ctz (term c) 64)] 458 | [(do-unop popcnt t-i c) 459 | ,(bit-vector-popcount (string->bit-vector (number->string (term c) 2)))] 460 | [(do-unop neg t-f c) ,(- (term c))] 461 | [(do-unop abs t-f c) ,(abs (term c))] 462 | [(do-unop ceil t-f c) ,(ceiling (term c))] 463 | [(do-unop floor t-f c) ,(floor (term c))] 464 | [(do-unop trunc t-f c) ,(truncate (term c))] 465 | [(do-unop nearest t-f c) ,(round (term c))] 466 | [(do-unop sqrt t-f c) ,(sqrt (term c))]) 467 | 468 | (define (clamp type const) 469 | (cond [(< const 0) 470 | (define start (if (eq? type 'i32) 32 64)) 471 | (define end (integer-length const)) 472 | (for/fold ([const const]) 473 | ([i (in-range start end)]) 474 | (bitwise-and const (arithmetic-shift 1 i)))] 475 | [else 476 | (bitwise-and const 477 | (if (eq? type 'i32) 478 | #xFFFFFFFF 479 | #xFFFFFFFFFFFFFFFF))])) 480 | 481 | (define-metafunction wasm-runtime-lang 482 | do-binop : binop t c c -> c 483 | [(do-binop add t-i c_1 c_2) ,(clamp (term t-i) (+ (term c_1) (term c_2)))] 484 | [(do-binop sub t-i c_1 c_2) ,(clamp (term t-i) (- (term c_1) (term c_2)))] 485 | [(do-binop mul t-i c_1 c_2) ,(clamp (term t-i) (* (term c_1) (term c_2)))] 486 | ;; FIXME: needs to account for sign and bit range properly 487 | [(do-binop div-s t-i c_1 c_2) ,(quotient (term c_1) (term c_2))] 488 | [(do-binop div-u t-i c_1 c_2) ,(quotient (term c_1) (term c_2))] 489 | [(do-binop div-s t-i c_1 0) #false] 490 | [(do-binop div-u t-i c_1 0) #false] 491 | [(do-binop rem-s t-i c_1 c_2) ,(remainder (term c_1) (term c_2))] 492 | [(do-binop rem-u t-i c_1 c_2) ,(remainder (term c_1) (term c_2))] 493 | [(do-binop rem-s t-i c_1 0) #false] 494 | [(do-binop rem-u t-i c_1 0) #false] 495 | [(do-binop and t-i c_1 c_2) ,(bitwise-and (term c_1) (term c_2))] 496 | [(do-binop or t-i c_1 c_2) ,(bitwise-ior (term c_1) (term c_2))] 497 | [(do-binop shl t-i c_1 c_2) ,(clamp (arithmetic-shift (term c_1) (term c_2)))] 498 | [(do-binop shr-s t-i c_1 c_2) ,(arithmetic-shift (term c_1) (- (term c_2)))] 499 | ;; FIXME: sign extension 500 | [(do-binop shr-u t-i c_1 c_2) ,(arithmetic-shift (term c_1) (- (term c_2)))] 501 | [(do-binop rotl i32 c_1 c_2) 502 | ,(bitwise-rotate-bit-field (term c_1) 0 32 (term c_2))] 503 | [(do-binop rotl i64 c_1 c_2) 504 | ,(bitwise-rotate-bit-field (term c_1) 0 64 (term c_2))] 505 | [(do-binop rotr i32 c_1 c_2) 506 | ,(bitwise-rotate-bit-field (term c_1) 0 32 (- 32 (term c_2)))] 507 | [(do-binop rotr i64 c_1 c_2) 508 | ,(bitwise-rotate-bit-field (term c_1) 0 64 (- 64 (term c_2)))] 509 | ;; FIXME: these cases aren't quite right at boundaries 510 | [(do-binop add t-f c_1 c_2) ,(+ (term c_1) (term c_2))] 511 | [(do-binop sub t-f c_1 c_2) ,(- (term c_1) (term c_2))] 512 | [(do-binop mul t-f c_1 c_2) ,(* (term c_1) (term c_2))] 513 | [(do-binop div t-f c_1 c_2) ,(/ (term c_1) (term c_2))] 514 | [(do-binop min t-f c_1 c_2) ,(min (term c_1) (term c_2))] 515 | [(do-binop max t-f c_1 c_2) ,(max (term c_1) (term c_2))] 516 | [(do-binop copysign t-f c_1 c_2) 517 | ;; FIXME: nan cases are tricky 518 | ,(cond [(or (equal? (sgn (term c_1)) (sgn (term c_2))) 519 | (zero? (term c_2))) 520 | (term c_1)] 521 | [else 522 | (- (term c_1))])]) 523 | 524 | (define-metafunction wasm-runtime-lang 525 | do-testop : testop t c -> c 526 | [(do-testop eqz t-i 0) 1] 527 | [(do-testop eqz t-i c) 0]) 528 | 529 | (define (b->i bool) (if bool 1 0)) 530 | 531 | (define (s->u int type) 532 | (match type 533 | ['i32 (integer-bytes->integer (integer->integer-bytes int 8 #t) #f #f 0 4)] 534 | ['i64 (integer-bytes->integer (integer->integer-bytes int 8 #t) #f)])) 535 | 536 | (define (u->s int type) 537 | (match type 538 | ['i32 (integer-bytes->integer (integer->integer-bytes int 8 #f) #t #f 0 4)] 539 | ['i64 (integer-bytes->integer (integer->integer-bytes int 8 #f) #t)])) 540 | 541 | (define-metafunction wasm-runtime-lang 542 | do-relop : relop t c c -> c 543 | [(do-relop lt-s t-i c_1 c_2) ,(b->i (< (term c_1) (term c_2)))] 544 | [(do-relop gt-s t-i c_1 c_2) ,(b->i (> (term c_1) (term c_2)))] 545 | [(do-relop le-s t-i c_1 c_2) ,(b->i (<= (term c_1) (term c_2)))] 546 | [(do-relop ge-s t-i c_1 c_2) ,(b->i (>= (term c_1) (term c_2)))] 547 | [(do-relop lt-u t-i c_1 c_2) ,(b->i (< (s->u (term c_1) (term t-i)) 548 | (s->u (term c_2) (term t-i))))] 549 | [(do-relop gt-u t-i c_1 c_2) ,(b->i (> (s->u (term c_1) (term t-i)) 550 | (s->u (term c_2) (term t-i))))] 551 | [(do-relop le-u t-i c_1 c_2) ,(b->i (<= (s->u (term c_1) (term t-i)) 552 | (s->u (term c_2) (term t-i))))] 553 | [(do-relop ge-u t-i c_1 c_2) ,(b->i (>= (s->u (term c_1) (term t-i)) 554 | (s->u (term c_2) (term t-i))))] 555 | [(do-relop lt t-f c_1 c_2) ,(b->i (< (term c_1) (term c_2)))] 556 | [(do-relop gt t-f c_1 c_2) ,(b->i (> (term c_2) (term c_2)))] 557 | [(do-relop le t-f c_1 c_2) ,(b->i (<= (term c_1) (term c_2)))] 558 | [(do-relop ge t-f c_1 c_2) ,(b->i (>= (term c_1) (term c_2)))] 559 | [(do-relop eq t c_1 c_2) ,(b->i (= (term c_1) (term c_2)))] 560 | [(do-relop ne t c_1 c_2) ,(b->i (not (= (term c_1) (term c_2))))]) 561 | 562 | ;; helpers for pretty printing / drawing as stack picts 563 | (define (pp/pict state port width txt) 564 | (redex-let 565 | wasm-runtime-lang 566 | ([{s F e* i} state]) 567 | (define e*-pict (term->pict (term e*))) 568 | (define p 569 | (vl-append (text (format "instance: ~a" (term i))) 570 | (text "instructions:") 571 | (blank 0 5) 572 | e*-pict)) 573 | (send txt insert (new pict-snip% [pict p])))) 574 | 575 | (define (type->color type) 576 | (match type 577 | ['value "lemonchiffon"] 578 | ['instr "pale green"] 579 | ['control "sky blue"] 580 | ['admin "lavender"])) 581 | 582 | (define (stack-pict str [type 'instr]) 583 | (cc-superimpose 584 | (filled-rectangle 130 35 585 | #:color (type->color type) 586 | #:border-color "gray") 587 | (text str (list (make-object color% "black"))))) 588 | 589 | (define (indent pict) 590 | (hc-append (blank 30 1) pict)) 591 | 592 | (define term->pict 593 | (term-match/single 594 | wasm-runtime-lang 595 | [((const t c) e*) 596 | (let () 597 | (define str (format "~a.const ~a" (term t) (term c))) 598 | (vc-append (stack-pict str 'value) 599 | (term->pict (term e*))))] 600 | [((call cl) e*) 601 | (let () 602 | (vc-append (stack-pict "call #") 603 | (term->pict (term e*))))] 604 | [((label n {e*_0} e*_1) e*_2) 605 | (let () 606 | (vc-append (stack-pict (~a "label " (term n)) 'admin) 607 | (indent (term->pict (term e*_1))) 608 | (term->pict (term e*_2))))] 609 | [((local n {i F} e*_1) e*_2) 610 | (let () 611 | (vc-append (stack-pict (format "local ~a {~a ; ...}" (term n) (term i)) 612 | 'admin) 613 | (indent (hc-append (text "frame" null 12 (/ pi 2)) 614 | (term->pict (term (F->v* F))))) 615 | (indent (term->pict (term e*_1))) 616 | (term->pict (term e*_2))))] 617 | [((block tf e*_1) e*_2) 618 | (let () 619 | (vc-append (stack-pict (format "block ~a" (term tf)) 620 | 'control) 621 | (indent (term->pict (term e*_1))) 622 | (term->pict (term e*_2))))] 623 | [((loop tf e*_1) e*_2) 624 | (let () 625 | (vc-append (stack-pict (format "loop ~a" (term tf)) 626 | 'control) 627 | (indent (term->pict (term e*_1))) 628 | (term->pict (term e*_2))))] 629 | [((if tf e*_0 else e*_1) e*_2) 630 | (let () 631 | (vc-append (stack-pict (format "if ~a" (term tf)) 632 | 'control) 633 | (indent (term->pict (term e*_0))) 634 | (stack-pict (format "else") 635 | 'control) 636 | (indent (term->pict (term e*_1))) 637 | (term->pict (term e*_2))))] 638 | [(e e*) 639 | (vc-append (stack-pict (format "~a" (term e))) 640 | (term->pict (term e*)))] 641 | [ϵ (blank 0 0)])) 642 | 643 | (define-syntax-rule (wasm-pp-traces t) 644 | (traces wasm-> #:pp pp/pict t)) 645 | 646 | ;; the actual reduction relation starts here 647 | (define wasm-> 648 | (reduction-relation 649 | wasm-runtime-lang 650 | #:domain (s F e* i) 651 | 652 | (--> (s F (trap (e e*)) i) 653 | (s F (trap ϵ) i) 654 | trap) 655 | (--> (s F (in-hole E (trap e*)) i) 656 | (s F (trap ϵ) i) 657 | (side-condition (not (redex-match wasm-runtime-lang hole (term E)))) 658 | trap-context) 659 | 660 | (==> ((const t c) ((unop t) e*)) 661 | ((const t (do-unop unop t c)) e*) 662 | unop) 663 | 664 | (==> ((const t c_1) ((const t c_2) ((binop t) e*))) 665 | ((const t c) e*) 666 | (where c (do-binop binop t c_1 c_2)) 667 | binop) 668 | (==> ((const t c_1) ((const t c_2) ((binop t) e*))) 669 | (trap e*) 670 | (where #false (do-binop binop t c_1 c_2)) 671 | binop-trap) 672 | 673 | (==> ((const t c) ((testop t) e*)) 674 | ((const i32 (do-testop testop t c)) e*) 675 | testop) 676 | 677 | (==> ((const t c_1) ((const t c_2) ((relop t) e*))) 678 | ((const i32 (do-relop relop t c_1 c_2)) e*) 679 | relop) 680 | 681 | (==> ((const t_1 c) ((convert t_2 t_1) e*)) 682 | ((const t_2 (cvt t_1 t_2 c))) 683 | convert) 684 | 685 | (==> ((const t_1 c) ((convert t_2 t_1 sx) e*)) 686 | ((const t_2 (cvt-sx t_1 t_2 sx c))) 687 | convert-sx) 688 | 689 | (==> ((const t_1 c) ((reinterpret t_2 t_1) e*)) 690 | ((const t_2 (const-reinterpret t_2 (bits (sizeof t_1) t_1 c))) e*) 691 | reinterpret) 692 | 693 | ;; generally these rules need to mention the "continuation" in the sequence 694 | ;; of instructions because Redex does not allow splicing holes with a 695 | ;; sequence of s-exps 696 | (==> (unreachable e*) (trap e*)) 697 | (==> (nop e*) e*) 698 | (==> (v (drop e*)) e*) 699 | 700 | (==> (v_1 (v_2 ((const i32 0) (select e*)))) 701 | (v_2 e*) 702 | select-false) 703 | (==> (v_1 (v_2 ((const i32 k) (select e*)))) 704 | (v_1 e*) 705 | (side-condition (>= (term k) 1)) 706 | select-true) 707 | 708 | ;; Redex can't express a pattern like n-level nestings of an 709 | ;; expression, so we explicitly compute the nesting depth of 710 | ;; values around the hole in the context E instead 711 | (++> (in-hole E ((block (-> (t_1 ...) (t_2 ...)) e*_0) e*_1)) 712 | (in-hole E_outer (seq* (label k {ϵ} (in-hole E_v e*_0)) e*_1)) 713 | 714 | (where l ,(length (term (t_2 ...)))) 715 | (where k ,(length (term (t_1 ...)))) 716 | (where (E_outer E_v) (v-split E k)) 717 | block) 718 | 719 | (++> (in-hole E ((name e_loop (loop (-> (t_1 ...) (t_2 ...)) e*_0)) e*_1)) 720 | (in-hole E_outer (seq* e_lbl e*_1)) 721 | 722 | (where l ,(length (term (t_2 ...)))) 723 | (where k ,(length (term (t_1 ...)))) 724 | (where (E_outer E_v) (v-split E k)) 725 | (where e_lbl (label l {(seq e_loop)} (in-hole E_v e*_0))) 726 | loop) 727 | 728 | (==> ((const i32 0) ((if tf e*_1 else e*_2) e*)) 729 | (seq* (block tf e*_2) e*) 730 | if-false) 731 | (==> ((const i32 k) ((if tf e*_1 else e*_2) e*)) 732 | (seq* (block tf e*_1) e*) 733 | (side-condition (>= (term k) 1)) 734 | if-true) 735 | 736 | (==> ((label n {e*_0} v*) e*_1) 737 | (e*-append v* e*_1) 738 | label-value) 739 | (==> ((label n {e*_0} trap) e*_1) 740 | (trap e*_1) 741 | label-trap) 742 | (==> ((label n {e*_0} (in-hole E ((br j) e*_1))) e*_2) 743 | (e*-append (in-hole E_v e*_0) e*_2) 744 | (where j (label-depth E)) 745 | (where (E_outer E_v) (v-split E n)) 746 | label-br) 747 | 748 | (==> ((const i32 0) ((br-if j) e*)) 749 | e* 750 | br-if-false) 751 | (==> ((const i32 k) ((br-if j) e*)) 752 | (seq (br j) e*) 753 | (side-condition (>= (term k) 1)) 754 | br-if-true) 755 | 756 | (==> ((const i32 k) ((br-table i_1 ... i i_2 ...) e*)) 757 | (seq* (br i) e*) 758 | (side-condition (= (length (term (i_1 ...))) (term k))) 759 | br-table-index) 760 | (==> ((const i32 k) ((br-table i_1 ... i) e*)) 761 | (seq* (br i) e*) 762 | (side-condition (>= (term k) (length (term (i_1 ...))))) 763 | br-table-end) 764 | 765 | (--> (s F (in-hole E ((call j) e*)) i) 766 | (s F (in-hole E ((call (store-func s i j)) e*)) i) 767 | call-index) 768 | 769 | (--> (s F (in-hole E ((const i32 j) ((call-indirect tf) e*))) i) 770 | (s F (in-hole E ((call cl) e*)) i) 771 | (where cl (store-tab s i j)) 772 | (where (func () tf local (t ...) e*_f) (cl-code cl)) 773 | call-indirect) 774 | 775 | ;; case where dynamic type check fails 776 | (--> (s F (in-hole E ((const i32 j) ((call-indirect tf_0) e*))) i) 777 | (s F (in-hole E (trap e*)) i) 778 | (where cl (store-tab s i j)) 779 | (where (func () tf_1 local (t ...) e*_f) (cl-code cl)) 780 | (side-condition (not (equal? (term tf_0) (term tf_1)))) 781 | call-indirect-trap) 782 | 783 | (++> (in-hole E ((call cl) e*_0)) 784 | (in-hole E_outer ((local m {(cl-inst cl) F} e*_block) e*_0)) 785 | (where (func () (-> (t_1 ...) (t_2 ...)) local (t ...) e*_code) (cl-code cl)) 786 | (where n ,(length (term (t_1 ...)))) 787 | (where m ,(length (term (t_2 ...)))) 788 | (where (E_outer E_v) (v-split E n)) 789 | (where F (F-append (v*->F (in-hole E_v ϵ)) ((const t 0) ...))) 790 | (where e*_block (seq (block (-> () (t_2 ...)) e*_code))) 791 | call-closure) 792 | 793 | (==> ((local n {i F} v*) e*) 794 | (e*-append v* e*) 795 | local-value) 796 | 797 | (==> ((local n {i F} (trap e*_0)) e*_1) 798 | (trap ϵ) 799 | local-trap) 800 | 801 | (==> ((local n {i F} (in-hole E (return e*_0))) e*_1) 802 | (in-hole E_v e*_1) 803 | (where (E_outer E_v) (v-split E n)) 804 | local-return) 805 | 806 | ;; specifies how to reduce inside a local/frame instruction via a 807 | ;; recursive use of the reduction relation 808 | (--> (s_0 F_0 (in-hole E ((local n {i F_1} e*_0) e*_2)) j) 809 | (s_1 F_0 (in-hole E ((local n {i F_2} e*_1) e*_2)) j) 810 | ;; apply --> recursively 811 | (where any_rec 812 | ,(apply-reduction-relation/tag-with-names 813 | wasm-> (term (s_0 F_1 e*_0 i)))) 814 | ;; only apply this rule if this reduction was valid 815 | (side-condition (not (null? (term any_rec)))) 816 | ;; the relation should be deterministic, so just take the first 817 | (where (string_tag (s_1 F_2 e*_1 i)) ,(first (term any_rec))) 818 | (computed-name (term string_tag))) 819 | 820 | ;; reductions for operating on locals in frames 821 | (--> (s (name F (v_1 ... v v_2 ...)) (in-hole E ((get-local j) e*)) i) 822 | (s F (in-hole E (v e*)) i) 823 | (side-condition (= (length (term (v_1 ...))) (term j))) 824 | get-local) 825 | 826 | (--> (s (v_1 ... v v_2 ...) (in-hole E (v_new ((set-local j) e*))) i) 827 | (s (v_1 ... v_new v_2 ...) (in-hole E e*) i) 828 | (side-condition (= (length (term (v_1 ...))) (term j))) 829 | set-local) 830 | 831 | (==> (v ((tee-local j) e*)) 832 | (v (v ((set-local j) e*))) 833 | tee-local) 834 | 835 | ;; reductions for operating on global store data 836 | (--> (s F (in-hole E ((get-global j) e*)) i) 837 | (s F (in-hole E ((store-glob s i j) e*)) i) 838 | get-global) 839 | 840 | (--> (s F (in-hole E (v ((set-global j) e*))) i) 841 | (s_new F (in-hole E e*) i) 842 | (where s_new (store-glob= s i j v)) 843 | set-global) 844 | 845 | ;; reductions for operating on memory 846 | (--> (s F (in-hole E ((const i32 k) ((load t a o) e*))) i) 847 | (s F (in-hole E ((const t (const-reinterpret t (b ...))) e*)) i) 848 | (where (b ...) (store-mem s i ,(+ (term k) (term o)) (sizeof t))) 849 | load) 850 | 851 | (--> (s F (in-hole E ((const i32 k) ((load t tp sx a o) e*))) i) 852 | (s F (in-hole E ((const t (const-reinterpret-packed t (b ...) sx)) e*)) i) 853 | (where (b ...) (store-mem s i ,(+ (term k) (term o)) (sizeof tp))) 854 | load-packed) 855 | 856 | (--> (s F (in-hole E ((const i32 k) ((load t a o) e*))) i) 857 | (s F (in-hole E (trap e*)) i) 858 | (where #false (store-mem s i ,(+ (term k) (term o)) (sizeof t))) 859 | load-trap) 860 | 861 | (--> (s F (in-hole E ((const i32 k) ((load t tp sx a o) e*))) i) 862 | (s F (in-hole E (trap e*)) i) 863 | (where #false (store-mem s i ,(+ (term k) (term o)) (sizeof tp))) 864 | load-trap-packed) 865 | 866 | (--> (s F (in-hole E ((const i32 k) ((const t c) ((store t a o) e*)))) i) 867 | (s_new F (in-hole E e*) i) 868 | (where n (sizeof t)) 869 | (where s_new (store-mem= s i ,(+ (term k) (term o)) n (bits n t c))) 870 | store) 871 | 872 | (--> (s F (in-hole E ((const i32 k) ((const t c) ((store t tp a o) e*)))) i) 873 | (s_new F (in-hole E e*) i) 874 | (where n (sizeof tp)) 875 | (where s_new (store-mem= s i ,(+ (term k) (term o)) n (bits n t c))) 876 | store-packed) 877 | 878 | (--> (s F (in-hole E ((const i32 k) ((const t c) ((store t tp ... a o) e*)))) i) 879 | (s F (in-hole E (trap e*)) i) 880 | (where n (sizeof t)) 881 | (where #false (store-mem= s i ,(+ (term k) (term o)) n (bits n t c))) 882 | store-trap) 883 | 884 | (--> (s F (in-hole E ((const i32 k) ((const t c) ((store t tp a o) e*)))) i) 885 | (s F (in-hole E (trap e*)) i) 886 | (where n (sizeof tp)) 887 | (where #false (store-mem= s i ,(+ (term k) (term o)) n (bits n t c))) 888 | store-trap-packed) 889 | 890 | (--> (s F (in-hole E (current-memory e*)) i) 891 | (s F (in-hole E ((const i32 (memory-size s i)) e*)) i) 892 | current-memory) 893 | 894 | (--> (s F (in-hole E ((const i32 k) (grow-memory e*))) i) 895 | (s_new F (in-hole E ((const i32 j_newsize) e*)) i) 896 | (where (s_new j_newsize) (expand-memory s i k)) 897 | grow-memory) 898 | 899 | ;; failure case for grow-memory omitted, alternatively we could institute a cap 900 | ;; and return -1 for that cap in the model 901 | 902 | with 903 | [(--> (s F (in-hole E x) i) 904 | (s F (in-hole E y) i)) 905 | (==> x y)] 906 | [(--> (s F x i) 907 | (s F y i)) 908 | (++> x y)])) 909 | 910 | (module+ test 911 | (require rackunit) 912 | 913 | (define (wasm-eval a-term) 914 | (define results (apply-reduction-relation* wasm-> a-term)) 915 | (unless (= (length results) 1) 916 | (error "wasm-> had non-deterministic evaluation or no result")) 917 | (define result (first results)) 918 | (define result->eval-result 919 | (term-match/single 920 | wasm-runtime-lang 921 | [{s F (v ϵ) i} (term v)] 922 | [{s F (trap ϵ) i} (term trap)])) 923 | (result->eval-result (first results))) 924 | 925 | (define-syntax-rule (test-wasm--> x y) 926 | (test--> wasm-> x y)) 927 | (define-syntax-rule (test-wasm-->> x y) 928 | (test-->> wasm-> x y)) 929 | 930 | ;; for testing with side effects 931 | (define-syntax-rule (test-wasm-eval x y) 932 | (test-equal (wasm-eval x) y)) 933 | 934 | ;; test helpers and terms 935 | (define default-memory 936 | (make-list *page-size* 0)) 937 | (define mt-s (term {(inst) (tab) (mem)})) 938 | (define-syntax-rule (simple-config e*) 939 | (term (,mt-s () e* 0))) 940 | 941 | ;; sanity checks for the grammar 942 | (check-not-false 943 | (redex-match wasm-runtime-lang s mt-s)) 944 | (check-not-false 945 | (redex-match wasm-runtime-lang F (second (simple-config ϵ)))) 946 | (check-not-false 947 | (redex-match wasm-runtime-lang v (term (const i32 42)))) 948 | (check-not-false 949 | (redex-match wasm-runtime-lang 950 | (in-hole E (v (drop e*))) 951 | (term ((const i32 42) (drop ϵ))))) 952 | 953 | ;; test primitives 954 | (test-wasm--> (simple-config (seq (const f32 42.0) (neg f32))) 955 | (simple-config (seq (const f32 -42.0)))) 956 | (test-wasm--> (simple-config (seq (const i32 42) (eqz i32))) 957 | (simple-config (seq (const i32 0)))) 958 | (test-wasm--> (simple-config (seq (const i32 42) (const i32 42) (ne i32))) 959 | (simple-config (seq (const i32 0)))) 960 | 961 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 1) (add i32))) 962 | (simple-config (seq (const i32 2)))) 963 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 0) (add i32))) 964 | (simple-config (seq (const i32 1)))) 965 | (test-wasm--> (simple-config (seq (const i32 -1) (const i32 -1) (add i32))) 966 | (simple-config (seq (const i32 -2)))) 967 | (test-wasm--> (simple-config (seq (const i32 -1) (const i32 1) (add i32))) 968 | (simple-config (seq (const i32 0)))) 969 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 1) (add i32))) 970 | (simple-config (seq (const i32 #x80000000)))) 971 | (test-wasm--> (simple-config (seq (const i32 #x80000000) (const i32 -1) (add i32))) 972 | (simple-config (seq (const i32 #x7fffffff)))) 973 | (test-wasm--> (simple-config (seq (const i32 #x3fffffff) (const i32 1) (add i32))) 974 | (simple-config (seq (const i32 #x40000000)))) 975 | 976 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 1) (sub i32))) 977 | (simple-config (seq (const i32 0)))) 978 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 0) (sub i32))) 979 | (simple-config (seq (const i32 1)))) 980 | (test-wasm--> (simple-config (seq (const i32 -1) (const i32 -1) (sub i32))) 981 | (simple-config (seq (const i32 0)))) 982 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 -1) (sub i32))) 983 | (simple-config (seq (const i32 #x80000000)))) 984 | (test-wasm--> (simple-config (seq (const i32 #x80000000) (const i32 1) (sub i32))) 985 | (simple-config (seq (const i32 #x7fffffff)))) 986 | (test-wasm--> (simple-config (seq (const i32 #x80000000) (const i32 #x80000000) (sub i32))) 987 | (simple-config (seq (const i32 0)))) 988 | (test-wasm--> (simple-config (seq (const i32 #x3fffffff) (const i32 -1) (sub i32))) 989 | (simple-config (seq (const i32 #x40000000)))) 990 | 991 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 1) (mul i32))) 992 | (simple-config (seq (const i32 1)))) 993 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 0) (mul i32))) 994 | (simple-config (seq (const i32 0)))) 995 | (test-wasm--> (simple-config (seq (const i32 -1) (const i32 -1) (mul i32))) 996 | (simple-config (seq (const i32 1)))) 997 | (test-wasm--> (simple-config (seq (const i32 #x10000000) (const i32 4096) (mul i32))) 998 | (simple-config (seq (const i32 0)))) 999 | (test-wasm--> (simple-config (seq (const i32 ,(u->s #x80000000 'i32)) (const i32 0) (mul i32))) 1000 | (simple-config (seq (const i32 0)))) 1001 | ;; TODO: fix numerics corner case 1002 | #; 1003 | (test-wasm--> (simple-config (seq (const i32 ,(u->s #x80000000 'i32)) (const i32 -1) (mul i32))) 1004 | (simple-config (seq (const i32 ,(u->s #x80000000 'i32))))) 1005 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 -1) (mul i32))) 1006 | (simple-config (seq (const i32 ,(u->s #x80000001 'i32))))) 1007 | (test-wasm--> (simple-config (seq (const i32 #x01234567) (const i32 #x76543210) (mul i32))) 1008 | (simple-config (seq (const i32 #x358e7470)))) 1009 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 #x7fffffff) (mul i32))) 1010 | (simple-config (seq (const i32 1)))) 1011 | 1012 | (test-wasm--> (simple-config (seq (const i32 #xabcd9876) (const i32 1) (rotl i32))) 1013 | (simple-config (seq (const i32 #x579b30ed)))) 1014 | 1015 | (test-wasm--> (simple-config (seq (const i32 #xff00cc00) (const i32 1) (rotr i32))) 1016 | (simple-config (seq (const i32 #x7f806600)))) 1017 | 1018 | (test-wasm--> (simple-config (seq (const i32 ,(u->s #x80000000 'i32)) (const i32 #x7fffffff) (gt-s i32))) 1019 | (simple-config (seq (const i32 0)))) 1020 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 ,(u->s #x80000000 'i32)) (gt-s i32))) 1021 | (simple-config (seq (const i32 1)))) 1022 | (test-wasm--> (simple-config (seq (const i32 ,(u->s #x80000000 'i32)) (const i32 #x7fffffff) (le-s i32))) 1023 | (simple-config (seq (const i32 1)))) 1024 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 ,(u->s #x80000000 'i32)) (le-s i32))) 1025 | (simple-config (seq (const i32 0)))) 1026 | (test-wasm--> (simple-config (seq (const i32 ,(u->s #x80000000 'i32)) (const i32 #x7fffffff) (le-u i32))) 1027 | (simple-config (seq (const i32 0)))) 1028 | (test-wasm--> (simple-config (seq (const i32 #x7fffffff) (const i32 ,(u->s #x80000000 'i32)) (le-u i32))) 1029 | (simple-config (seq (const i32 1)))) 1030 | 1031 | ;; test drop & select 1032 | (test-wasm--> (simple-config (seq (const i32 42) drop)) 1033 | (simple-config (seq))) 1034 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 2) (const i32 0) select)) 1035 | (simple-config (seq (const i32 2)))) 1036 | (test-wasm--> (simple-config (seq (const i32 1) (const i32 2) (const i32 42) select)) 1037 | (simple-config (seq (const i32 1)))) 1038 | 1039 | ;; test labels 1040 | (test-wasm--> (simple-config 1041 | (seq (label 1 {ϵ} ((const i32 2) ϵ)))) 1042 | (simple-config 1043 | (seq (const i32 2)))) 1044 | (test-wasm--> (simple-config 1045 | (seq (const i32 1) (label 1 {ϵ} ((const i32 2) ϵ)))) 1046 | (simple-config 1047 | (seq (const i32 1) (const i32 2)))) 1048 | (test-wasm--> (simple-config 1049 | (seq (label 1 {(drop ϵ)} (seq (label 1 {ϵ} (seq (const i32 1) (br 1))))))) 1050 | (simple-config 1051 | (seq (const i32 1) drop))) 1052 | 1053 | ;; test block & related constructs 1054 | (test-wasm--> (simple-config 1055 | (seq (const i32 1) (const i32 2) (block (-> (i32) (i32)) ϵ))) 1056 | (simple-config 1057 | (seq (const i32 1) (label 1 {ϵ} ((const i32 2) ϵ))))) 1058 | (test-wasm-->> (simple-config (seq (const i32 1) (const i32 2) (block (-> (i32) (i32)) ϵ))) 1059 | (simple-config (seq (const i32 1) (const i32 2)))) 1060 | (test-wasm-->> (simple-config (seq (const i32 1) (block (-> (i32) (i32)) (seq drop)))) 1061 | (simple-config (seq))) 1062 | 1063 | ;; test branches 1064 | (test-wasm--> (simple-config 1065 | (seq (const i32 1) (br-table 0 1 2))) 1066 | (simple-config (seq (br 1)))) 1067 | (test-wasm--> (simple-config 1068 | (seq (const i32 2) (br-table 0 1 2))) 1069 | (simple-config (seq (br 2)))) 1070 | (test-wasm--> (simple-config 1071 | (seq (const i32 3) (br-table 0 1 2))) 1072 | (simple-config (seq (br 2)))) 1073 | 1074 | ;; test frames / function calls / access to locals 1075 | (test-wasm--> (simple-config 1076 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1077 | (seq (get-local 1))))) 1078 | (simple-config 1079 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1080 | (seq (const i32 2)))))) 1081 | (test-wasm-->> (simple-config 1082 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1083 | (seq (get-local 1))))) 1084 | (simple-config 1085 | (seq (const i32 2)))) 1086 | (test-wasm-->> (simple-config 1087 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1088 | (seq (const i32 42) (tee-local 1))))) 1089 | (simple-config 1090 | (seq (const i32 42)))) 1091 | (test-wasm-->> (simple-config 1092 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1093 | (seq trap (get-local 1))))) 1094 | (simple-config (seq trap))) 1095 | (test-wasm-->> (simple-config 1096 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1097 | (seq (get-local 1) return (get-local 2))))) 1098 | (simple-config 1099 | (seq (const i32 2)))) 1100 | (test-wasm-->> (simple-config 1101 | (seq (local 1 {1 ((const i32 1) (const i32 2) (const i32 3))} 1102 | (seq (get-local 1) return (get-local 2))) 1103 | drop)) 1104 | (simple-config (seq))) 1105 | 1106 | ;; test function calls with factorial 1107 | (let () 1108 | (define f-0 1109 | (term (func () (-> () (i32)) local () (seq (const i32 0))))) 1110 | (define fact-loop 1111 | (term (func () (-> (i32) (i32)) local (i32) 1112 | (seq (const i32 1) 1113 | (set-local 1) 1114 | (loop (-> () ()) 1115 | (seq (get-local 0) 1116 | (eqz i32) 1117 | (if (-> () ()) 1118 | (seq (get-local 1) return) 1119 | else 1120 | (seq (get-local 0) 1121 | (get-local 1) 1122 | (mul i32) 1123 | (set-local 1) 1124 | (get-local 0) 1125 | (const i32 1) 1126 | (sub i32) 1127 | (set-local 0) 1128 | (br 1))))))))) 1129 | (define f-2 1130 | (term (func () (-> (i32) (i32)) local () 1131 | (seq (const i32 5) (call 1) 1132 | (get-local 0) (mul i32))))) 1133 | (define cl-0 1134 | (term {(inst 0) (code ,f-0)})) 1135 | (define cl-1 1136 | (term {(inst 0) (code ,fact-loop)})) 1137 | (define cl-2 1138 | (term {(inst 0) (code ,f-2)})) 1139 | (define modinst-0 1140 | (term {(func ,cl-0 ,cl-1 ,cl-2) (glob)})) 1141 | (define modinst-1 1142 | (term {(func) (glob)})) 1143 | (define tabinst-0 1144 | (term ())) 1145 | (define tabinst-1 1146 | (term ())) 1147 | (define func-store 1148 | (term {(inst ,modinst-0 ,modinst-1) 1149 | (tab ,tabinst-0 ,tabinst-1) 1150 | (mem)})) 1151 | (define-syntax-rule (func-config e*) 1152 | (term (,func-store () e* 0))) 1153 | 1154 | (test-wasm-->> (func-config (seq (call 0))) 1155 | (func-config (seq (const i32 0)))) 1156 | (test-wasm-->> (func-config (seq (const i32 5) (call 1))) 1157 | (func-config (seq (const i32 120)))) 1158 | (test-wasm-->> (func-config (seq (const i32 2) (call 2))) 1159 | (func-config (seq (const i32 240))))) 1160 | 1161 | (let () 1162 | (define fac 1163 | (term (func () (-> (i64) (i64)) local () 1164 | (seq (get-local 0) 1165 | (eqz i64) 1166 | (if (-> () (i64)) 1167 | (seq (const i64 1)) 1168 | else 1169 | (seq (get-local 0) 1170 | (get-local 0) 1171 | (const i64 1) 1172 | (sub i64) 1173 | (call 0) 1174 | (mul i64))))))) 1175 | (define fac-acc 1176 | (term (func () (-> (i64 i64) (i64)) local () 1177 | (seq (get-local 0) 1178 | (eqz i64) 1179 | (if (-> () (i64)) 1180 | (seq (get-local 1)) 1181 | else 1182 | (seq (get-local 0) 1183 | (const i64 1) 1184 | (sub i64) 1185 | (get-local 0) 1186 | (get-local 1) 1187 | (mul i64) 1188 | (call 1))))))) 1189 | (define fib 1190 | (term (func () (-> (i64) (i64)) local () 1191 | (seq (get-local 0) 1192 | (const i64 1) 1193 | (le-u i64) 1194 | (if (-> () (i64)) 1195 | (seq (const i64 1)) 1196 | else 1197 | (seq (get-local 0) 1198 | (const i64 2) 1199 | (sub i64) 1200 | (call 2) 1201 | (get-local 0) 1202 | (const i64 1) 1203 | (sub i64) 1204 | (call 2) 1205 | (add i64))))))) 1206 | (define even 1207 | (term (func () (-> (i64) (i32)) local () 1208 | (seq (get-local 0) 1209 | (eqz i64) 1210 | (if (-> () (i32)) 1211 | (seq (const i32 44)) 1212 | else 1213 | (seq (get-local 0) 1214 | (const i64 1) 1215 | (sub i64) 1216 | (call 4))))))) 1217 | (define odd 1218 | (term (func () (-> (i64) (i32)) local () 1219 | (seq (get-local 0) 1220 | (eqz i64) 1221 | (if (-> () (i32)) 1222 | (seq (const i32 99)) 1223 | else 1224 | (seq (get-local 0) 1225 | (const i64 1) 1226 | (sub i64) 1227 | (call 3))))))) 1228 | (define cl-0 (term {(inst 0) (code ,fac)})) 1229 | (define cl-1 (term {(inst 0) (code ,fac-acc)})) 1230 | (define cl-2 (term {(inst 0) (code ,fib)})) 1231 | (define cl-3 (term {(inst 0) (code ,even)})) 1232 | (define cl-4 (term {(inst 0) (code ,odd)})) 1233 | (define modinst-0 1234 | (term {(func ,cl-0 ,cl-1 ,cl-2 ,cl-3 ,cl-4) (glob)})) 1235 | (define func-store 1236 | (term {(inst ,modinst-0) (tab) (mem)})) 1237 | (define-syntax-rule (func-config e*) 1238 | (term (,func-store () e* 0))) 1239 | 1240 | (test-wasm-->> (func-config (seq (const i64 5) (call 0))) 1241 | (func-config (seq (const i64 120)))) 1242 | (test-wasm-->> (func-config (seq (const i64 5) (const i64 1) (call 1))) 1243 | (func-config (seq (const i64 120)))) 1244 | (test-wasm-->> (func-config (seq (const i64 5) (call 2))) 1245 | (func-config (seq (const i64 8)))) 1246 | (test-wasm-->> (func-config (seq (const i64 6) (call 3))) 1247 | (func-config (seq (const i32 44)))) 1248 | (test-wasm-->> (func-config (seq (const i64 5) (call 3))) 1249 | (func-config (seq (const i32 99)))) 1250 | (test-wasm-->> (func-config (seq (const i64 4) (call 4))) 1251 | (func-config (seq (const i32 99)))) 1252 | (test-wasm-->> (func-config (seq (const i64 7) (call 4))) 1253 | (func-config (seq (const i32 44))))) 1254 | 1255 | ;; test that globals don't interfere between instances 1256 | (let () 1257 | (define f-0 1258 | (term (func () (-> () (i32)) local () 1259 | (seq (get-global 0) 1260 | (const i32 1) 1261 | (add i32) 1262 | (set-global 0) 1263 | (get-global 0) 1264 | return)))) 1265 | (define cl-0 1266 | (term {(inst 0) (code ,f-0)})) 1267 | (define cl-1 1268 | (term {(inst 1) (code ,f-0)})) 1269 | (define modinst-0 1270 | (term {(func ,cl-0 ,cl-1) (glob (const i32 42))})) 1271 | (define modinst-1 1272 | (term {(func ,cl-1) (glob (const i32 52))})) 1273 | (define tabinst-0 (term ())) 1274 | (define tabinst-1 (term ())) 1275 | (define func-store 1276 | (term {(inst ,modinst-0 ,modinst-1) 1277 | (tab ,tabinst-0 ,tabinst-1) 1278 | (mem)})) 1279 | (define-syntax-rule (func-config e*) 1280 | (term (,func-store () e* 0))) 1281 | 1282 | (test-wasm-eval (func-config (seq (call 0) drop (call 0))) 1283 | (term (const i32 44))) 1284 | (test-wasm-eval (func-config (seq (call 0) (call 0) 1285 | drop drop 1286 | (call 1))) 1287 | (term (const i32 53)))) 1288 | 1289 | ;; tests for tables 1290 | (let () 1291 | (define f-0 1292 | (term (func () (-> (f64 f64) (f64)) local () 1293 | (seq (get-local 0) 1294 | (get-local 1) 1295 | (sub f64) 1296 | return)))) 1297 | (define f-1 1298 | (term (func () (-> (f64 f64) (f64)) local () 1299 | (seq (get-local 0) 1300 | (get-local 1) 1301 | (add f64) 1302 | return)))) 1303 | (define cl-0 1304 | (term {(inst 0) (code ,f-0)})) 1305 | (define cl-1 1306 | (term {(inst 0) (code ,f-1)})) 1307 | (define modinst-0 1308 | (term {(func) (glob) (tab 0)})) 1309 | (define modinst-1 1310 | (term {(func) (glob) (tab 0)})) 1311 | (define tabinst (term (,cl-0 ,cl-1))) 1312 | (define tab-store 1313 | (term {(inst ,modinst-0 ,modinst-1) 1314 | (tab ,tabinst) 1315 | (mem)})) 1316 | (define-syntax-rule (tab-config e*) 1317 | (term (,tab-store () e* 0))) 1318 | 1319 | (test-wasm-->> (tab-config (seq (const f64 3.0) 1320 | (const f64 5.0) 1321 | (const i32 1) ; call index 1322 | (call-indirect (-> (f64 f64) (f64))))) 1323 | (tab-config (seq (const f64 8.0)))) 1324 | (test-wasm-->> (tab-config (seq (const f64 15.0) 1325 | (const f64 5.0) 1326 | (const i32 0) 1327 | (const i32 1) 1328 | (const i32 5) 1329 | select 1330 | (call-indirect (-> (f64 f64) (f64))))) 1331 | (tab-config (seq (const f64 10.0))))) 1332 | 1333 | ;; tests for memory related operations 1334 | (let () 1335 | ;; f-0 just stores some data 1336 | (define f-0 1337 | (term (func () (-> (i32 i64) ()) local () 1338 | (seq (get-local 0) 1339 | (get-local 1) 1340 | (store i64 6 0) 1341 | return)))) 1342 | ;; f-1 modifies the data 1343 | (define f-1 1344 | (term (func () (-> (i32 i64) ()) local (i64) 1345 | (seq (get-local 0) 1346 | (load i64 6 0) 1347 | (tee-local 2) 1348 | (get-local 1) 1349 | (mul i64) 1350 | (set-local 2) 1351 | (get-local 0) 1352 | (get-local 2) 1353 | (store i64 6 0) 1354 | return)))) 1355 | ;; f-2 just reads it 1356 | (define f-2 1357 | (term (func () (-> (i32) (i64)) local () 1358 | (seq (get-local 0) 1359 | (load i64 6 0) 1360 | return)))) 1361 | (define cl-0 1362 | (term {(inst 0) (code ,f-0)})) 1363 | (define cl-1 1364 | (term {(inst 1) (code ,f-1)})) 1365 | (define cl-2 1366 | (term {(inst 0) (code ,f-2)})) 1367 | (define modinst-0 1368 | (term {(func ,cl-0 ,cl-1 ,cl-2) (glob) (mem 0)})) 1369 | (define modinst-1 1370 | (term {(func ,cl-1) (glob) (mem 0)})) 1371 | (define mem-store 1372 | (term {(inst ,modinst-0 ,modinst-1) 1373 | (tab () ()) 1374 | (mem ,default-memory)})) 1375 | (define-syntax-rule (mem-config e*) 1376 | (term (,mem-store () e* 0))) 1377 | 1378 | (test-wasm-eval (mem-config (seq (const i32 0) 1379 | (const i64 42) 1380 | (call 0) 1381 | (const i32 0) 1382 | (const i64 5) 1383 | (call 1) 1384 | (const i32 0) 1385 | (call 2))) 1386 | (term (const i64 210))) 1387 | (test-wasm-eval (mem-config (seq current-memory)) 1388 | (term (const i32 1))) 1389 | (test-wasm-eval (mem-config (seq (const i32 2) grow-memory)) 1390 | (term (const i32 3))) 1391 | ;; write/read at very end of page 1392 | (test-wasm-eval (mem-config (seq (const i32 ,(- *page-size* 8)) 1393 | (const i64 42) 1394 | (call 0) 1395 | (const i32 ,(- *page-size* 8)) 1396 | (call 2))) 1397 | (term (const i64 42))) 1398 | ;; reads & writes out of bounds should fail 1399 | (test-wasm-eval (mem-config (seq (const i32 ,(- *page-size* 7)) 1400 | (const i64 42) 1401 | (call 0))) 1402 | (term trap)) 1403 | (test-wasm-eval (mem-config (seq (const i32 ,(- *page-size* 7)) 1404 | (call 2))) 1405 | (term trap)) 1406 | ) 1407 | ) --------------------------------------------------------------------------------