Commit b8a8e009 authored by Camil Staps's avatar Camil Staps 🍃

Fix bugs and resolve todos after new implementation of the WebAssembly generator

parent cc36c94f
Pipeline #23360 failed with stages
in 15 minutes and 46 seconds
......@@ -17,7 +17,6 @@
(global $js-ref-constructor (mut i32) (i32.const 0))
(func $js-ref-found (import "clean" "js_ref_found") (param i32))
(func $get-asp (import "clean" "get_asp") (result i32))
(func $set-hp (import "clean" "set_hp") (param i32))
(func $set-hp-free (import "clean" "set_hp_free") (param i32))
......@@ -152,8 +151,7 @@
)
)
(func (export "gc")
(local $asp i32)
(func (export "gc") (param $asp i32)
(local $old i32)
(local $new i32)
(local $n i32)
......@@ -164,8 +162,6 @@
(call $gc-start)
(local.set $asp (call $get-asp))
(if
(global.get $in-first-semispace)
(then
......
......@@ -102,7 +102,6 @@ intp = new Uint8Array(intp);
update_host_reference: function(index,new_location) {
},
get_asp: () => intp.instance.exports.get_asp(),
set_hp: hp => intp.instance.exports.set_hp(hp),
set_hp_free: free => intp.instance.exports.set_hp_free(free),
......
......@@ -152,7 +152,7 @@ dNil_ptr :: Expr TWord
small_integer :: !(Expr TInt) -> Expr TWord
static_character :: !(Expr TChar) -> Expr TWord
static_boolean :: !(Expr TWord) -> Expr TWord
caf_list :: Expr (TPtr (TPtr TWord))
caf_list :: Expr (TPtr TWord)
push_c :: !(Expr (TPtr TWord)) !Target -> Target
pop_pc_from_c :: !Target -> Target
......
......@@ -481,8 +481,8 @@ static_character c = "(BC_WORD)&static_characters[("+-+c+-+")<<1]"
static_boolean :: !(Expr TWord) -> Expr TWord
static_boolean b = "(BC_WORD)&static_booleans[("+-+b+-+") ? 2 : 0]"
caf_list :: Expr (TPtr (TPtr TWord))
caf_list = "caf_list"
caf_list :: Expr (TPtr TWord)
caf_list = "(BC_WORD*)caf_list"
push_c :: !(Expr (TPtr TWord)) !Target -> Target
push_c v t = append ("\t*++csp=(BC_WORD)"+-+v+-+";") t
......
......@@ -157,7 +157,7 @@ dNil_ptr :: Expr TWord
small_integer :: !(Expr TInt) -> Expr TWord
static_character :: !(Expr TChar) -> Expr TWord
static_boolean :: !(Expr TWord) -> Expr TWord
caf_list :: Expr (TPtr (TPtr TWord))
caf_list :: Expr (TPtr TWord)
push_c :: !(Expr (TPtr TWord)) !Target -> Target
pop_pc_from_c :: !Target -> Target
......
......@@ -119,7 +119,6 @@ new_temp_var tp t
F64 -> {t & temp_vars.tv_f64=t.temp_vars.tv_f64+1}
= (Local var,t)
// TODO: see how many of these are actually needed
i32_temp_vars =: {#{#'v','w',i} \\ i <- ['0'..'9']}
i64_temp_vars =: {#{#'v','q',i} \\ i <- ['0'..'9']}
f64_temp_vars =: {#{#'v','d',i} \\ i <- ['0'..'0']}
......@@ -256,7 +255,7 @@ where
| otherwise = abort ("unknown variable "+++v+++"\n")
type2 :: !a !a -> Type | type a
type2 a b = let ta = type a in ta // TODO: if (ta == type b) ta (abort "type mismatch\n")
type2 a b = let ta = type a in if (ta == type b) ta (abort "type mismatch\n")
instance toString Ex
where
......@@ -352,17 +351,21 @@ where
bootstrap :: ![String] -> [String]
bootstrap instrs = instrs
rt_vars :: [String]
rt_vars =: ["pc","asp","bsp","csp","hp","hp-size","hp-free"]
collect_instructions :: !Options ![Target] -> [String]
collect_instructions {instructions_order=Nothing} _ = abort "no abc instructions order specified\n"
collect_instructions {debug_instructions,instructions_order=Just instrs_order} is =
start ++
reverse [block_start i \\ i <- is] ++
header ++
reverse [block_start i \\ i <- is_with_illegal_block] ++
switch ++
flatten [block_body i \\ i <- is] ++
end
flatten [block_body i \\ i <- is_with_illegal_block] ++
footer
where
rt_vars = ["pc","asp","bsp","csp","hp","hp-size","hp-free"]
start =
is_with_illegal_block = is ++ [end_instruction (instr_unimplemented (begin_instruction "illegal" start))]
header =
[ "(module"
, "(import \"clean\" \"memory\" (memory 1))"
......@@ -392,7 +395,7 @@ where
, "(func $clean_handle_illegal_instr (import \"clean\" \"handle_illegal_instr\") (param i32 i32 i32 i32 i32 i32 i32) (result i32))"
, "(func $clean_illegal_instr (import \"clean\" \"illegal_instr\") (param i32 i32))"
, "(func $clean_out_of_memory (import \"clean\" \"out_of_memory\"))"
, "(func $clean_gc (import \"clean\" \"gc\"))"
, "(func $clean_gc (import \"clean\" \"gc\") (param i32))"
, "(func $clean_halt (import \"clean\" \"halt\") (param i32 i32 i32))"
] ++
......@@ -410,12 +413,13 @@ where
[ "(loop $abc-loop"
, "(block $abc-gc"
]
end =
footer =
[ ")" // block abc-gc
, "(local.set $vw0 (local.get $hp-free))"
, "(call $clean_gc)"
, "(if (i32.le_s (local.get $hp-free) (local.get $vw0))"
, "(call $clean_gc (local.get $asp))"
, "(if (i32.le_s (global.get $g-hp-free) (local.get $hp-free))"
, "\t(then (call $clean_out_of_memory) (unreachable)))"
, "(local.set $hp (global.get $g-hp))"
, "(local.set $hp-free (global.get $g-hp-free))"
, "(br $abc-loop)"
, ")" // loop abc-loop
, "(unreachable)"
......@@ -429,15 +433,12 @@ where
head = reverse [";; "+++i \\ i <- t.instrs]
switch =
[ "(block $instr_illegal"
, if debug_instructions
[ if debug_instructions
"\t(call $clean_debug_instr (local.get $pc) (i32.load (local.get $pc)))"
""
, "\t(br_table " +++
foldr (+++) "" [find_label i is \\ i <- instrs_order] +++
"$instr_illegal (i32.load (local.get $pc)))"
, ")"
: /*unimplemented_block TODO ++*/ ["(br $abc-loop)"]
]
where
find_label i [t:ts]
......@@ -483,7 +484,19 @@ instr_mulUUL :: !Target -> Target
instr_mulUUL t = instr_unimplemented t // TODO
instr_RtoAC :: !Target -> Target
instr_RtoAC t = instr_unimplemented t // TODO
instr_RtoAC t = (
new_local TReal (to_real (B @ 0)) \r ->
new_local THWord (Ecall "clean_RtoAC_words_needed" (r -- ELNil)) \lw ->
//ensure_hp (lw ::: THWord) :. // TODO
A @ 1 .= to_word Hp :.
Hp .= (Ecall "clean_RtoAC" (Hp -- r -- ELNil) ::: TPtr TWord) :.
advance_ptr Pc 1 :.
advance_ptr A 1 :.
advance_ptr B 1
) t
where
(:::) :: !(Expr t) t -> Expr t
(:::) e _ = e
lit_word :: !Int -> Expr TWord
lit_word w = Econst I64 w
......@@ -558,7 +571,7 @@ instance ^ (Expr TReal) where ^ a b = Ecall "clean_powR" (a -- b -- ELNil)
(>=.) a b = Ege (type2 a b) Signed a b
(&&.) infixr 3 :: !(Expr TBool) !(Expr TBool) -> Expr TBool
(&&.) a b = Eor (type2 a b) a b
(&&.) a b = Eand (type2 a b) a b
(&.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(&.) a b = Eand (type2 a b) a b
......@@ -911,7 +924,7 @@ where
TRUE = Econst I64 (8*668)
FALSE = Econst I64 (8*666)
caf_list :: Expr (TPtr (TPtr TWord))
caf_list :: Expr (TPtr TWord)
caf_list = Econst I32 (97*8)
C = Local "csp"
......
......@@ -1656,9 +1656,9 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
ui += lit_word 1
) :.
if_then (n_a <>. lit_word 0) (
new_local (TPtr TWord) (caf_list @ 1) \a ->
new_local (TPtr TWord) (to_word_ptr (caf_list @ 1)) \a ->
a @ -1 .= to_word n :.
caf_list @ 1 .= n
caf_list @ 1 .= to_word n
)
, instr "fillh3" (Just 2) $
ensure_hp 2 :.
......@@ -2171,7 +2171,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
A @ (n_a - i) .= n @ 0 :.
i += lit_hword 1
) :.
grow_a (to_hword n_a) :. // compiler cannot resolve overloading without to_hword
grow_a (to_hword n_a) :. // NB: compiler cannot resolve overloading without to_hword
while_do (i <. n_total) (
B @ (n_a - n_total + i) .= n @ 0 :.
advance_ptr n 1 :.
......@@ -2837,7 +2837,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
if_then (end_i >. to_int l) (end_i .= to_int l) :.
l .= to_word (end_i - first_i) :.
new_local TWord (if_i64_or_i32_expr ((l + lit_word 7) >>. lit_word 3) ((l + lit_word 3) >>. lit_word 2) + lit_word 2) \lw ->
ensure_hp (to_hword lw) :. // compiler cannot resolve overloading without to_hword
ensure_hp (to_hword lw) :. // NB: compiler cannot resolve overloading without to_hword
shrink_b 2 :.
Hp @ 0 .= STRING__ptr + lit_word 2 :.
Hp @ 1 .= l :.
......@@ -3029,7 +3029,7 @@ all_instructions opts t = bootstrap $ collect_instructions opts $ map (\i -> i t
Hp @ 1 .= l :.
new_local (TPtr TChar) (to_char_ptr (Hp @? 2)) \p ->
p @ 0 .= lit_char '-' :.
advance_ptr p (to_hword l) :. // compiler cannot resolve overloading without to_hword
advance_ptr p (to_hword l) :. // NB: compiler cannot resolve overloading without to_hword
advance_ptr Hp lw :.
advance_ptr Pc 1 :.
while_do (ui >=. lit_word 10) (
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment