miloignis/kraken
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Starting to add control instruction stuff, beginning with the block instruction. No nice labels or anything yet

Browse Source
This commit is contained in:
Nathan Braswell
2021-07-22 01:14:51 -04:00
parent f740dd07e2
commit ca25f2ca2b
2 changed files with 25 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
comp_wasm.kp
View File

@@ -1,13 +1,19 @@
(with_import "./wasm.kp" (with_import "./wasm.kp"
(let ( (let (
_ (println "args" *ARGV*) _ (println "args" *ARGV*)
(_ _ out) (cond (!= (len *ARGV*) 3) (error "wrong number of params") (_ _ out) (cond (!= (len *ARGV*) 3) (error "wrong number of params to comp_wasm (please provide out)")
true *ARGV*) true *ARGV*)
_ (println "out" out) _ (println "out" out)
wasm_code (module wasm_code (module
(func $add (param $num i32) (result i32) (func $add (param $num i32) (result i32)
(local $tmp1 i32) (local $tmp1 i32)
(local $tmp2 i32) (local $tmp2 i32)
(block
(i32.const 1337)
(i32.const 1338)
drop
drop
)
(i32.const 11) (i32.const 11)
(local.get $tmp2) (local.get $tmp2)
i32.add i32.add

21
wasm.kp
View File

@@ -9,6 +9,7 @@
) )
encode_s8_LEB128 (lambda (x) (encode_u_LEB128 (& x 0xFF))) encode_s8_LEB128 (lambda (x) (encode_u_LEB128 (& x 0xFF)))
encode_s32_LEB128 (lambda (x) (encode_u_LEB128 (& x 0xFFFFFFFF))) encode_s32_LEB128 (lambda (x) (encode_u_LEB128 (& x 0xFFFFFFFF)))
encode_s33_LEB128 (lambda (x) (encode_u_LEB128 (& x 0x1FFFFFFFF)))
encode_vector (lambda (enc v) encode_vector (lambda (enc v)
(concat (encode_u_LEB128 (len v)) (flat_map enc v) ) (concat (encode_u_LEB128 (len v)) (flat_map enc v) )
) )
@@ -77,11 +78,20 @@
encoded (encode_vector encode_u_LEB128 x) encoded (encode_vector encode_u_LEB128 x)
) (concat [0x03] (encode_u_LEB128 (len encoded)) encoded )) ) (concat [0x03] (encode_u_LEB128 (len encoded)) encoded ))
) )
encode_ins (lambda (ins) encode_blocktype (lambda (type) (cond (symbol? type) (encode_valtype type)
(= [] type) [0x40] ; empty type
true (encode_s33_LEB128 typ)
))
encode_ins (rec-lambda recurse (ins)
(let ( (let (
op (idx ins 0) op (idx ins 0)
) (cond (= op 'unreachable) [0x00] ) (cond (= op 'unreachable) [0x00]
(= op 'nop) [0x01] (= op 'nop) [0x01]
(= op 'block) (concat [0x02] (encode_blocktype (idx ins 1)) (flat_map recurse (idx ins 2)) [0x0B])
;...
(= op 'return) [0x0F]
(= op 'call) (condat [0x10] (encode_u_LEB128 (idx ins 1)))
; call_indirect
; skipping a bunch ; skipping a bunch
; Parametric Instructions ; Parametric Instructions
(= op 'drop) [0x1A] (= op 'drop) [0x1A]
@@ -167,11 +177,13 @@
) [] nil 0 0) ) [] nil 0 0)
inner_env (add-dict-to-env de inner_name_dict) inner_env (add-dict-to-env de inner_name_dict)
our_type [ (map (lambda (x) (idx x 2)) params) (slice result 1 -1) ] our_type [ (map (lambda (x) (idx x 2)) params) (slice result 1 -1) ]
_ (println "about to get our_code")
our_code (flat_map (lambda (x) (let (ins (eval x inner_env)) our_code (flat_map (lambda (x) (let (ins (eval x inner_env))
(cond (array? ins) ins (cond (array? ins) ins
true (ins) ; un-evaled function, bare WAT true (ins) ; un-evaled function, bare WAT
))) )))
body) body)
_ (println "resulting code " our_code)
) [ ) [
outer_name_dict outer_name_dict
; type ; type
@@ -186,12 +198,15 @@
(concat code [ [ compressed_locals our_code ] ]) (concat code [ [ compressed_locals our_code ] ])
]) ])
)) ))
drop (lambda () [['drop]])
i32.const (lambda (const) [['i32.const const]]) i32.const (lambda (const) [['i32.const const]])
local.get (lambda (const) [['local.get const]]) local.get (lambda (const) [['local.get const]])
i32.add (lambda (& flatten) (concat (map (lambda (x) (idx x 0)) flatten) [['i32.add]])) i32.add (lambda (& flatten) (concat (flat_map (lambda (x) x) flatten) [['i32.add]]))
block (lambda (& inner) [['block [] (flat_map (lambda (x) (cond (array? x) x
true (x))) inner)]])
export (vau de (name t_v) (lambda (name_dict type function memory export code) export (vau de (name t_v) (lambda (name_dict type function memory export code)
[ name_dict type function memory (concat export [ [ name (idx t_v 0) (get-value name_dict (idx t_v 1)) ] ]) code ] [ name_dict type function memory (concat export [ [ name (idx t_v 0) (get-value name_dict (idx t_v 1)) ] ]) code ]
)) ))
) )
(provide wasm_to_binary module func i32.const local.get i32.add export) (provide wasm_to_binary module func drop i32.const local.get i32.add block export)
)) ))