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

compile static calls to static wasm calls

Browse Source
This commit is contained in:
Nathan Braswell
2022-04-01 01:06:40 -04:00
parent b87afc6a12
commit d5b11ca037
1 changed files with 57 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
partial_eval.scm
View File

@@ -2423,6 +2423,7 @@
; no function will have a 0 func index and count as falsy ; no function will have a 0 func index and count as falsy
(dyn_start (+ 0 k_slice_impl)) (dyn_start (+ 0 k_slice_impl))
(func_id_dynamic_ofset (+ (- 0 dyn_start) (- num_pre_functions 1)))
; This and is 1111100011 ; This and is 1111100011
; The end ensuring 01 makes only ; The end ensuring 01 makes only
@@ -4238,26 +4239,17 @@
((param_codes first_params_err ctx) (compile_params false ctx params)) ((param_codes first_params_err ctx) (compile_params false ctx params))
((func_val func_code func_err ctx) (compile-inner ctx func_value false)) ((func_val func_code func_err ctx) (compile-inner ctx func_value false))
;(_ (print_strip "func val " func_val " func code " func_code " func err " func_err " param_codes " param_codes " err " err " from " func_value)) ;(_ (print_strip "func val " func_val " func code " func_code " func err " func_err " param_codes " param_codes " err " err " from " func_value))
(func_code (mif func_val (i64.const func_val) func_code))
((unval_param_codes err ctx) (compile_params true ctx params)) ((unval_param_codes err ctx) (compile_params true ctx params))
((bad_unval_params_msg_val _ _ ctx) (compile-inner ctx (marked_val (str "error was with unval-evaling parameters of " (str_strip c))) true)) ((bad_unval_params_msg_val _ _ ctx) (compile-inner ctx (marked_val (str "error was with unval-evaling parameters of " (str_strip c))) true))
(result_code (concat (wrap_0_param_code (concat
func_code
(local.set '$tmp)
(_if '$is_wrap_0
(i64.eq (i64.const #x00) (i64.and (local.get '$tmp) (i64.const #x30)))
(then
(local.get '$tmp) ; saving ito restore it (local.get '$tmp) ; saving ito restore it
(apply concat param_codes) (apply concat param_codes)
(local.set '$param_ptr (call '$malloc (i32.const (* 8 num_params)))) (local.set '$param_ptr (call '$malloc (i32.const (* 8 num_params))))
(flat_map (lambda (i) (i64.store (* i 8) (local.set '$tmp) (local.get '$param_ptr) (local.get '$tmp))) (flat_map (lambda (i) (i64.store (* i 8) (local.set '$tmp) (local.get '$param_ptr) (local.get '$tmp)))
(range (- num_params 1) -1)) (range (- num_params 1) -1))
(local.set '$tmp) ; restoring tmp (local.set '$tmp) ; restoring tmp
) ))
(else (wrap_1_param_code (concat
(_if '$is_wrap_1
(i64.eq (i64.const #x10) (i64.and (local.get '$tmp) (i64.const #x30)))
(then
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Since we're not sure if it's going to be a vau or not, ; Since we're not sure if it's going to be a vau or not,
; this code might not be compilable, so we gracefully handle ; this code might not be compilable, so we gracefully handle
@@ -4275,14 +4267,41 @@
(flat_map (lambda (i) (i64.store (* i 8) (local.set '$tmp) (local.get '$param_ptr) (local.get '$tmp))) (flat_map (lambda (i) (i64.store (* i 8) (local.set '$tmp) (local.get '$param_ptr) (local.get '$tmp)))
(range (- num_params 1) -1)) (range (- num_params 1) -1))
(local.set '$tmp) ; restoring tmp (local.set '$tmp) ; restoring tmp
)) ))))
) (wrap_x_param_code (concat
(else
; TODO: Handle other wrap levels ; TODO: Handle other wrap levels
(call '$print (i64.const weird_wrap_msg_val)) (call '$print (i64.const weird_wrap_msg_val))
(unreachable) (unreachable)))
;(func_code (mif func_val (i64.const func_val) func_code))
(result_code (mif func_val
(concat
(dlet ((wrap_level (>> (band func_val #x30) 4)))
(cond ((= 0 wrap_level) wrap_0_param_code)
((= 1 wrap_level) wrap_1_param_code)
(true wrap_x_param_code)))
(call (- (>> func_val 35) func_id_dynamic_ofset (- 0 num_pre_functions) 1)
;params
(i64.or (i64.extend_i32_u (local.get '$param_ptr))
(i64.const (bor (<< num_params 32) #x5)))
;dynamic env (is caller's static env)
(call '$dup (local.get '$s_env))
; static env
(i64.const (bor (<< (band func_val #x3FFFFFFC0) 2) #b01001))
) )
) )
(concat
func_code
(local.set '$tmp)
(_if '$is_wrap_0
(i64.eq (i64.const #x00) (i64.and (local.get '$tmp) (i64.const #x30)))
(then wrap_0_param_code)
(else
(_if '$is_wrap_1
(i64.eq (i64.const #x10) (i64.and (local.get '$tmp) (i64.const #x30)))
(then wrap_1_param_code)
(else wrap_x_param_code)
)
) )
) )
(call_indirect (call_indirect
@@ -4306,7 +4325,7 @@
(i64.const 2)) (i64.const #b01001)) (i64.const 2)) (i64.const #b01001))
;func_idx ;func_idx
(i32.wrap_i64 (i64.shr_u (local.get '$tmp) (i64.const 35))) (i32.wrap_i64 (i64.shr_u (local.get '$tmp) (i64.const 35)))
))) ))))
) (array nil result_code (mif func_err func_err first_params_err) ctx))) ) (array nil result_code (mif func_err func_err first_params_err) ctx)))
)))))) ))))))
@@ -4482,7 +4501,8 @@
(concat setup_code inner_code end_code) (concat setup_code inner_code end_code)
)) ))
(funcs (concat funcs our_func)) (funcs (concat funcs our_func))
(our_func_idx (+ (- (len funcs) dyn_start) (- num_pre_functions 1))) ;(our_func_idx (+ (- (len funcs) dyn_start) (- num_pre_functions 1)))
(our_func_idx (+ (len funcs) func_id_dynamic_ofset))
(func_value (bor (<< our_func_idx 35) (<< wrap_level 4) #b0001)) (func_value (bor (<< our_func_idx 35) (<< wrap_level 4) #b0001))
(memo (put memo (.hash c) func_value)) (memo (put memo (.hash c) func_value))
(_ (print_strip "the hash " (.hash c) " with value " func_value " corresponds to " c)) (_ (print_strip "the hash " (.hash c) " with value " func_value " corresponds to " c))