Commit 8407c79f authored by Camil Staps's avatar Camil Staps 🐾

Merge branch 'optimise-wasm-interpreter' into 'master'

Optimise wasm interpreter

See merge request !108
parents cc45c57f e641d333
Pipeline #25354 passed with stages
in 13 minutes and 49 seconds
...@@ -17,7 +17,6 @@ ...@@ -17,7 +17,6 @@
(global $js-ref-constructor (mut i32) (i32.const 0)) (global $js-ref-constructor (mut i32) (i32.const 0))
(func $js-ref-found (import "clean" "js_ref_found") (param i32)) (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 (import "clean" "set_hp") (param i32))
(func $set-hp-free (import "clean" "set_hp_free") (param i32)) (func $set-hp-free (import "clean" "set_hp_free") (param i32))
...@@ -152,8 +151,7 @@ ...@@ -152,8 +151,7 @@
) )
) )
(func (export "gc") (func (export "gc") (param $asp i32)
(local $asp i32)
(local $old i32) (local $old i32)
(local $new i32) (local $new i32)
(local $n i32) (local $n i32)
...@@ -164,8 +162,6 @@ ...@@ -164,8 +162,6 @@
(call $gc-start) (call $gc-start)
(local.set $asp (call $get-asp))
(if (if
(global.get $in-first-semispace) (global.get $in-first-semispace)
(then (then
......
...@@ -102,7 +102,6 @@ intp = new Uint8Array(intp); ...@@ -102,7 +102,6 @@ intp = new Uint8Array(intp);
update_host_reference: function(index,new_location) { 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: hp => intp.instance.exports.set_hp(hp),
set_hp_free: free => intp.instance.exports.set_hp_free(free), set_hp_free: free => intp.instance.exports.set_hp_free(free),
...@@ -236,11 +235,16 @@ intp = new Uint8Array(intp); ...@@ -236,11 +235,16 @@ intp = new Uint8Array(intp);
if (scriptArgs.indexOf('--extract-code') >= 0) { if (scriptArgs.indexOf('--extract-code') >= 0) {
var obj = wasmExtractCode(intp.module, 'best'); var obj = wasmExtractCode(intp.module, 'best');
const extractable = ['interpret'];
var exports = {}; var exports = {};
for (var f in intp.instance.exports) for (var f in intp.instance.exports)
exports[intp.instance.exports[f].name] = f; exports[intp.instance.exports[f].name] = f;
obj.segments.filter(seg => seg.kind == 0).map(function (seg) { obj.segments.filter(function (seg) {
return seg.kind == 0 &&
extractable.indexOf(exports[seg.funcIndex]) >= 0;
}).map(function (seg) {
var name = seg.funcIndex in exports ? exports[seg.funcIndex] : ('_'+seg.funcIndex); var name = seg.funcIndex in exports ? exports[seg.funcIndex] : ('_'+seg.funcIndex);
var filename = 'disas-'+name+'.bin'; var filename = 'disas-'+name+'.bin';
var code = obj.code.subarray(seg.funcBodyBegin, seg.funcBodyEnd); var code = obj.code.subarray(seg.funcBodyBegin, seg.funcBodyEnd);
......
20945800
halt at 4
471012 53276 524288
20945800
halt at 4
235503 26641 262144
s/3000/10000/
s/Start.*/Start = sum [Select [2,3:Primes] NrOfPrimes \\\\ _ <- [1..200]]/
...@@ -15,8 +15,7 @@ On a machine without a math coprocessor the execution of this ...@@ -15,8 +15,7 @@ On a machine without a math coprocessor the execution of this
program might take a (very) long time. Set NrOfPrimes to a smaller value. program might take a (very) long time. Set NrOfPrimes to a smaller value.
*/ */
import StdClass import StdEnv
import StdInt, StdReal
NrOfPrimes :== 3000 NrOfPrimes :== 3000
......
...@@ -122,7 +122,7 @@ int add_strtab_section(Elf *e) { ...@@ -122,7 +122,7 @@ int add_strtab_section(Elf *e) {
uint64_t *find_start_of_br_table(uint64_t *code, unsigned int size) { uint64_t *find_start_of_br_table(uint64_t *code, unsigned int size) {
unsigned int optimum=0; unsigned int optimum=0;
unsigned int opt_size=1; unsigned int opt_size=10; /* to decrease verbosity */
uint8_t *code8=(uint8_t*)code; uint8_t *code8=(uint8_t*)code;
size<<=3; size<<=3;
...@@ -134,7 +134,7 @@ uint64_t *find_start_of_br_table(uint64_t *code, unsigned int size) { ...@@ -134,7 +134,7 @@ uint64_t *find_start_of_br_table(uint64_t *code, unsigned int size) {
for (; j<(size-i)>>3; j++) for (; j<(size-i)>>3; j++)
if ((code[j]>>24)!=this_high) if ((code[j]>>24)!=this_high)
break; break;
if (j > opt_size) { if (j >= opt_size) {
opt_size=j; opt_size=j;
optimum=i; optimum=i;
fprintf(stderr,"new optimum %d at %d: 0x%010lx......\n",opt_size,optimum,this_high); fprintf(stderr,"new optimum %d at %d: 0x%010lx......\n",opt_size,optimum,this_high);
...@@ -155,7 +155,7 @@ char *find_movabs_of_br_table(char *code, unsigned int size, uint64_t high_bytes ...@@ -155,7 +155,7 @@ char *find_movabs_of_br_table(char *code, unsigned int size, uint64_t high_bytes
if (code[i]==0x48) if (code[i]==0x48)
return &code[i]; return &code[i];
if (code[i]==0x49) if (code[i]==0x49)
return &code[i+1]; return &code[i];
} }
} }
......
...@@ -18,25 +18,20 @@ instr_mulUUL :: !Target -> Target ...@@ -18,25 +18,20 @@ instr_mulUUL :: !Target -> Target
instr_RtoAC :: !Target -> Target instr_RtoAC :: !Target -> Target
lit_word :: !Int -> Expr TWord lit_word :: !Int -> Expr TWord
lit_hword :: !Int -> Expr TPtrOffset
lit_char :: !Char -> Expr TChar lit_char :: !Char -> Expr TChar
lit_short :: !Int -> Expr TShort lit_short :: !Int -> Expr TShort
lit_int :: !Int -> Expr TInt lit_int :: !Int -> Expr TInt
instance to_word TChar instance to_word TWord, TChar, TInt, TShort, (TPtr t), TReal
instance to_word TInt instance to_bool TWord
instance to_word TShort
instance to_word (TPtr t)
instance to_word TReal
instance to_char TWord instance to_char TWord
instance to_int TWord instance to_int TWord
instance to_real TWord instance to_real TWord
instance to_word_ptr TWord, (TPtr t) instance to_word_ptr TWord, (TPtr t)
instance to_char_ptr TWord, (TPtr t) instance to_char_ptr TWord, (TPtr t)
instance to_short_ptr TWord, (TPtr t) instance to_short_ptr TWord, (TPtr t)
instance to_ptr_offset TWord, TPtrOffset, TShort
instance + (Expr t) instance + (Expr t)
instance - (Expr t) instance - (Expr t)
...@@ -45,15 +40,14 @@ instance / (Expr t) ...@@ -45,15 +40,14 @@ instance / (Expr t)
instance ^ (Expr TReal) instance ^ (Expr TReal)
(%.) infixl 6 :: !(Expr TInt) !(Expr TInt) -> Expr TInt (%.) infixl 6 :: !(Expr TInt) !(Expr TInt) -> Expr TInt
(==.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (==.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(<>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (<>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(<.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (<.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(<=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (<=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(>=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (>=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(&&.) infixr 3 :: !(Expr TWord) !(Expr TWord) -> Expr TWord (&&.) infixr 3 :: !(Expr TBool) !(Expr TBool) -> Expr TBool
notB :: !(Expr TWord) -> Expr TWord
(&.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord (&.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(|.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord (|.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
...@@ -81,7 +75,7 @@ RtoI :: !(Expr TReal) -> Expr TInt ...@@ -81,7 +75,7 @@ RtoI :: !(Expr TReal) -> Expr TInt
if_i64_or_i32 :: !(Target -> Target) !(Target -> Target) !Target -> Target if_i64_or_i32 :: !(Target -> Target) !(Target -> Target) !Target -> Target
if_i64_or_i32_expr :: !(Expr t) !(Expr t) -> Expr t if_i64_or_i32_expr :: !(Expr t) !(Expr t) -> Expr t
if_expr :: !(Expr TWord) !(Expr t) !(Expr t) -> Expr t if_expr :: !(Expr TBool) !(Expr t) !(Expr t) -> Expr t
begin_instruction :: !String !Target -> Target begin_instruction :: !String !Target -> Target
end_instruction :: !Target -> Target end_instruction :: !Target -> Target
...@@ -92,21 +86,22 @@ nop :: !Target -> Target ...@@ -92,21 +86,22 @@ nop :: !Target -> Target
(:.) infixr 1 :: !(Target -> Target) !(Target -> Target) !Target -> Target (:.) infixr 1 :: !(Target -> Target) !(Target -> Target) !Target -> Target
class typename t :: t -> String class typename t :: t -> String
instance typename TWord, TChar, TShort, TInt, TReal, (TPtr t) | typename t instance typename TWord, TPtrOffset, TChar, TShort, TInt, TReal, (TPtr t) | typename t
new_local :: !t !(Expr t) !((Expr t) Target -> Target) !Target -> Target | 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 class (.=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target
instance .= instance .=
TWord TWord, TWord TChar, TWord TInt, TWord TShort, TWord TWord, TWord TPtrOffset, TWord TBool, TWord TChar, TWord TInt, TWord TShort,
TPtrOffset TPtrOffset,
TChar TChar, TChar TChar,
TInt TInt, TInt TWord, TInt TInt, TInt TWord,
(TPtr t) (TPtr u) // NB/TODO: no checking on child types! (TPtr t) (TPtr u) // NB/TODO: no checking on child types!
class (+=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target class (+=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target
instance += TWord TWord instance += TWord TWord, TPtrOffset TPtrOffset
class (-=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target class (-=) infix 2 v e :: !(Expr v) !(Expr e) !Target -> Target
instance -= TWord TWord, TShort TShort, TInt TInt instance -= TWord TWord, TPtrOffset TPtrOffset, TShort TShort
class advance_ptr i :: !(Expr (TPtr v)) !i !Target -> Target class advance_ptr i :: !(Expr (TPtr v)) !i !Target -> Target
instance advance_ptr Int, (Expr w) instance advance_ptr Int, (Expr w)
...@@ -123,19 +118,18 @@ instance @? Int, (Expr t) ...@@ -123,19 +118,18 @@ instance @? Int, (Expr t)
begin_block :: !Target -> Target begin_block :: !Target -> Target
end_block :: !Target -> Target end_block :: !Target -> Target
while_do :: !(Expr TWord) !(Target -> Target) !Target -> Target while_do :: !(Expr TBool) !(Target -> Target) !Target -> Target
break :: !Target -> Target break :: !Target -> Target
if_then_else :: if_then_else ::
!(Expr TWord) !(Target -> Target) !(Expr TBool) !(Target -> Target)
![(Expr TWord, Target -> Target)] ![(Expr TBool, Target -> Target)]
!(Maybe (Target -> Target)) !(Maybe (Target -> Target))
!Target -> Target !Target -> Target
if_break_else :: !(Expr TWord) !(Target -> Target) !Target -> Target if_break_else :: !(Expr TBool) !(Target -> Target) !Target -> Target
class ensure_hp s :: !s !Target -> Target class ensure_hp s :: !s !Target -> Target
instance ensure_hp (Expr TWord) instance ensure_hp Int, (Expr t)
instance ensure_hp Int
A :: Expr (TPtr TWord) A :: Expr (TPtr TWord)
B :: Expr (TPtr TWord) B :: Expr (TPtr TWord)
...@@ -148,20 +142,20 @@ INT_ptr :: Expr TWord ...@@ -148,20 +142,20 @@ INT_ptr :: Expr TWord
REAL_ptr :: Expr TWord REAL_ptr :: Expr TWord
ARRAY__ptr :: Expr TWord ARRAY__ptr :: Expr TWord
STRING__ptr :: Expr TWord STRING__ptr :: Expr TWord
jmp_ap_ptr :: !Int -> Expr TWord jmp_ap_ptr :: !Int -> Expr (TPtr TWord)
cycle_ptr :: Expr TWord cycle_ptr :: Expr TWord
indirection_ptr :: Expr TWord indirection_ptr :: Expr TWord
dNil_ptr :: Expr TWord dNil_ptr :: Expr TWord
small_integer :: !(Expr TInt) -> Expr TWord small_integer :: !(Expr TInt) -> Expr TWord
static_character :: !(Expr TChar) -> Expr TWord static_character :: !(Expr TChar) -> Expr TWord
static_boolean :: !(Expr TWord) -> Expr TWord static_boolean :: !(Expr TWord) -> Expr TWord
caf_list :: Expr (TPtr (TPtr TWord)) caf_list :: Expr (TPtr TWord)
push_c :: !(Expr TWord) !Target -> Target push_c :: !(Expr (TPtr TWord)) !Target -> Target
pop_pc_from_c :: !Target -> Target pop_pc_from_c :: !Target -> Target
memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr TWord) !Target -> Target memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr TPtrOffset) !Target -> Target
strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr TWord) -> Expr TInt strncmp :: !(Expr (TPtr TChar)) !(Expr (TPtr TChar)) !(Expr TPtrOffset) -> Expr TInt
putchar :: !(Expr TChar) !Target -> Target putchar :: !(Expr TChar) !Target -> Target
print_bool :: !(Expr TWord) !Target -> Target print_bool :: !(Expr TWord) !Target -> Target
......
...@@ -185,6 +185,9 @@ instr_RtoAC t = foldl (flip append) t ...@@ -185,6 +185,9 @@ instr_RtoAC t = foldl (flip append) t
lit_word :: !Int -> Expr TWord lit_word :: !Int -> Expr TWord
lit_word i = toString i lit_word i = toString i
lit_hword :: !Int -> Expr TPtrOffset
lit_hword i = toString i
lit_char :: !Char -> Expr TChar lit_char :: !Char -> Expr TChar
lit_char c = {#'\'',c,'\''} lit_char c = {#'\'',c,'\''}
...@@ -194,12 +197,20 @@ lit_short i = toString i ...@@ -194,12 +197,20 @@ lit_short i = toString i
lit_int :: !Int -> Expr TInt lit_int :: !Int -> Expr TInt
lit_int i = toString i lit_int i = toString i
instance to_word TWord where to_word e = e
instance to_word TChar where to_word e = "(BC_WORD)("+-+e+-+")" instance to_word TChar where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TInt where to_word e = "(BC_WORD)("+-+e+-+")" instance to_word TInt where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TShort where to_word e = "(BC_WORD)("+-+e+-+")" 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 (TPtr t) where to_word e = "(BC_WORD)("+-+e+-+")"
instance to_word TReal where to_word e = "*(BC_WORD*)&("+-+e+-+")" instance to_word TReal where to_word e = "*(BC_WORD*)&("+-+e+-+")"
instance to_bool TWord
where
to_bool e = e`
where
e` :: Expr TBool
e` = e
instance to_char TWord where to_char e = "(char)("+-+e+-+")" instance to_char TWord where to_char e = "(char)("+-+e+-+")"
instance to_int TWord where to_int e = "(BC_WORD_S)("+-+e+-+")" instance to_int TWord where to_int e = "(BC_WORD_S)("+-+e+-+")"
...@@ -213,6 +224,10 @@ instance to_char_ptr (TPtr t) where to_char_ptr e = "(char*)("+-+e+-+")" ...@@ -213,6 +224,10 @@ instance to_char_ptr (TPtr t) where to_char_ptr e = "(char*)("+-+e+-+")"
instance to_short_ptr TWord where to_short_ptr e = "(int16_t*)("+-+e+-+")" instance to_short_ptr TWord where to_short_ptr e = "(int16_t*)("+-+e+-+")"
instance to_short_ptr (TPtr t) where to_short_ptr e = "(int16_t*)("+-+e+-+")" instance to_short_ptr (TPtr t) where to_short_ptr e = "(int16_t*)("+-+e+-+")"
instance to_ptr_offset TWord where to_ptr_offset w = "(int)("+-+w+-+")"
instance to_ptr_offset TPtrOffset where to_ptr_offset w = w
instance to_ptr_offset TShort where to_ptr_offset s = "(int)("+-+s+-+")"
instance + (Expr t) where + a b = "("+-+a+-+"+"+-+b+-+")" instance + (Expr t) where + a b = "("+-+a+-+"+"+-+b+-+")"
instance - (Expr t) where - a b = "("+-+a+-+"-"+-+b+-+")" instance - (Expr t) where - a b = "("+-+a+-+"-"+-+b+-+")"
instance * (Expr t) where * a b = "("+-+a+-+"*"+-+b+-+")" instance * (Expr t) where * a b = "("+-+a+-+"*"+-+b+-+")"
...@@ -222,30 +237,27 @@ instance ^ (Expr TReal) where ^ a b = "pow("+-+a+-+","+-+b+-+")" ...@@ -222,30 +237,27 @@ instance ^ (Expr TReal) where ^ a b = "pow("+-+a+-+","+-+b+-+")"
(%.) infixl 6 :: !(Expr TInt) !(Expr TInt) -> Expr TInt (%.) infixl 6 :: !(Expr TInt) !(Expr TInt) -> Expr TInt
(%.) a b = "("+-+a+-+"%"+-+b+-+")" (%.) a b = "("+-+a+-+"%"+-+b+-+")"
(==.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (==.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(==.) a b = "("+-+a+-+"=="+-+b+-+")" (==.) a b = "("+-+a+-+"=="+-+b+-+")"
(<>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (<>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(<>.) a b = "("+-+a+-+"!="+-+b+-+")" (<>.) a b = "("+-+a+-+"!="+-+b+-+")"
(<.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (<.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(<.) a b = "("+-+a+-+"<"+-+b+-+")" (<.) a b = "("+-+a+-+"<"+-+b+-+")"
(>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (>.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(>.) a b = "("+-+a+-+">"+-+b+-+")" (>.) a b = "("+-+a+-+">"+-+b+-+")"
(<=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (<=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(<=.) a b = "("+-+a+-+"<="+-+b+-+")" (<=.) a b = "("+-+a+-+"<="+-+b+-+")"
(>=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TWord (>=.) infix 4 :: !(Expr a) !(Expr a) -> Expr TBool
(>=.) a b = "("+-+a+-+">="+-+b+-+")" (>=.) a b = "("+-+a+-+">="+-+b+-+")"
(&&.) infixr 3 :: !(Expr TWord) !(Expr TWord) -> Expr TWord (&&.) infixr 3 :: !(Expr TBool) !(Expr TBool) -> Expr TBool
(&&.) a b = "("+-+a+-+"&&"+-+b+-+")" (&&.) a b = "("+-+a+-+"&&"+-+b+-+")"
notB :: !(Expr TWord) -> Expr TWord
notB a = "!("+-+a+-+")"
(&.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord (&.) infixl 6 :: !(Expr TWord) !(Expr TWord) -> Expr TWord
(&.) a b = "("+-+a+-+"&"+-+b+-+")" (&.) a b = "("+-+a+-+"&"+-+b+-+")"
...@@ -315,7 +327,7 @@ if_i64_or_i32 i64 i32 t = append "#endif" (i32 (append "#else" (i64 (append "#if ...@@ -315,7 +327,7 @@ if_i64_or_i32 i64 i32 t = append "#endif" (i32 (append "#else" (i64 (append "#if
if_i64_or_i32_expr :: !(Expr t) !(Expr t) -> Expr t if_i64_or_i32_expr :: !(Expr t) !(Expr t) -> Expr t
if_i64_or_i32_expr a b = "IF_INT_64_OR_32("+-+a+-+","+-+b+-+")" if_i64_or_i32_expr a b = "IF_INT_64_OR_32("+-+a+-+","+-+b+-+")"
if_expr :: !(Expr TWord) !(Expr t) !(Expr t) -> Expr t if_expr :: !(Expr TBool) !(Expr t) !(Expr t) -> Expr t
if_expr c t e = "("+-+c+-+" ? "+-+t+-+" : "+-+e+-+")" if_expr c t e = "("+-+c+-+" ? "+-+t+-+" : "+-+e+-+")"
begin_instruction :: !String !Target -> Target begin_instruction :: !String !Target -> Target
...@@ -334,6 +346,7 @@ nop t = t ...@@ -334,6 +346,7 @@ nop t = t
(:.) first then t = then (first t) (:.) first then t = then (first t)
instance typename TWord where typename _ = "BC_WORD" instance typename TWord where typename _ = "BC_WORD"
instance typename TPtrOffset where typename _ = "int"
instance typename TChar where typename _ = "char" instance typename TChar where typename _ = "char"
instance typename TShort where typename _ = "int16_t" instance typename TShort where typename _ = "int16_t"
instance typename TInt where typename _ = "BC_WORD_S" instance typename TInt where typename _ = "BC_WORD_S"
...@@ -348,13 +361,16 @@ where ...@@ -348,13 +361,16 @@ where
set :: !(Expr v) !(Expr e) !Target -> Target set :: !(Expr v) !(Expr e) !Target -> Target
set v e t = append ("\t"+-+v+-+"="+-+e+-+";") t set v e t = append ("\t"+-+v+-+"="+-+e+-+";") t
instance .= TWord TWord where .= v e t = set v e t instance .= TWord TWord where .= v e t = set v e t
instance .= TWord TChar where .= v e t = set v e t instance .= TWord TPtrOffset where .= v e t = set v e t
instance .= TWord TInt where .= v e t = set v e t instance .= TWord TBool where .= v e t = set v e t
instance .= TWord TShort where .= v e t = set v e t instance .= TWord TChar where .= v e t = set v e t
instance .= TChar TChar where .= v e t = set v e t instance .= TWord TInt where .= v e t = set v e t
instance .= TInt TInt where .= v e t = set v e t instance .= TWord TShort where .= v e t = set v e t
instance .= TInt TWord where .= v e t = set v e t instance .= TPtrOffset TPtrOffset 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 instance .= (TPtr t) (TPtr u) where .= v e t = set v e t
add_local :: !(Expr v) !(Expr e) !Target -> Target add_local :: !(Expr v) !(Expr e) !Target -> Target
...@@ -363,7 +379,8 @@ add_local v e t = case e of ...@@ -363,7 +379,8 @@ add_local v e t = case e of
"1" -> append ("\t"+-+v+-+"++;") t "1" -> append ("\t"+-+v+-+"++;") t
e -> append ("\t"+-+v+-+"+="+-+e+-+";") 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 += TPtrOffset TPtrOffset where += v e t = add_local v e t
sub_local :: !(Expr v) !(Expr e) !Target -> Target sub_local :: !(Expr v) !(Expr e) !Target -> Target
sub_local v e t = case e of sub_local v e t = case e of
...@@ -372,8 +389,8 @@ sub_local v e t = case e of ...@@ -372,8 +389,8 @@ sub_local v e t = case e of
e -> append ("\t"+-+v+-+"-="+-+e+-+";") t e -> append ("\t"+-+v+-+"-="+-+e+-+";") t
instance -= TWord TWord where -= v e t = sub_local v e t instance -= TWord TWord where -= v e t = sub_local v e t
instance -= TPtrOffset TPtrOffset where -= v e t = sub_local v e t
instance -= TShort TShort 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 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 instance advance_ptr (Expr w) where advance_ptr v e t = add_local v e t
...@@ -399,15 +416,15 @@ begin_block t = append "\tdo {" t ...@@ -399,15 +416,15 @@ begin_block t = append "\tdo {" t
end_block :: !Target -> Target end_block :: !Target -> Target
end_block t = append "\t} while (0);" t end_block t = append "\t} while (0);" t
while_do :: !(Expr TWord) !(Target -> Target) !Target -> Target while_do :: !(Expr TBool) !(Target -> Target) !Target -> Target
while_do c f t = append "\t}" (f (append ("\twhile ("+-+c+-+") {") t)) while_do c f t = append "\t}" (f (append ("\twhile ("+-+c+-+") {") t))
break :: !Target -> Target break :: !Target -> Target
break t = append "\tbreak;" t break t = append "\tbreak;" t
if_then_else :: if_then_else ::
!(Expr TWord) !(Target -> Target) !(Expr TBool) !(Target -> Target)
![(Expr TWord, Target -> Target)] ![(Expr TBool, Target -> Target)]
!(Maybe (Target -> Target)) !(Maybe (Target -> Target))
!Target -> Target !Target -> Target
if_then_else c then elifs else t if_then_else c then elifs else t
...@@ -418,10 +435,10 @@ if_then_else c then elifs else t ...@@ -418,10 +435,10 @@ if_then_else c then elifs else t
-> append "\t}" (e (append "\t} else {" (drop_last_line t))) -> append "\t}" (e (append "\t} else {" (drop_last_line t)))
-> t -> t
if_break_else :: !(Expr TWord) !(Target -> Target) !Target -> Target 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))) 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 instance ensure_hp Int where ensure_hp i t = append ("\tNEED_HEAP("+-+toString i+-+");") t
A :: Expr (TPtr TWord) A :: Expr (TPtr TWord)
...@@ -454,7 +471,7 @@ ARRAY__ptr = "(BC_WORD)&__ARRAY__" ...@@ -454,7 +471,7 @@ ARRAY__ptr = "(BC_WORD)&__ARRAY__"
STRING__ptr :: Expr TWord STRING__ptr :: Expr TWord
STRING__ptr = "(BC_WORD)&__STRING__" STRING__ptr = "(BC_WORD)&__STRING__"
jmp_ap_ptr :: !Int -> Expr TWord jmp_ap_ptr :: !Int -> Expr (TPtr TWord)
jmp_ap_ptr i = "(BC_WORD)&Fjmp_ap["+-+toString i+-+"]" jmp_ap_ptr i = "(BC_WORD)&Fjmp_ap["+-+toString i+-+"]"
cycle_ptr :: Expr TWord cycle_ptr :: Expr TWord
...@@ -470,24 +487,24 @@ small_integer :: !(Expr TInt) -> Expr TWord ...@@ -470,24 +487,24 @@ small_integer :: !(Expr TInt) -> Expr TWord
small_integer i = "(BC_WORD)&small_integers[("+-+i+-+")<<1]" small_integer i = "(BC_WORD)&small_integers[("+-+i+-+")<<1]"
static_character :: !(Expr TChar) -> Expr TWord static_character :: !(Expr TChar) -> Expr TWord
static_character c = "(BC_WORD)&static_characters[("+-+c+-+")<<1]" static_character c = "(BC_WORD)&static_characters[(unsigned char)("+-+c+-+")<<1]"
static_boolean :: !(Expr TWord) -> Expr TWord static_boolean :: !(Expr TWord) -> Expr TWord
static_boolean b = "(BC_WORD)&static_booleans[("+-+b+-+") ? 2 : 0]" static_boolean b = "(BC_WORD)&static_booleans[("+-+b+-+") ? 2 : 0]"
caf_list :: Expr (TPtr (TPtr TWord)) caf_list :: Expr (TPtr TWord)
caf_list = "caf_list" caf_list = "(BC_WORD*)caf_list"
push_c :: !(Expr TWord) !Target -> Target push_c :: !(Expr (TPtr TWord)) !Target -> Target
push_c v t = append ("\t*++csp="+-+v+-+";") t push_c v t = append ("\t*++csp=(BC_WORD)"+-+v+-+";") t
pop_pc_from_c :: !Target -> Target pop_pc_from_c :: !Target -> Target
pop_pc_from_c t = append "\tpc=(BC_WORD*)*csp--;" t pop_pc_from_c t = append "\tpc=(BC_WORD*)*csp--;" t
memcpy :: !(Expr (TPtr a)) !(Expr (TPtr b)) !(Expr TWord) !Target -> Target