Commit 1ff8b9dc authored by Camil Staps's avatar Camil Staps 🍃

Optimize wasm interpreter by using i32 for as many pointer offsets as possible...

Optimize wasm interpreter by using i32 for as many pointer offsets as possible (avoids unnecessary i32.wrap_i64)
parent b8a8e009
Pipeline #23776 failed with stages
in 12 minutes and 56 seconds
......@@ -4,9 +4,6 @@ import StdEnv
import StdMaybe
import interpretergen
:: THWord :== TWord
THWord :== TWord
:: Target
:: Expr t
......@@ -21,13 +18,13 @@ instr_mulUUL :: !Target -> Target
instr_RtoAC :: !Target -> Target
lit_word :: !Int -> Expr TWord
lit_hword :== lit_word
lit_hword :: !Int -> Expr THWord
lit_char :: !Char -> Expr TChar
lit_short :: !Int -> Expr TShort
lit_int :: !Int -> Expr TInt
instance to_word TWord, TChar, TInt, TShort, (TPtr t), TReal
to_hword :== to_word
instance to_hword TWord, THWord, TShort
instance to_bool TWord
instance to_char TWord
instance to_int TWord
......@@ -89,21 +86,22 @@ nop :: !Target -> Target
(:.) infixr 1 :: !(Target -> Target) !(Target -> Target) !Target -> Target
class typename t :: t -> String
instance typename TWord, TChar, TShort, TInt, TReal, (TPtr t) | typename t
instance typename TWord, THWord, TChar, TShort, TInt, TReal, (TPtr t) | typename t
new_local :: !t !(Expr t) !((Expr t) Target -> Target) !Target -> Target | typename t
class (.=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target
instance .=
TWord TWord, TWord TBool, TWord TChar, TWord TInt, TWord TShort,
TWord TWord, TWord THWord, TWord TBool, TWord TChar, TWord TInt, TWord TShort,
THWord THWord,
TChar TChar,
TInt TInt, TInt TWord,
(TPtr t) (TPtr u) // NB/TODO: no checking on child types!
class (+=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target
instance += TWord TWord
instance += TWord TWord, THWord THWord
class (-=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target
instance -= TWord TWord, TShort TShort, TInt TInt
instance -= TWord TWord, THWord THWord, TShort TShort
class advance_ptr i :: !(Expr (TPtr v)) !i !Target -> Target
instance advance_ptr Int, (Expr w)
......@@ -131,8 +129,7 @@ if_then_else ::
if_break_else :: !(Expr TBool) !(Target -> Target) !Target -> Target
class ensure_hp s :: !s !Target -> Target
instance ensure_hp (Expr TWord)
instance ensure_hp Int
instance ensure_hp Int, (Expr t)
A :: Expr (TPtr TWord)
B :: Expr (TPtr TWord)
......@@ -157,8 +154,8 @@ caf_list :: Expr (TPtr TWord)
push_c :: !(Expr (TPtr TWord)) !Target -> Target
pop_pc_from_c :: !Target -> Target
memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr TWord) !Target -> Target
strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr TWord) -> Expr TInt
memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr THWord) !Target -> Target
strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr THWord) -> Expr TInt
putchar :: !(Expr TChar) !Target -> Target
print_bool :: !(Expr TWord) !Target -> Target
......
......@@ -185,6 +185,9 @@ instr_RtoAC t = foldl (flip append) t
lit_word :: !Int -> Expr TWord
lit_word i = toString i
lit_hword :: !Int -> Expr THWord
lit_hword i = toString i
lit_char :: !Char -> Expr TChar
lit_char c = {#'\'',c,'\''}
......@@ -201,6 +204,10 @@ instance to_word TShort where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word (TPtr t) where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TReal where to_word e = "*(BC_WORD*)&("+-+e+-+")"
instance to_hword TWord where to_hword w = "(int)("+-+w+-+")"
instance to_hword THWord where to_hword w = w
instance to_hword TShort where to_hword s = "(int)("+-+s+-+")"
instance to_bool TWord
where
to_bool e = e`
......@@ -339,6 +346,7 @@ nop t = t
(:.) first then t = then (first t)
instance typename TWord where typename _ = "BC_WORD"
instance typename THWord where typename _ = "int"
instance typename TChar where typename _ = "char"
instance typename TShort where typename _ = "int16_t"
instance typename TInt where typename _ = "BC_WORD_S"
......@@ -353,14 +361,16 @@ where
set :: !(Expr v) !(Expr e) !Target -> Target
set v e t = append ("\t"+-+v+-+"="+-+e+-+";") t
instance .= TWord TWord where .= v e t = set v e t
instance .= TWord TBool where .= v e t = set v e t
instance .= TWord TChar where .= v e t = set v e t
instance .= TWord TInt where .= v e t = set v e t
instance .= TWord TShort where .= v e t = set v e t
instance .= TChar TChar where .= v e t = set v e t
instance .= TInt TInt where .= v e t = set v e t
instance .= TInt TWord where .= v e t = set v e t
instance .= TWord TWord where .= v e t = set v e t
instance .= TWord THWord where .= v e t = set v e t
instance .= TWord TBool where .= v e t = set v e t
instance .= TWord TChar where .= v e t = set v e t
instance .= TWord TInt where .= v e t = set v e t
instance .= TWord TShort where .= v e t = set v e t
instance .= THWord THWord where .= v e t = set v e t
instance .= TChar TChar where .= v e t = set v e t
instance .= TInt TInt where .= v e t = set v e t
instance .= TInt TWord where .= v e t = set v e t
instance .= (TPtr t) (TPtr u) where .= v e t = set v e t
add_local :: !(Expr v) !(Expr e) !Target -> Target
......@@ -369,7 +379,8 @@ add_local v e t = case e of
"1" -> append ("\t"+-+v+-+"++;") t
e -> append ("\t"+-+v+-+"+="+-+e+-+";") t
instance += TWord TWord where += v e t = add_local v e t
instance += TWord TWord where += v e t = add_local v e t
instance += THWord THWord where += v e t = add_local v e t
sub_local :: !(Expr v) !(Expr e) !Target -> Target
sub_local v e t = case e of
......@@ -378,8 +389,8 @@ sub_local v e t = case e of
e -> append ("\t"+-+v+-+"-="+-+e+-+";") t
instance -= TWord TWord where -= v e t = sub_local v e t
instance -= THWord THWord where -= v e t = sub_local v e t
instance -= TShort TShort where -= v e t = sub_local v e t
instance -= TInt TInt where -= v e t = sub_local v e t
instance advance_ptr Int where advance_ptr v e t = add_local v (toString e) t
instance advance_ptr (Expr w) where advance_ptr v e t = add_local v e t
......@@ -427,7 +438,7 @@ if_then_else c then elifs else t
if_break_else :: !(Expr TBool) !(Target -> Target) !Target -> Target
if_break_else c else t = concat_up_to_mark (else (append ("\t\tif ("+-+c+-+") break;") (mark t)))
instance ensure_hp (Expr TWord) where ensure_hp i t = append ("\tNEED_HEAP("+-+i+-+");") t
instance ensure_hp (Expr t) where ensure_hp i t = append ("\tNEED_HEAP("+-+i+-+");") t
instance ensure_hp Int where ensure_hp i t = append ("\tNEED_HEAP("+-+toString i+-+");") t
A :: Expr (TPtr TWord)
......@@ -490,10 +501,10 @@ push_c v t = append ("\t*++csp=(BC_WORD)"+-+v+-+";") t
pop_pc_from_c :: !Target -> Target
pop_pc_from_c t = append "\tpc=(BC_WORD*)*csp--;" t
memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr TWord) !Target -> Target
memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr THWord) !Target -> Target
memcpy d s n t = append ("\tmemcpy("+-+d+-+","+-+s+-+","+-+n+-+");") t
strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr TWord) -> Expr TInt
strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr THWord) -> Expr TInt
strncmp s1 s2 n = "strncmp("+-+s1+-+","+-+s2+-+","+-+n+-+")"
putchar :: !(Expr TChar) !Target -> Target
......
......@@ -4,8 +4,6 @@ import StdEnv
import StdMaybe
import interpretergen
:: THWord = THWord
:: Type
class wasm_type a :: !a -> Type
......@@ -31,8 +29,6 @@ lit_char :: !Char -> Expr TChar
lit_short :: !Int -> Expr TShort
lit_int :: !Int -> Expr TInt
class to_hword t :: !(Expr t) -> Expr THWord
instance to_word THWord, TChar, TInt, TShort, (TPtr t), TReal
instance to_hword TWord, THWord, TShort
instance to_bool TWord
......@@ -137,7 +133,7 @@ if_then_else ::
if_break_else :: !(Expr TBool) !(Target -> Target) !Target -> Target
class ensure_hp s :: !s !Target -> Target
instance ensure_hp Int, (Expr t) | to_hword t /* should be only THWord TODO */
instance ensure_hp Int, (Expr t) | to_hword t
A :: Expr (TPtr TWord)
B :: Expr (TPtr TWord)
......
......@@ -788,19 +788,13 @@ where
instance @? (Expr t)
where
@? p e
# e = force_i32 e
# e = if (type e==I64) (Ewrap I32 I64 e) e
| sft == 0 = Eadd I32 p e
| otherwise = Eadd I32 p (Eshl I32 e (Econst I32 sft))
where
ptr_type = wasm_type (get_type_of_ptr p)
sft = type_width_shift ptr_type
// TODO check if some instructions can be optimized
force_i32 :: !Ex -> Ex
force_i32 e = case type e of
I64 -> Ewrap I32 I64 e
_ -> e
begin_block :: !Target -> Target
begin_block t = append Eblock t
......@@ -951,13 +945,13 @@ strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr THWord) -> Expr TInt
strncmp s1 s2 n = Eextend I64 I32 (Ecall "clean_strncmp" (s1 -- s2 -- n -- ELNil))
putchar :: !(Expr TChar) !Target -> Target
putchar c t = append (Ecall "clean_putchar" (force_i32 c -- ELNil)) t
putchar c t = append (Ecall "clean_putchar" (Ewrap I32 I64 c -- ELNil)) t
print_bool :: !(Expr TWord) !Target -> Target
print_bool c t = append (Ecall "clean_print_bool" (force_i32 c -- ELNil)) t
print_bool c t = append (Ecall "clean_print_bool" (Ewrap I32 I64 c -- ELNil)) t
print_char :: !Bool !(Expr TChar) !Target -> Target
print_char quotes c t = append (Ecall (if quotes "clean_print_char" "clean_putchar") (force_i32 c -- ELNil)) t
print_char quotes c t = append (Ecall (if quotes "clean_print_char" "clean_putchar") (Ewrap I32 I64 c -- ELNil)) t
print_int :: !(Expr TInt) !Target -> Target
print_int c t = append (Ecall "clean_print_int" (high -- low -- ELNil)) t
......
......@@ -9,6 +9,7 @@ from target import :: Expr
}
:: TWord = TWord
:: THWord = THWord
:: TBool = TBool
:: TChar = TChar
:: TShort = TShort
......@@ -18,6 +19,7 @@ from target import :: Expr
:: TPtr t = TPtr !t
class to_word t :: !(Expr t) -> Expr TWord
class to_hword t :: !(Expr t) -> Expr THWord
class to_bool t :: !(Expr t) -> Expr TBool
class to_char t :: !(Expr t) -> Expr TChar
class to_short t :: !(Expr t) -> Expr TShort
......
This diff is collapsed.
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