Commit 05a6350b authored by Camil Staps's avatar Camil Staps 🚀

Merge branch 'unrelocated-serialization' into 'master'

Add deserialization support for the WebAssembly interpreter

See merge request !103
parents 404cc93b c0f4ecb2
Pipeline #20593 passed with stages
in 17 minutes and 51 seconds
......@@ -63,6 +63,17 @@ defaultDeserializationSettings :: DeserializationSettings
*/
serialize :: a !String !*World -> *(!Maybe SerializedGraph, !*World)
/**
* Serialize an expression for unrelocated interpretation. This is a mode of
* interpretation where the code and data addresses are fixed. It is useful for
* the WebAssembly interpreter where memory always starts at index 0.
*
* @param The value to serialize.
* @param The path to the executable's bytecode (set by the `ByteCode` option in the project file).
* @result The result may be `Nothing` if the bytecode could not be parsed.
*/
serialize_for_unrelocated_interpretation :: a !String !String !*World -> *(!Maybe String, !*World)
/**
* Deserialize an expression using the ABC interpreter.
* This version copies nodes as soon as they are in head normal form.
......
implementation module ABC.Interpreter
import StdArray
import StdBool
import StdClass
import StdFile
import StdInt
......@@ -42,20 +43,20 @@ defaultDeserializationSettings =
serialize :: a !String !*World -> *(!Maybe SerializedGraph, !*World)
serialize graph bcfile w
# (graph,descs,mods) = copy_to_string_with_names graph
# (graph,descinfo,modules) = copy_to_string_with_names graph
# (bytecode,w) = readFile bcfile w
| isNothing bytecode = (Nothing, w)
# bytecode = fromJust bytecode
#! (len,bytecodep) = strip_bytecode bytecode {#symbol_name di mods \\ di <-: descs}
#! (len,bytecodep) = strip_bytecode bytecode {#symbol_name di modules \\ di <-: descinfo}
#! bytecode = derefCharArray bytecodep len
| free_to_false bytecodep = (Nothing, w)
# rec =
{ graph = graph
, descinfo = descs
, modules = mods
, descinfo = descinfo
, modules = modules
, bytecode = bytecode
}
= (Just rec, w)
......@@ -74,6 +75,144 @@ where
ccall strip_bytecode "sA:VIp"
}
serialize_for_unrelocated_interpretation :: a !String !String !*World -> *(!Maybe String, !*World)
serialize_for_unrelocated_interpretation graph bcfile thisexe w
# (host_syms,w) = accFiles (read_symbols thisexe) w
# (graph,descinfo,modules) = copy_to_string_with_names graph
# (bytecode,w) = readFile bcfile w
| isNothing bytecode = (Nothing, w)
# bytecode = fromJust bytecode
# pgm = parse host_syms bytecode
| isNothing pgm = (Nothing, w)
# pgm = fromJust pgm
# code_start = get_code pgm
# int_syms = {#s \\ s <- getInterpreterSymbols pgm}
# int_syms = {#predef_or_lookup_symbol code_start d modules int_syms \\ d <-: descinfo}
# graph = replace_desc_numbers_by_descs 0 graph int_syms 0 code_start // relocate relative to beginning of code segment
= (Just graph, w)
where
get_code :: !Pointer -> Pointer
get_code pgm = code {
ccall get_code "p:p"
}
predef_or_lookup_symbol :: !Int !DescInfo !{#String} !{#Symbol} -> Int
predef_or_lookup_symbol code_start di mods syms = case di.di_name of
"_ARRAY_" -> code_start-1*8+2
"_STRING_" -> code_start-2*8+2
"BOOL" -> code_start-3*8+2
"CHAR" -> code_start-4*8+2
"REAL" -> code_start-5*8+2
"INT" -> code_start-6*8+2
"dINT" -> code_start-6*8+2
_ -> lookup_symbol_value di mods syms
// This is like the function with the same name in GraphCopy's
// graph_copy_with_names, but it assigns even negative descriptor numbers
// to predefined symbols so that it matches predef_or_lookup_symbol above.
replace_desc_numbers_by_descs :: !Int !*{#Char} !{#Int} !Int !Int -> *{#Char}
replace_desc_numbers_by_descs i s symbol_a symbol_offset array_desc
| i>=size s
| i==size s = s
| otherwise = abort "error in replace_desc_numbers_by_descs\n"
#! desc=get_word_from_string s i
| desc<0
= replace_desc_numbers_by_descs (i+IF_INT_64_OR_32 8 4) s symbol_a symbol_offset array_desc
# desc = symbol_a.[desc-1]
# desc=desc+symbol_offset
# s=store_int_in_string s i (desc-array_desc)
| desc bitand 2==0
# d = get_thunk_n_non_pointers desc
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 8 4)+(d<<(IF_INT_64_OR_32 3 2))) s symbol_a symbol_offset array_desc
# (d,not_array) = get_descriptor_n_non_pointers_and_not_array desc
| not_array
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 8 4)+(d<<(IF_INT_64_OR_32 3 2))) s symbol_a symbol_offset array_desc
| d==0 // _STRING_
#! l = get_word_from_string s (i+IF_INT_64_OR_32 8 4)
# l = IF_INT_64_OR_32 ((l+7) bitand -8) ((l+3) bitand -4)
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 16 8)+l) s symbol_a symbol_offset array_desc
| d==1 // _ARRAY_
#! d = get_word_from_string s (i+IF_INT_64_OR_32 16 8)
| d==0
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 24 12)) s symbol_a symbol_offset array_desc
# d = symbol_a.[d-1]
# d = d+symbol_offset
# s=store_int_in_string s (i+IF_INT_64_OR_32 16 8) (d-array_desc)
#! l = get_word_from_string s (i+IF_INT_64_OR_32 8 4)
| d==array_desc-5*8+2 // REAL
# l = l << IF_INT_64_OR_32 3 2
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 24 12)+l) s symbol_a symbol_offset array_desc
| d==array_desc-6*8+2 // INT
# l = l << 3
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 24 12)+l) s symbol_a symbol_offset array_desc
| d==array_desc-3*8+2 // BOOL
# l = IF_INT_64_OR_32 ((l+7) bitand -8) ((l+3) bitand -4)
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 24 12)+l) s symbol_a symbol_offset array_desc
# arity = get_D_node_arity d
| arity>=256
# record_a_arity = get_D_record_a_arity d
# record_b_arity = arity-256-record_a_arity
# l = (l * record_b_arity) << IF_INT_64_OR_32 3 2
= replace_desc_numbers_by_descs (i+(IF_INT_64_OR_32 24 12)+l) s symbol_a symbol_offset array_desc
= abort (toString l+++" "+++toString d)
where
get_word_from_string :: !{#Char} !Int -> Int // get_D_from_string_64
get_word_from_string s i = code inline {
push_a_b 0
pop_a 1
addI
load_i 16
}
store_int_in_string :: !*{#Char} !Int !Int -> *{#Char} // 64-bit variant
store_int_in_string s i n =
{s & [i]=toChar n,[i+1]=toChar (n>>8),[i+2]=toChar (n>>16),[i+3]=toChar (n>>24),
[i+4]=toChar (n >> 32),[i+5]=toChar (n>>40),[i+6]=toChar (n>>48),[i+7]=toChar (n>>56)}
get_thunk_n_non_pointers:: !Int -> Int
get_thunk_n_non_pointers d
# arity = get_thunk_arity d
| arity<256
= 0
# b_size = arity>>8
= b_size
where
get_thunk_arity :: !Int -> Int // 64-bit version
get_thunk_arity a = code {
load_si32 -4
}
get_descriptor_n_non_pointers_and_not_array :: !Int -> (!Int,!Bool)
get_descriptor_n_non_pointers_and_not_array d
| d<array_desc
| d==array_desc-1*8+2 = (1,False) // _ARRAY_
| d==array_desc-2*8+2 = (0,False) // _STRING_
| d==array_desc-3*8+2 = (1,True) // BOOL
| d==array_desc-4*8+2 = (1,True) // CHAR
| d==array_desc-5*8+2 = (IF_INT_64_OR_32 1 2,True) // REAL
| d==array_desc-6*8+2 = (1,True) // INT/dINT
| otherwise = abort "internal error in serialize_for_unrelocated_interpretation\n"
# arity = get_D_node_arity d
| arity<256 = (0,True)
# record_a_arity = get_D_record_a_arity d
# record_b_arity = arity-256-record_a_arity
= (record_b_arity,True)
get_D_node_arity :: !Int -> Int
get_D_node_arity d = code inline {
load_si16 -2
}
get_D_record_a_arity :: !Int -> Int
get_D_record_a_arity d = code inline {
load_si16 0
}
deserialize :: !DeserializationSettings !SerializedGraph !String !*World -> *(!Maybe a, !*World)
deserialize dsets graph thisexe w = deserialize` False dsets graph thisexe w
......
......@@ -95,6 +95,29 @@ intp = new Uint8Array(intp);
{
clean: {
memory: memory,
debug: function(what,a,b,c) {
switch (what) {
case 0:
console.log('loop',a,'/',b,'; hp at',c);
break;
case 1:
console.log('desc',a);
break;
case 2:
console.log('arity',a);
break;
case 3:
console.log('unimplemented:',['large hnf','thunk'][a]);
break;
case 4:
console.log('redirect',a,c,'(from',b,')');
break;
case 5:
console.log('a arity',a);
break;
}
}
}
}
);
......@@ -192,6 +215,20 @@ intp = new Uint8Array(intp);
});
}
var i=scriptArgs.indexOf('--graph');
if (i >= 0) {
var graph = os.file.readFile(scriptArgs[i+1], 'binary');
graph = new Uint32Array(graph.buffer);
var unused_semispace = util.instance.exports.get_unused_semispace();
for (var i=0; i<graph.length; i++)
membuffer[unused_semispace/4+i] = graph[i];
var node = hp;
hp = util.instance.exports.copy_from_string(unused_semispace,graph.length/2,asp,bsp,hp,code_offset*8);
asp+=8;
membuffer[asp/4] = node;
start+=32; /* skip bootstrap to build start node; jump to _print_graph */
}
var time_start=new Date().getTime();
var r=intp.instance.exports.interpret(start, asp, bsp, csp, hp, heap_size/8);
......
(module
(import "clean" "memory" (memory 1))
;;(func $debug (import "clean" "debug") (param i32 i32 i32 i32))
(global $start-heap (mut i32) (i32.const 0))
(global $half-heap (mut i32) (i32.const 0))
......@@ -87,6 +88,14 @@
(global.set $caf-list (local.get 3))
)
(func (export "get_unused_semispace") (result i32)
(select
(global.get $half-heap)
(global.get $start-heap)
(global.get $in-first-semispace)
)
)
;; upper half of result is new hp pointer;
;; lower half is hp-free
(func (export "gc") (param $asp i32) (result i64)
......@@ -545,4 +554,476 @@
(i32.lt_s (local.get $arity) (i32.const 2))
)
)
(func $copy (param $to i32) (param $from i32) (param $n-words i32)
(block $end
(loop $loop
(local.set $n-words (i32.sub (local.get $n-words) (i32.const 1)))
(br_if $end (i32.lt_s (local.get $n-words) (i32.const 0)))
(i64.store
(i32.add (local.get $to) (i32.shl (local.get $n-words) (i32.const 3)))
(i64.load (i32.add (local.get $from) (i32.shl (local.get $n-words) (i32.const 3)))))
(br $loop)
)
)
)
(func (export "copy_from_string")
(param $s i32) (param $len i32)
(param $asp i32) (param $bsp i32) (param $hp i32)
(param $code-offset i32)
(result i32)
(local $ptr-stack i32)
(local $a-size-stack i32)
(local $i i32)
(local $desc i32)
(local $a-arity i32)
(local $b-arity i32)
(local $arity i32)
(local $a i32)
(local $j i32)
(local $k i32)
(local.set $ptr-stack (local.get $asp))
(local.set $a-size-stack (local.get $bsp))
(i32.store (local.tee $ptr-stack (i32.add (local.get $ptr-stack) (i32.const 4))) (local.get $s)) ;; dummy
(i32.store (local.tee $a-size-stack (i32.sub (local.get $a-size-stack) (i32.const 2))) (i32.const 1))
(local.set $i (i32.const -8))
(local.set $len (i32.shl (local.get $len) (i32.const 3)))
(block $end
(loop $loop
(local.set $i (i32.add (local.get $i) (i32.const 8)))
(br_if $end (i32.ge_u (local.get $i) (local.get $len)))
(if
(i32.eqz (i32.load16_s (local.get $a-size-stack)))
(then
(local.set $i (i32.sub (local.get $i) (i32.const 8)))
(local.set $a-size-stack (i32.add (local.get $a-size-stack) (i32.const 2)))
(br $loop)
)
)
;; "loop"
;;(call $debug (i32.const 0) (local.get $i) (local.get $len) (local.get $hp))
(i32.store16 (local.get $a-size-stack) (i32.sub (i32.load16_s (local.get $a-size-stack)) (i32.const 1)))
(local.set $desc (i32.load (i32.add (local.get $s) (local.get $i))))
(i64.store (i32.add (local.get $s) (local.get $i)) (i64.extend_i32_u (local.get $hp)))
(if ;; redirection or predefined constructor
(i32.lt_s (local.get $desc) (i32.const 0))
(then
(block $no-predefined-constructor
(block $predefined-constructor
;; predefined constructors: see ABC.Interpreter for the $desc values;
;; the constructors written to the heap are from the interpreter generator.
(if ;; BOOL
(i32.eq (local.get $desc) (i32.const -22))
(then
(i64.store (local.get $hp) (i64.const 90))
(i64.store offset=8 (local.get $hp) (i64.load offset=8 (i32.add (local.get $s) (local.get $i))))
(br $predefined-constructor)
)
)
(if ;; CHAR
(i32.eq (local.get $desc) (i32.const -30))
(then
(i64.store (local.get $hp) (i64.const 130))
(i64.store offset=8 (local.get $hp) (i64.load offset=8 (i32.add (local.get $s) (local.get $i))))
(br $predefined-constructor)
)
)
(if ;; REAL
(i32.eq (local.get $desc) (i32.const -38))
(then
(i64.store (local.get $hp) (i64.const 170))
(i64.store offset=8 (local.get $hp) (i64.load offset=8 (i32.add (local.get $s) (local.get $i))))
(br $predefined-constructor)
)
)
(if ;; INT
(i32.eq (local.get $desc) (i32.const -46))
(then
(i64.store (local.get $hp) (i64.const 210))
(i64.store offset=8 (local.get $hp) (i64.load offset=8 (i32.add (local.get $s) (local.get $i))))
(br $predefined-constructor)
)
)
(br $no-predefined-constructor)
)
(i64.store (i32.load (local.get $ptr-stack)) (i64.extend_i32_u (local.get $hp)))
(local.set $ptr-stack (i32.sub (local.get $ptr-stack) (i32.const 4)))
(local.set $hp (i32.add (local.get $hp) (i32.const 16)))
(local.set $i (i32.add (local.get $i) (i32.const 8)))
(br $loop)
)
(if ;; _STRING_
(i32.eq (local.get $desc) (i32.const -14))
(then
(i64.store (i32.load (local.get $ptr-stack)) (i64.extend_i32_u (local.get $hp)))
(local.set $ptr-stack (i32.sub (local.get $ptr-stack) (i32.const 4)))
(i64.store (local.get $hp) (i64.const 50))
(local.set $a (i32.load offset=8 (i32.add (local.get $s) (local.get $i))))
(i64.store offset=8 (local.get $hp) (i64.extend_i32_u (local.get $a)))
(local.set $a (i32.shr_u (i32.add (local.get $a) (i32.const 7)) (i32.const 3)))
(call $copy
(i32.add (local.get $hp) (i32.const 16))
(i32.add (local.get $s) (i32.add (local.get $i) (i32.const 16)))
(local.get $a))
(local.set $hp (i32.add (local.get $hp) (i32.add (i32.const 8) (i32.shl (local.get $a) (i32.const 3)))))
(local.set $i (i32.add (local.get $i) (i32.add (i32.const 16) (i32.shl (local.get $a) (i32.const 3)))))
(br $loop)
)
)
(if ;; _ARRAY_
(i32.eq (local.get $desc) (i32.const -6))
(then
(i64.store (i32.load (local.get $ptr-stack)) (i64.extend_i32_u (local.get $hp)))
(local.set $ptr-stack (i32.sub (local.get $ptr-stack) (i32.const 4)))
(local.set $a (i32.load offset=8 (i32.add (local.get $s) (local.get $i))))
(local.set $desc (i32.load offset=16 (i32.add (local.get $s) (local.get $i))))
(i64.store (local.get $hp) (i64.const 10))
(i64.store offset=8 (local.get $hp) (i64.extend_i32_u (local.get $a)))
(if ;; INT elements
(i32.eq (local.get $desc) (i32.const -46))
(then
(i64.store offset=16 (local.get $hp) (i64.const 210))
(call $copy
(i32.add (local.get $hp) (i32.const 24))
(i32.add (local.get $s) (i32.add (local.get $i) (i32.const 24)))
(local.get $a))
(local.set $a (i32.shl (local.get $a) (i32.const 3)))
(local.set $hp (i32.add (local.get $hp) (i32.add (i32.const 24) (local.get $a))))
(local.set $i (i32.add (local.get $i) (i32.add (i32.const 16) (local.get $a))))
(br $loop)
)
)
(if ;; REAL elements
(i32.eq (local.get $desc) (i32.const -38))
(then
(i64.store offset=16 (local.get $hp) (i64.const 170))
(call $copy
(i32.add (local.get $hp) (i32.const 24))
(i32.add (local.get $s) (i32.add (local.get $i) (i32.const 24)))
(local.get $a))
(local.set $a (i32.shl (local.get $a) (i32.const 3)))
(local.set $hp (i32.add (local.get $hp) (i32.add (i32.const 24) (local.get $a))))
(local.set $i (i32.add (local.get $i) (i32.add (i32.const 16) (local.get $a))))
(br $loop)
)
)
(if ;; BOOL elements
(i32.eq (local.get $desc) (i32.const -22))
(then
(i64.store offset=16 (local.get $hp) (i64.const 90))
(local.set $a (i32.shr_u (i32.add (local.get $a) (i32.const 7)) (i32.const 3)))
(call $copy
(i32.add (local.get $hp) (i32.const 24))
(i32.add (local.get $s) (i32.add (local.get $i) (i32.const 24)))
(local.get $a))
(local.set $a (i32.shl (local.get $a) (i32.const 3)))
(local.set $hp (i32.add (local.get $hp) (i32.add (i32.const 24) (local.get $a))))
(local.set $i (i32.add (local.get $i) (i32.add (i32.const 16) (local.get $a))))
(br $loop)
)
)
(if
(i32.eqz (local.get $desc))
(then
(local.set $arity (i32.const 1))
(local.set $a-arity (i32.const 1))
)
(else
(local.set $desc (i32.add (local.get $desc) (local.get $code-offset)))
(local.set $arity (i32.sub (i32.load16_u (i32.sub (local.get $desc) (i32.const 2))) (i32.const 256)))
(local.set $a-arity (i32.load16_u (local.get $desc)))
)
)
(local.set $b-arity (i32.sub (local.get $arity) (local.get $a-arity)))
(i64.store offset=16 (local.get $hp) (i64.extend_i32_u (local.get $desc)))
(local.set $hp (i32.add (local.get $hp) (i32.const 24)))
(local.set $i (i32.add (local.get $i) (i32.const 16)))
(local.set $ptr-stack (i32.add (local.get $ptr-stack)
(i32.shl (i32.mul (local.get $a) (local.get $a-arity)) (i32.const 2))))
(i32.store16 (local.tee $a-size-stack (i32.sub (local.get $a-size-stack) (i32.const 2)))
(i32.mul (local.get $a) (local.get $a-arity)))
(local.set $arity (i32.shl (local.get $arity) (i32.const 3)))
(local.set $j (i32.const 0))
(block $end-copy-array-elements
(loop $copy-array-elements
(br_if $end-copy-array-elements (i32.eq (local.get $j) (local.get $a)))
(local.set $k (i32.const 0))
(block $end-push-pointers
(loop $push-pointers
(br_if $end-push-pointers (i32.eq (local.get $k) (local.get $a-arity)))
(i32.store
(i32.sub (local.get $ptr-stack)
(i32.shl (i32.add (i32.mul (local.get $j) (local.get $a-arity)) (local.get $k)) (i32.const 2)))
(i32.add (local.get $hp) (i32.shl (local.get $k) (i32.const 3))))
(local.set $k (i32.add (local.get $k) (i32.const 1)))
(br $push-pointers)
)
)
(call $copy
(i32.add (local.get $hp) (i32.shl (local.get $a-arity) (i32.const 3)))
(i32.add (local.get $s) (i32.add (local.get $i) (i32.const 8)))
(local.get $b-arity))
(local.set $i (i32.add (local.get $i) (i32.shl (local.get $b-arity) (i32.const 3))))
(local.set $hp (i32.add (local.get $hp) (local.get $arity)))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $copy-array-elements)
)
)
(br $loop)
)
)
;; not a predefined constructor; redirection
(i64.store
(i32.load (local.get $ptr-stack))
(i64.load (i32.add (local.get $s) (i32.add (local.get $i) (i32.sub (local.get $desc) (i32.const 1))))))
(local.set $ptr-stack (i32.sub (local.get $ptr-stack) (i32.const 4)))
(br $loop)
)
)
(local.set $desc (i32.add (local.get $desc) (local.get $code-offset)))
;; "desc"
;;(call $debug (i32.const 1) (local.get $desc) (i32.const 0) (i32.const 0))
(if
(i32.and (local.get $desc) (i32.const 2))
(then
;; hnf
(local.set $arity (i32.load16_s (i32.sub (local.get $desc) (i32.const 2))))
(local.set $a-arity (local.get $arity))
;; "arity"
;;(call $debug (i32.const 2) (local.get $arity) (i32.const 0) (i32.const 0))
(if
(i32.gt_u (local.get $arity) (i32.const 256))
(then
(local.set $a-arity (i32.load16_s (local.get $desc)))
(local.set $arity (i32.sub (local.get $arity) (i32.const 256)))
)
)
(if
(i32.eq (local.get $arity) (i32.const 0))
(then
(local.set $desc (i32.sub (local.get $desc) (i32.const 10)))
(i64.store (i32.load (local.get $ptr-stack)) (i64.extend_i32_u (local.get $desc)))
(local.set $ptr-stack (i32.sub (local.get $ptr-stack) (i32.const 4)))
(i64.store (i32.add (local.get $s) (local.get $i)) (i64.extend_i32_u (local.get $desc)))
(i32.store16 (local.tee $a-size-stack (i32.sub (local.get $a-size-stack) (i32.const 2))) (i32.const 0))
(br $loop)
)
)
(i64.store (i32.load (local.get $ptr-stack)) (i64.extend_i32_u (local.get $hp)))
(local.set $ptr-stack (i32.sub (local.get $ptr-stack) (i32.const 4)))
(i64.store (local.get $hp) (i64.extend_i32_u (local.get $desc)))
(if
(i32.eq (local.get $arity) (i32.const 1))
(then
(if
(i32.eq (local.get $a-arity) (i32.const 1))
(then
(i32.store
(local.tee $ptr-stack (i32.add (local.get $ptr-stack) (i32.const 4)))
(i32.add (local.get $hp) (i32.const 8)))
)
(else
(i64.store offset=8 (local.get $hp)
(i64.load (i32.add (local.get $s)
(local.tee $i (i32.add (local.get $i) (i32.const 8))))))
)
)
(local.set $hp (i32.add (local.get $hp) (i32.const 16)))
(i32.store16 (local.tee $a-size-stack (i32.sub (local.get $a-size-stack) (i32.const 2))) (i32.const 1))
(br $loop)
)
)
(if
(i32.eq (local.get $arity) (i32.const 2))
(then
;;(call $debug (i32.const 5) (local.get $a-arity) (i32.const 0) (i32.const 0))
(if
(i32.eq (local.get $a-arity) (i32.const 2))
(then
(i32.store offset=8 (local.get $ptr-stack) (i32.add (local.get $hp) (i32.const 8)))
(i32.store offset=4 (local.get $ptr-stack) (i32.add (local.get $hp) (i32.const 16)))
(local.set $ptr-stack (i32.add (local.get $ptr-stack) (i32.const 8)))
)
(else
(if
(i32.eq (local.get $a-arity) (i32.const 1))
(then
(i32.store offset=4 (local.get $ptr-stack) (i32.add (local.get $hp) (i32.const 8)))
(local.set $ptr-stack (i32.add (local.get $ptr-stack) (i32.const 4)))
(i64.store offset=16 (local.get $hp)
(i64.load (i32.add (local.get $s)
(local.tee $i (i32.add (local.get $i) (i32.const 8))))))
)
(else ;; b-arity=2
(i64.store offset=8 (local.get $hp)
(i64.load (i32.add (local.get $s) (i32.add (local.get $i) (i32.const 8)))))
(i64.store offset=16 (local.get $hp)
(i64.load (i32.add (local.get $s) (i32.add (local.get $i) (i32.const 16)))))
(local.set $i (i32.add (local.get $i) (i32.const 16)))
)
)
)
)
(local.set $hp (i32.add (local.get $hp) (i32.const 24)))
(i32.store16 (local.tee $a-size-stack (i32.sub (local.get $a-size-stack) (i32.const 2))) (i32.const 2))
(br $loop)
)
)
;; large hnf
;;(call $debug (i32.const 3) (i32.const 0) (i32.const 0) (i32.const 0))
(i64.store offset=16 (local.get $hp) (i64.extend_i32_u (i32.add (local.get $hp) (i32.const 24))))
(if
(i32.eq (local.get $a-arity) (i32.const 0))
(then
(i64.store offset=8 (local.get $hp)
(i64.load (i32.add (local.get $s)
(local.tee $i (i32.add (local.get $i) (i32.const 8))))))
(local.set $arity (i32.sub (local.get $arity) (i32.const 1)))
(call $copy
(i32.add (local.get $hp) (i32.const 24))
(i32.add (local.get $s) (local.get $i))
(local.get $arity))
(local.set $i (i32.add (local.get $i) (i32.shl (local.get $arity) (i32.const 3))))
)