From 28d6e93ce960138e6de9521f38a4c3fa87fcef21 Mon Sep 17 00:00:00 2001 From: Oscar Spencer Date: Sun, 7 Feb 2021 12:26:11 -0500 Subject: [PATCH] chore!: Grain implementation of memory allocator --- compiler/src/codegen/compcore.re | 239 ++++++++++++--- compiler/src/codegen/mashtree.re | 2 +- compiler/src/codegen/transl_anf.re | 49 +++- .../src/middle_end/analyze_inline_wasm.re | 11 +- compiler/src/middle_end/anf_helper.re | 2 + compiler/src/middle_end/anf_helper.rei | 3 + compiler/src/middle_end/anftree.re | 1 + compiler/src/middle_end/anftree.rei | 1 + compiler/src/middle_end/linearize.re | 45 ++- compiler/src/parsing/lexer.mll | 2 +- compiler/src/typed/env.re | 37 ++- compiler/src/typed/env.rei | 13 +- compiler/src/typed/typemod.re | 66 +++-- compiler/test/input/letMutForLoop.gr | 5 +- compiler/test/input/unsafeWasmGlobals.gr | 13 +- compiler/test/stdlib/wasmf32.test.gr | 7 +- compiler/test/stdlib/wasmf64.test.gr | 7 +- compiler/test/stdlib/wasmi32.test.gr | 7 +- compiler/test/stdlib/wasmi64.test.gr | 7 +- runtime/src/core/memory.js | 13 +- runtime/src/core/runner.js | 29 +- runtime/src/runtime.js | 8 +- stdlib/runtime/debug.gr | 3 + stdlib/runtime/malloc.gr | 275 ++++++++++++++++++ stdlib/runtime/unsafe/conv.gr | 70 +++++ stdlib/{ => runtime}/unsafe/memory.gr | 9 +- stdlib/runtime/unsafe/tags.gr | 24 ++ stdlib/runtime/unsafe/utils.gr | 21 ++ stdlib/{ => runtime}/unsafe/wasmf32.gr | 29 +- stdlib/{ => runtime}/unsafe/wasmf64.gr | 29 +- stdlib/{ => runtime}/unsafe/wasmi32.gr | 27 +- stdlib/{ => runtime}/unsafe/wasmi64.gr | 29 +- .../stdlib-external/ascutils/grainRuntime.ts | 23 +- stdlib/stdlib-external/runtime/malloc.ts | 266 ----------------- 34 files changed, 841 insertions(+), 531 deletions(-) create mode 100644 stdlib/runtime/debug.gr create mode 100644 stdlib/runtime/malloc.gr create mode 100644 stdlib/runtime/unsafe/conv.gr rename stdlib/{ => runtime}/unsafe/memory.gr (68%) create mode 100644 stdlib/runtime/unsafe/tags.gr create mode 100644 stdlib/runtime/unsafe/utils.gr rename stdlib/{ => runtime}/unsafe/wasmf32.gr (78%) rename stdlib/{ => runtime}/unsafe/wasmf64.gr (78%) rename stdlib/{ => runtime}/unsafe/wasmi32.gr (87%) rename stdlib/{ => runtime}/unsafe/wasmi64.gr (86%) delete mode 100644 stdlib/stdlib-external/runtime/malloc.ts diff --git a/compiler/src/codegen/compcore.re b/compiler/src/codegen/compcore.re index 24bfb947e9..21c4fdb601 100644 --- a/compiler/src/codegen/compcore.re +++ b/compiler/src/codegen/compcore.re @@ -44,12 +44,14 @@ let module_runtime_id = Ident.create_persistent("moduleRuntimeId"); let reloc_base = Ident.create_persistent("relocBase"); let table_size = Ident.create_persistent("GRAIN$TABLE_SIZE"); let runtime_mod = Ident.create_persistent("grainRuntime"); +let malloc_mod = Ident.create_persistent("GRAIN$MODULE$runtime/malloc"); let stdlib_external_runtime_mod = Ident.create_persistent("stdlib-external/runtime"); let console_mod = Ident.create_persistent("console"); let check_memory_ident = Ident.create_persistent("checkMemory"); let throw_error_ident = Ident.create_persistent("throwError"); let malloc_ident = Ident.create_persistent("malloc"); +let malloc_closure_ident = Ident.create_persistent("GRAIN$EXPORT$malloc"); let incref_ident = Ident.create_persistent("incRef"); let new_rational_ident = Ident.create_persistent("newRational"); let new_float32_ident = Ident.create_persistent("newFloat32"); @@ -266,23 +268,36 @@ let traced_imports = ]; }; -let runtime_global_imports = [ +let required_global_imports = [ { mimp_mod: runtime_mod, mimp_name: reloc_base, - mimp_type: MGlobalImport(I32Type), + mimp_type: MGlobalImport(I32Type, false), mimp_kind: MImportWasm, mimp_setup: MSetupNone, }, { mimp_mod: runtime_mod, mimp_name: module_runtime_id, - mimp_type: MGlobalImport(I32Type), + mimp_type: MGlobalImport(I32Type, false), mimp_kind: MImportWasm, mimp_setup: MSetupNone, }, ]; +let grain_runtime_imports = [ + { + mimp_mod: malloc_mod, + mimp_name: malloc_closure_ident, + mimp_type: MGlobalImport(I32Type, true), + mimp_kind: MImportWasm, + mimp_setup: MSetupNone, + }, +]; + +let runtime_global_imports = + List.append(required_global_imports, grain_runtime_imports); + let runtime_function_imports = List.append( [ @@ -294,9 +309,9 @@ let runtime_function_imports = mimp_setup: MSetupNone, }, { - mimp_mod: runtime_mod, + mimp_mod: malloc_mod, mimp_name: malloc_ident, - mimp_type: MFuncImport([I32Type], [I32Type]), + mimp_type: MFuncImport([I32Type, I32Type], [I32Type]), mimp_kind: MImportWasm, mimp_setup: MSetupNone, }, @@ -481,13 +496,22 @@ let call_runtime_throw_error = (wasm_mod, env, args) => Type.none, ); -let call_malloc = (wasm_mod, env, args) => +let call_malloc = (wasm_mod, env, args) => { + let args = [ + Expression.global_get( + wasm_mod, + get_imported_name(malloc_mod, malloc_closure_ident), + Type.int32, + ), + ...args, + ]; Expression.call( wasm_mod, - get_imported_name(runtime_mod, malloc_ident), + get_imported_name(malloc_mod, malloc_ident), args, Type.int32, ); +}; let call_incref = (wasm_mod, env, arg) => if (Config.no_gc^) { arg; @@ -1844,18 +1868,96 @@ let compile_record_op = (wasm_mod, env, rec_imm, op) => { /** Heap allocations. */ -let round_up = (num: int, multiple: int): int => num + num mod multiple; +// Heap pointer used by runtime before memory allocation is available +let runtime_heap_ptr_name = "_RUNTIME_HEAP_PTR"; +let runtime_heap_ptr = MGlobalBind(runtime_heap_ptr_name, I32Type, false); /** Rounds the given number of words to be aligned correctly */ +let round_to_even = num_words => + if (num_words mod 2 == 0) { + num_words; + } else { + num_words + 1; + }; -let round_allocation_size = (num_words: int): int => round_up(num_words, 4); +let heap_allocate = (wasm_mod, env, num_words: int) => + if (Env.is_runtime_mode()) { + let addition = + Expression.binary( + wasm_mod, + Op.add_int32, + compile_bind(wasm_mod, env, ~action=BindGet, runtime_heap_ptr), + Expression.const( + wasm_mod, + const_int32(round_to_even(num_words) * 4), + ), + ); + Expression.tuple_extract( + wasm_mod, + Expression.tuple_make( + wasm_mod, + [ + compile_bind(wasm_mod, env, ~action=BindGet, runtime_heap_ptr), + compile_bind( + wasm_mod, + env, + ~action=BindTee(addition), + runtime_heap_ptr, + ), + ], + ), + 0, + ); + } else { + call_malloc( + wasm_mod, + env, + [Expression.const(wasm_mod, const_int32(4 * num_words))], + ); + }; -let heap_allocate = (wasm_mod, env, num_words: int) => { - let words_to_allocate = round_allocation_size(num_words); - call_malloc( +let heap_runtime_allocate_imm = + (~additional_words=0, wasm_mod, env, num_words: immediate) => { + let num_words = () => + untag_number(wasm_mod, compile_imm(wasm_mod, env, num_words)); + let addition = + Expression.binary( + wasm_mod, + Op.add_int32, + compile_bind(wasm_mod, env, ~action=BindGet, runtime_heap_ptr), + Expression.binary( + wasm_mod, + Op.mul_int32, + Expression.binary( + wasm_mod, + Op.and_int32, + Expression.binary( + wasm_mod, + Op.add_int32, + num_words(), + // Add 1 extra and clear final bit to round up to an even number of words + Expression.const(wasm_mod, const_int32(1 + additional_words)), + ), + Expression.const(wasm_mod, const_int32(0xfffffffe)), + ), + Expression.const(wasm_mod, const_int32(4)), + ), + ); + Expression.tuple_extract( wasm_mod, - env, - [Expression.const(wasm_mod, const_int32(4 * words_to_allocate))], + Expression.tuple_make( + wasm_mod, + [ + compile_bind(wasm_mod, env, ~action=BindGet, runtime_heap_ptr), + compile_bind( + wasm_mod, + env, + ~action=BindTee(addition), + runtime_heap_ptr, + ), + ], + ), + 0, ); }; @@ -1897,6 +1999,14 @@ let heap_allocate_imm = }; }; +let heap_allocate_imm = + (~additional_words=0, wasm_mod, env, num_words: immediate) => + if (Env.is_runtime_mode()) { + heap_runtime_allocate_imm(~additional_words, wasm_mod, env, num_words); + } else { + heap_allocate_imm(~additional_words, wasm_mod, env, num_words); + }; + let buf_to_ints = (buf: Buffer.t): list(int64) => { let num_bytes = Buffer.length(buf); let num_ints = num_bytes / 8; @@ -1939,16 +2049,7 @@ let allocate_string = (wasm_mod, env, str) => { ~offset=0, wasm_mod, tee_swap( - call_malloc( - wasm_mod, - env, - [ - Expression.const( - wasm_mod, - const_int32 @@ 4 * (2 + 2 * List.length(ints_to_push)), - ), - ], - ), + heap_allocate(wasm_mod, env, 2 + 2 * List.length(ints_to_push)), ), Expression.const( wasm_mod, @@ -1998,13 +2099,7 @@ let allocate_char = (wasm_mod, env, char) => { store( ~offset=0, wasm_mod, - tee_swap( - call_malloc( - wasm_mod, - env, - [Expression.const(wasm_mod, const_int32(8))], - ), - ), + tee_swap(heap_allocate(wasm_mod, env, 2)), Expression.const( wasm_mod, const_int32(tag_val_of_heap_tag_type(CharType)), @@ -2061,10 +2156,7 @@ let allocate_closure = wasm_mod, Op.sub_int32, get_swap(), - Expression.const( - wasm_mod, - const_int32 @@ 4 * round_allocation_size(closure_size), - ), + Expression.const(wasm_mod, const_int32 @@ 4 * closure_size), ), lambda, ); @@ -3345,19 +3437,27 @@ let compile_imports = (wasm_mod, env, {imports}) => { | MImportWasm => Ident.name(name) | MImportGrain => "GRAIN$EXPORT$" ++ Ident.name(name); + // HACK: The malloc module should have no Grain imports, though it does + // depend on the low-level wasm libraries. All of the wasm instructions are + // already inlined, so this dependency is unnecessary. Binaryen has an + // optimization pass which removes those imports, but Binaryen optimizations + // are disabled because of #196. For now, we just omit all Grain imports. + let malloc_mode = Env.is_malloc_mode(); + let compile_import = ({mimp_mod, mimp_name, mimp_type, mimp_kind}) => { let module_name = compile_module_name(mimp_mod, mimp_kind); let item_name = compile_import_name(mimp_name, mimp_kind); let internal_name = get_imported_name(mimp_mod, mimp_name); switch (mimp_kind, mimp_type) { - | (MImportGrain, MGlobalImport(ty)) => + | (MImportGrain, _) when malloc_mode => () + | (MImportGrain, MGlobalImport(ty, mut)) => Import.add_global_import( wasm_mod, internal_name, module_name, item_name, wasm_type(ty), - true, + mut, ) | (_, MFuncImport(args, ret)) => let proc_list = l => @@ -3370,7 +3470,7 @@ let compile_imports = (wasm_mod, env, {imports}) => { proc_list(args), proc_list(ret), ); - | (_, MGlobalImport(typ)) => + | (_, MGlobalImport(typ, mut)) => let typ = compile_asm_type(typ); Import.add_global_import( wasm_mod, @@ -3378,7 +3478,7 @@ let compile_imports = (wasm_mod, env, {imports}) => { module_name, item_name, typ, - false, + mut, ); }; }; @@ -3582,7 +3682,12 @@ let prepare = (env, {imports} as prog) => { let import_offset = List.length(runtime_imports); let import_global_offset = import_offset + List.length(imports); - let new_imports = List.append(runtime_imports, imports); + let new_imports = + if (Env.is_runtime_mode()) { + List.append(required_global_imports, imports); + } else { + List.append(runtime_imports, imports); + }; let new_env = List_utils.fold_lefti( process_import(~is_runtime_import=true), @@ -3608,6 +3713,37 @@ let prepare = (env, {imports} as prog) => { ); }; +let setup_runtime_compilation = (wasm_mod, {exports}) => + if (Env.is_malloc_mode()) { + // Disallow 0 as a valid Grain pointer + ignore @@ + Global.add_global( + wasm_mod, + runtime_heap_ptr_name, + Type.int32, + true, + // TODO: We still have some AssemblyScript modules which use the data + // segment, so we offset where the runtime begins. Once those data + // segments are removed, this should be changed to 8. + Expression.const(wasm_mod, const_int32(256)), + ); + ignore @@ + Export.add_global_export( + wasm_mod, + runtime_heap_ptr_name, + runtime_heap_ptr_name, + ); + } else { + Import.add_global_import( + wasm_mod, + runtime_heap_ptr_name, + Ident.name(malloc_mod), + runtime_heap_ptr_name, + Type.int32, + true, + ); + }; + let compile_wasm_module = (~env=?, ~name=?, prog) => { let env = switch (env) { @@ -3637,11 +3773,24 @@ let compile_wasm_module = (~env=?, ~name=?, prog) => { ); let _ = Memory.set_memory(wasm_mod, 0, Memory.unlimited, "memory", [], false); - let () = ignore @@ compile_functions(wasm_mod, env, prog); - let () = ignore @@ compile_imports(wasm_mod, env, prog); - let () = ignore @@ compile_exports(wasm_mod, env, prog); - let () = ignore @@ compile_globals(wasm_mod, env, prog); - let () = ignore @@ compile_tables(wasm_mod, env, prog); + + let compile_all = () => { + ignore @@ compile_functions(wasm_mod, env, prog); + ignore @@ compile_imports(wasm_mod, env, prog); + ignore @@ compile_exports(wasm_mod, env, prog); + ignore @@ compile_globals(wasm_mod, env, prog); + ignore @@ compile_tables(wasm_mod, env, prog); + }; + + if (Env.is_runtime_mode()) { + setup_runtime_compilation(wasm_mod, prog); + Config.preserve_config(() => { + Config.no_gc := true; + compile_all(); + }); + } else { + compile_all(); + }; let serialized_cmi = Cmi_format.serialize_cmi(prog.signature); Module.add_custom_section( diff --git a/compiler/src/codegen/mashtree.re b/compiler/src/codegen/mashtree.re index 2f51d79246..f46ea43443 100644 --- a/compiler/src/codegen/mashtree.re +++ b/compiler/src/codegen/mashtree.re @@ -429,7 +429,7 @@ and block = list(instr); [@deriving sexp] type import_type = | MFuncImport(list(asmtype), list(asmtype)) - | MGlobalImport(asmtype); + | MGlobalImport(asmtype, bool); [@deriving sexp] type import_kind = diff --git a/compiler/src/codegen/transl_anf.re b/compiler/src/codegen/transl_anf.re index 349edc9938..60bd171ff9 100644 --- a/compiler/src/codegen/transl_anf.re +++ b/compiler/src/codegen/transl_anf.re @@ -917,9 +917,9 @@ let compile_remaining_worklist = () => { }; let lift_imports = (env, imports) => { - let process_shape = + let process_shape = mut => fun - | GlobalShape(alloc) => MGlobalImport(asmtype_of_alloctype(alloc)) + | GlobalShape(alloc) => MGlobalImport(asmtype_of_alloctype(alloc), mut) | FunctionShape(inputs, outputs) => MFuncImport( List.map(asmtype_of_alloctype, inputs), @@ -948,7 +948,7 @@ let lift_imports = (env, imports) => { let new_mod = { mimp_mod, mimp_name, - mimp_type: process_shape(imp_shape), + mimp_type: process_shape(true, imp_shape), mimp_kind: MImportGrain, mimp_setup: MCallGetter, }; @@ -973,13 +973,54 @@ let lift_imports = (env, imports) => { ), }, ); + | WasmValue(mod_, name) => + let mimp_mod = Ident.create(mod_); + let mimp_name = Ident.create(name); + let (asmtype, gc) = + switch (imp_shape) { + | GlobalShape(HeapAllocated as alloc) => ( + asmtype_of_alloctype(alloc), + true, + ) + | GlobalShape(alloc) => (asmtype_of_alloctype(alloc), false) + | FunctionShape(_) => + failwith("internal: WasmValue had FunctionShape") + }; + let new_mod = { + mimp_mod, + mimp_name, + mimp_type: process_shape(false, imp_shape), + mimp_kind: MImportWasm, + mimp_setup: MWrap(Int32.zero), + }; + ( + [new_mod, ...imports], + setups, + { + ...env, + ce_binds: + Ident.add( + imp_use_id, + MGlobalBind( + Printf.sprintf( + "import_%s_%s", + Ident.unique_name(mimp_mod), + Ident.unique_name(mimp_name), + ), + asmtype, + gc, + ), + env.ce_binds, + ), + }, + ); | WasmFunction(mod_, name) => let glob = next_global(~exported=imp_exported == Global, imp_use_id, I32Type); let new_mod = { mimp_mod: Ident.create(mod_), mimp_name: Ident.create(name), - mimp_type: process_shape(imp_shape), + mimp_type: process_shape(false, imp_shape), mimp_kind: MImportWasm, mimp_setup: MWrap(Int32.zero), }; diff --git a/compiler/src/middle_end/analyze_inline_wasm.re b/compiler/src/middle_end/analyze_inline_wasm.re index 0990ec7a70..39dca7dd40 100644 --- a/compiler/src/middle_end/analyze_inline_wasm.re +++ b/compiler/src/middle_end/analyze_inline_wasm.re @@ -236,31 +236,31 @@ let analyze = ({imports, body, analyses}) => { mod_has_inlineable_wasm := false; let process_import = ({imp_use_id, imp_desc}) => { switch (imp_desc) { - | GrainValue("unsafe/wasmi32", name) => + | GrainValue("runtime/unsafe/wasmi32", name) => mod_has_inlineable_wasm := true; switch (get_primitive_i32(name)) { | Some(prim) => set_inlineable_wasm(imp_use_id, prim) | None => () }; - | GrainValue("unsafe/wasmi64", name) => + | GrainValue("runtime/unsafe/wasmi64", name) => mod_has_inlineable_wasm := true; switch (get_primitive_i64(name)) { | Some(prim) => set_inlineable_wasm(imp_use_id, prim) | None => () }; - | GrainValue("unsafe/wasmf32", name) => + | GrainValue("runtime/unsafe/wasmf32", name) => mod_has_inlineable_wasm := true; switch (get_primitive_f32(name)) { | Some(prim) => set_inlineable_wasm(imp_use_id, prim) | None => () }; - | GrainValue("unsafe/wasmf64", name) => + | GrainValue("runtime/unsafe/wasmf64", name) => mod_has_inlineable_wasm := true; switch (get_primitive_f64(name)) { | Some(prim) => set_inlineable_wasm(imp_use_id, prim) | None => () }; - | GrainValue("unsafe/memory", name) => + | GrainValue("runtime/unsafe/memory", name) => mod_has_inlineable_wasm := true; switch (get_primitive_memory(name)) { | Some(prim) => set_inlineable_wasm(imp_use_id, prim) @@ -268,6 +268,7 @@ let analyze = ({imports, body, analyses}) => { }; | GrainValue(_) | WasmFunction(_) + | WasmValue(_) | JSFunction(_) => () }; }; diff --git a/compiler/src/middle_end/anf_helper.re b/compiler/src/middle_end/anf_helper.re index fa6b0fad43..96a7ce0270 100644 --- a/compiler/src/middle_end/anf_helper.re +++ b/compiler/src/middle_end/anf_helper.re @@ -316,6 +316,8 @@ module Imp = { mk(a, GrainValue(md, name), s, global); let wasm_func = (~global=Nonglobal, a, md, name, s) => mk(a, WasmFunction(md, name), s, global); + let wasm_value = (~global=Nonglobal, a, md, name, s) => + mk(a, WasmValue(md, name), s, global); let js_func = (~global=Nonglobal, a, md, name, s) => mk(a, JSFunction(md, name), s, global); }; diff --git a/compiler/src/middle_end/anf_helper.rei b/compiler/src/middle_end/anf_helper.rei index 6219bf5780..a58043cc64 100644 --- a/compiler/src/middle_end/anf_helper.rei +++ b/compiler/src/middle_end/anf_helper.rei @@ -334,6 +334,9 @@ module Imp: { let wasm_func: (~global: global_flag=?, ident, string, string, import_shape) => import_spec; + let wasm_value: + (~global: global_flag=?, ident, string, string, import_shape) => + import_spec; let js_func: (~global: global_flag=?, ident, string, string, import_shape) => import_spec; diff --git a/compiler/src/middle_end/anftree.re b/compiler/src/middle_end/anftree.re index 220ac0cf8a..34b4fb49c4 100644 --- a/compiler/src/middle_end/anftree.re +++ b/compiler/src/middle_end/anftree.re @@ -385,6 +385,7 @@ type import_shape = type import_desc = | GrainValue(string, string) | WasmFunction(string, string) + | WasmValue(string, string) | JSFunction(string, string); [@deriving sexp] diff --git a/compiler/src/middle_end/anftree.rei b/compiler/src/middle_end/anftree.rei index f2960ae608..75d78d12ee 100644 --- a/compiler/src/middle_end/anftree.rei +++ b/compiler/src/middle_end/anftree.rei @@ -369,6 +369,7 @@ type import_shape = type import_desc = | GrainValue(string, string) | WasmFunction(string, string) + | WasmValue(string, string) | JSFunction(string, string); [@deriving sexp] diff --git a/compiler/src/middle_end/linearize.re b/compiler/src/middle_end/linearize.re index 1d1575be58..2566b68bbc 100644 --- a/compiler/src/middle_end/linearize.re +++ b/compiler/src/middle_end/linearize.re @@ -1329,25 +1329,42 @@ let rec transl_anf_statement = }; | TTopException(_, ext) => (Some(linearize_exception(env, ext)), []) | TTopForeign(exported, desc) => - let (argsty, retty) = - get_fn_allocation_type(env, desc.tvd_desc.ctyp_type); let global = switch (exported) { | Exported => Global | Nonexported => Nonglobal }; - ( - None, - [ - Imp.wasm_func( - ~global, - desc.tvd_id, - desc.tvd_mod.txt, - desc.tvd_name.txt, - FunctionShape(argsty, [retty]), - ), - ], - ); + switch (desc.tvd_desc.ctyp_type.desc) { + | TTyArrow(_) => + let (argsty, retty) = + get_fn_allocation_type(env, desc.tvd_desc.ctyp_type); + ( + None, + [ + Imp.wasm_func( + ~global, + desc.tvd_id, + desc.tvd_mod.txt, + desc.tvd_name.txt, + FunctionShape(argsty, [retty]), + ), + ], + ); + | _ => + let ty = get_allocation_type(env, desc.tvd_desc.ctyp_type); + ( + None, + [ + Imp.wasm_value( + ~global, + desc.tvd_id, + desc.tvd_mod.txt, + desc.tvd_name.txt, + GlobalShape(ty), + ), + ], + ); + }; | _ => (None, []) }; diff --git a/compiler/src/parsing/lexer.mll b/compiler/src/parsing/lexer.mll index 80f6ae8a99..26df14ff08 100644 --- a/compiler/src/parsing/lexer.mll +++ b/compiler/src/parsing/lexer.mll @@ -58,7 +58,7 @@ let consume_comments () = let out_comments = !comments in comments := []; - out_comments + List.rev(out_comments) let parse_line_comment comment_type lexbuf = let source = lexeme lexbuf in diff --git a/compiler/src/typed/env.re b/compiler/src/typed/env.re index 8d6ed12379..f9d33f30c3 100644 --- a/compiler/src/typed/env.re +++ b/compiler/src/typed/env.re @@ -662,12 +662,33 @@ let get_components = c => | Some(c) => c }; -let current_unit = ref(("", "")); +type compilation_mode = + | Normal + | Runtime + | MemoryAllocation; -let set_unit = ((name, source)) => current_unit := (name, source); +let current_unit = ref(("", "", Normal)); + +let set_unit = ((name, source, mode)) => + current_unit := (name, source, mode); let get_unit = () => current_unit^; +let is_runtime_mode = () => { + switch (current_unit^) { + | (_, _, Runtime) => true + | (_, _, MemoryAllocation) => true + | _ => false + }; +}; + +let is_malloc_mode = () => { + switch (current_unit^) { + | (_, _, MemoryAllocation) => true + | _ => false + }; +}; + /* Persistent structure descriptions */ type pers_flags = Cmi_format.pers_flags = | Rectypes | Opaque | Unsafe_string; @@ -773,7 +794,7 @@ let mark_in_progress = (~loc, unit_name, sourcefile) => { Cyclic_dependencies(unit_name, get_dependency_chain(~loc, unit_name)), ); }; - let (stored_name, _) = get_unit(); + let (stored_name, _, _) = get_unit(); Hashtbl.add( compilation_in_progress, sourcefile, @@ -939,12 +960,12 @@ let acknowledge_pers_struct = (check, {Persistent_signature.filename, cmi}) => { fun | Rectypes => if (! Clflags.recursive_types^) { - let (unit_name, _) = get_unit(); + let (unit_name, _, _) = get_unit(); error(Need_recursive_types(ps.ps_name, unit_name)); } | Unsafe_string => if (Config.safe_string^) { - let (unit_name, _) = get_unit(); + let (unit_name, _, _) = get_unit(); error(Depend_on_unsafe_string_unit(ps.ps_name, unit_name)); } | Opaque => add_imported_opaque(filename), @@ -1047,7 +1068,7 @@ let rec find_module_descr = (path, filename, env) => | PIdent(id) => try(IdTbl.find_same(id, env.components)) { | Not_found => - let (_, unit_source) = get_unit(); + let (_, unit_source, _) = get_unit(); let filename = Option.value(~default=Ident.name(id), filename); if (Ident.persistent(id) && !(filename == unit_source)) { find_pers_struct(~loc=Location.dummy_loc, filename).ps_comps; @@ -1097,7 +1118,7 @@ let find_module = (~alias, path, filename, env) => EnvLazy.force(subst_modtype_maker, data); }) { | Not_found => - let (_, unit_source) = get_unit(); + let (_, unit_source, _) = get_unit(); let filename = Option.value(~default=Ident.name(id), filename); if (Ident.persistent(id) && !(filename == unit_source)) { let ps = find_pers_struct(~loc=Location.dummy_loc, filename); @@ -1263,7 +1284,7 @@ and lookup_module = (~loc=?, ~load, ~mark, id, filename, env): Path.t => p; }) { | Not_found => - let (_, unit_source) = get_unit(); + let (_, unit_source, _) = get_unit(); if (Option.value(~default=s, filename) == unit_source) { raise(Not_found); }; diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei index 38cd8559d9..84b1b707f2 100644 --- a/compiler/src/typed/env.rei +++ b/compiler/src/typed/env.rei @@ -159,9 +159,16 @@ let add_local_type: (Path.t, type_declaration, t) => t; let add_item: (signature_item, t) => t; let add_signature: (signature, t) => t; -/* Remember the current compilation unit: modname * filename. */ -let set_unit: ((string, string)) => unit; -let get_unit: unit => (string, string); +/* Remember the current compilation unit: modname * filename * compilation mode. */ +type compilation_mode = + | Normal + | Runtime + | MemoryAllocation; + +let set_unit: ((string, string, compilation_mode)) => unit; +let get_unit: unit => (string, string, compilation_mode); +let is_runtime_mode: unit => bool; +let is_malloc_mode: unit => bool; /* Insertion of all fields of a signature, relative to the given path. Used to implement open. Returns None if the path refers to a functor, diff --git a/compiler/src/typed/typemod.re b/compiler/src/typed/typemod.re index 5ee0f228eb..d2094f2d3f 100644 --- a/compiler/src/typed/typemod.re +++ b/compiler/src/typed/typemod.re @@ -826,14 +826,27 @@ let type_module = (~toplevel=false, funct_body, anchor, env, sstr /*scope*/) => let type_module = type_module(false, None); -let implicit_modules: ref(list((string, string))) = ( - ref([("Pervasives", "pervasives")]): ref(list((string, string))) +let implicit_modules: ref(list((string, string, bool))) = ( + ref([ + ("Pervasives", "pervasives", true), + ("Malloc", "runtime/malloc", false), + ]): + ref(list((string, string, bool))) ); -let open_implicit_module = (m, env) => { +let open_implicit_module = (m, env, in_env) => { open Asttypes; let loc = Location.dummy_loc; - let (modname, filename) = m; + let (modname, filename, _) = m; + let values = + if (in_env) { + [ + PImportModule(Location.mknoloc(Identifier.IdentName(modname))), + PImportAllExcept([]), + ]; + } else { + []; + }; let (_path, newenv) = type_open_( env, @@ -842,10 +855,7 @@ let open_implicit_module = (m, env) => { loc, txt: filename, }, - pimp_val: [ - PImportModule(Location.mknoloc(Identifier.IdentName(modname))), - PImportAllExcept([]), - ], + pimp_val: values, pimp_loc: loc, }, ); @@ -856,26 +866,38 @@ let initial_env = () => { Ident.reinit(); let initial = Env.initial_safe_string; let env = initial; - List.fold_left( - (env, m) => { - let (modname, _) = m; - let (unit_name, _) = Env.get_unit(); - if (unit_name != modname) { - open_implicit_module(m, env); - } else { - env; - }; - }, - env, - implicit_modules^, - ); + let (unit_name, source, _) = Env.get_unit(); + if (Env.is_runtime_mode()) { + env; + } else { + List.fold_left( + (env, m) => { + let (modname, _, in_env) = m; + if (unit_name != modname) { + open_implicit_module(m, env, in_env); + } else { + env; + }; + }, + env, + implicit_modules^, + ); + }; +}; + +let get_compilation_mode = prog => { + switch (prog.comments) { + | [Block({cmt_content: "compilation-mode: runtime"}), ..._] => Env.Runtime + | [Block({cmt_content: "compilation-mode: malloc"}), ..._] => Env.MemoryAllocation + | _ => Env.Normal + }; }; let type_implementation = prog => { let sourcefile = prog.prog_loc.loc_start.pos_fname; /* TODO: Do we maybe need a fallback here? */ let modulename = Grain_utils.Files.filename_to_module_name(sourcefile); - Env.set_unit((modulename, sourcefile)); + Env.set_unit((modulename, sourcefile, get_compilation_mode(prog))); let initenv = initial_env(); let (stritems, sg, finalenv) = type_module(initenv, prog); let (statements, env) = stritems; diff --git a/compiler/test/input/letMutForLoop.gr b/compiler/test/input/letMutForLoop.gr index f148adba3c..23df825504 100644 --- a/compiler/test/input/letMutForLoop.gr +++ b/compiler/test/input/letMutForLoop.gr @@ -1,9 +1,10 @@ -import WasmI64 from "unsafe/wasmi64" +import WasmI64 from "runtime/unsafe/wasmi64" +import WasmUtils from "runtime/unsafe/utils" @disableGC let foo = () => { for (let mut x = 0N; WasmI64.ltS(x, 5N); x = WasmI64.add(x, 1N)) { - WasmI64.print(x) + WasmUtils.printI64(x) } } diff --git a/compiler/test/input/unsafeWasmGlobals.gr b/compiler/test/input/unsafeWasmGlobals.gr index 771660b264..da03ed3c43 100644 --- a/compiler/test/input/unsafeWasmGlobals.gr +++ b/compiler/test/input/unsafeWasmGlobals.gr @@ -1,11 +1,8 @@ -import WasmI32 from "unsafe/wasmi32" -import WasmI64 from "unsafe/wasmi64" -import WasmF32 from "unsafe/wasmf32" -import WasmF64 from "unsafe/wasmf64" +import WasmUtils from "runtime/unsafe/utils" import { _I32_VAL, _I64_VAL, _F32_VAL, _F64_VAL } from "unsafeWasmGlobalsExports" -WasmI32.print(_I32_VAL) -WasmI64.print(_I64_VAL) -WasmF32.print(_F32_VAL) -WasmF64.print(_F64_VAL) +WasmUtils.printI32(_I32_VAL) +WasmUtils.printI64(_I64_VAL) +WasmUtils.printF32(_F32_VAL) +WasmUtils.printF64(_F64_VAL) diff --git a/compiler/test/stdlib/wasmf32.test.gr b/compiler/test/stdlib/wasmf32.test.gr index fec77284cb..bca470b5c1 100644 --- a/compiler/test/stdlib/wasmf32.test.gr +++ b/compiler/test/stdlib/wasmf32.test.gr @@ -1,4 +1,5 @@ -import WasmF32 from "unsafe/wasmf32" +import WasmF32 from "runtime/unsafe/wasmf32" +import Conv from "runtime/unsafe/conv" @disableGC let test = () => { @@ -52,8 +53,8 @@ let test = () => { assert WasmF32.eq(WasmF32.demoteF64(1.23W), 1.23w) // Grain conversion tests - assert WasmF32.toFloat32(1.23w) == 1.23f - assert WasmF32.eq(WasmF32.ofFloat32(1.23f), 1.23w) + assert Conv.toFloat32(1.23w) == 1.23f + assert WasmF32.eq(Conv.fromFloat32(1.23f), 1.23w) } test() diff --git a/compiler/test/stdlib/wasmf64.test.gr b/compiler/test/stdlib/wasmf64.test.gr index aa3ce76374..85a7851b70 100644 --- a/compiler/test/stdlib/wasmf64.test.gr +++ b/compiler/test/stdlib/wasmf64.test.gr @@ -1,4 +1,5 @@ -import WasmF64 from "unsafe/wasmf64" +import WasmF64 from "runtime/unsafe/wasmf64" +import Conv from "runtime/unsafe/conv" @disableGC let test = () => { @@ -52,8 +53,8 @@ let test = () => { assert WasmF64.eq(WasmF64.promoteF32(1.5w), 1.5W) // Grain conversion tests - assert WasmF64.toFloat64(1.23W) == 1.23d - assert WasmF64.eq(WasmF64.ofFloat64(1.23d), 1.23W) + assert Conv.toFloat64(1.23W) == 1.23d + assert WasmF64.eq(Conv.fromFloat64(1.23d), 1.23W) } test() diff --git a/compiler/test/stdlib/wasmi32.test.gr b/compiler/test/stdlib/wasmi32.test.gr index b6a645ae7d..6acb5fbfc9 100644 --- a/compiler/test/stdlib/wasmi32.test.gr +++ b/compiler/test/stdlib/wasmi32.test.gr @@ -1,4 +1,5 @@ -import WasmI32 from "unsafe/wasmi32" +import WasmI32 from "runtime/unsafe/wasmi32" +import Conv from "runtime/unsafe/conv" @disableGC let test = () => { @@ -65,8 +66,8 @@ let test = () => { // Grain conversion tests assert WasmI32.eq(WasmI32.fromGrain(true), 0xfffffffen) assert (WasmI32.toGrain(0xfffffffen): Bool) - assert WasmI32.toInt32(45n) == 45l - assert WasmI32.ofInt32(45l) == 45n + assert Conv.toInt32(45n) == 45l + assert Conv.fromInt32(45l) == 45n } test() diff --git a/compiler/test/stdlib/wasmi64.test.gr b/compiler/test/stdlib/wasmi64.test.gr index a1afd3a839..85c49a5687 100644 --- a/compiler/test/stdlib/wasmi64.test.gr +++ b/compiler/test/stdlib/wasmi64.test.gr @@ -1,4 +1,5 @@ -import WasmI64 from "unsafe/wasmi64" +import WasmI64 from "runtime/unsafe/wasmi64" +import Conv from "runtime/unsafe/conv" @disableGC let test = () => { @@ -66,8 +67,8 @@ let test = () => { assert WasmI64.eq(WasmI64.extendS32(0x80000000N), 0xffffffff80000000N) // Grain conversion tests - assert WasmI64.toInt64(45N) == 45L - assert WasmI64.eq(WasmI64.ofInt64(45L), 45N) + assert Conv.toInt64(45N) == 45L + assert WasmI64.eq(Conv.fromInt64(45L), 45N) } test() diff --git a/runtime/src/core/memory.js b/runtime/src/core/memory.js index 575f6234a5..3a52f43d6d 100644 --- a/runtime/src/core/memory.js +++ b/runtime/src/core/memory.js @@ -662,10 +662,19 @@ export class ManagedMemory { } malloc(userPtr) { - return this._runtime.memoryManager.requiredExport("malloc")(userPtr); + let closure = this._runtime.memoryManager.requiredExport( + "GRAIN$EXPORT$malloc" + ).value; + return this._runtime.memoryManager.requiredExport("malloc")( + closure, + userPtr + ); } free(userPtr) { - this._runtime.memoryManager.requiredExport("free")(userPtr); + let closure = this._runtime.memoryManager.requiredExport( + "GRAIN$EXPORT$free" + ).value; + this._runtime.memoryManager.requiredExport("free")(closure, userPtr); } _free(userPtr) { diff --git a/runtime/src/core/runner.js b/runtime/src/core/runner.js index c9d6446575..048c56f66c 100644 --- a/runtime/src/core/runner.js +++ b/runtime/src/core/runner.js @@ -8,7 +8,7 @@ function roundUp(num, multiple) { return multiple * (Math.floor((num - 1) / multiple) + 1); } -const MALLOC_MODULE = "stdlib-external/runtime/malloc"; +const MALLOC_MODULE = "GRAIN$MODULE$runtime/malloc"; export class GrainRunner { constructor(locator, managedMemory, opts) { @@ -100,30 +100,15 @@ export class GrainRunner { return tyPrintNames[idx]; }, }; - this.loadMemoryManager(); } - async loadMemoryManager() { - const mod = await this.locator(MALLOC_MODULE); - if (mod) { - this.memoryManager = mod; - this.memoryManager.instantiate( - { - env: { - memory: this.managedMemory._memory, - }, - memoryManager: { - _malloc: this.managedMemory._malloc.bind(this.managedMemory), - _free: this.managedMemory._free.bind(this.managedMemory), - _growHeap: this.managedMemory.growHeap.bind(this.managedMemory), - _initialHeapSize: this.managedMemory._memory.buffer.byteLength, - }, - }, - this - ); - } else { - throw new GrainError(-1, "Failed to locate the memory manager."); + get memoryManager() { + if (!this._memoryManager) { + this._memoryManager = this.modules[MALLOC_MODULE]; + if (!this._memoryManager) + throw new GrainError(-1, "Failed to locate the memory manager."); } + return this._memoryManager; } // [HACK] Temporarily used while we transition to AS-based runtime diff --git a/runtime/src/runtime.js b/runtime/src/runtime.js index 80351ef0f4..8270380bec 100644 --- a/runtime/src/runtime.js +++ b/runtime/src/runtime.js @@ -78,14 +78,18 @@ const importObj = { grainRuntime: { mem: memory, tbl: table, - malloc, - free, incRef: managedMemory.incRef.bind(managedMemory), incRef64: managedMemory.incRef64.bind(managedMemory), decRef: managedMemory.decRef.bind(managedMemory), decRef64: managedMemory.decRef64.bind(managedMemory), ...tracingImports, }, + memoryManager: { + _malloc: managedMemory._malloc.bind(managedMemory), + _free: managedMemory._free.bind(managedMemory), + _growHeap: managedMemory.growHeap.bind(managedMemory), + _initialHeapSize: managedMemory._memory.buffer.byteLength, + }, }; export function buildGrainRunner(locator, opts) { diff --git a/stdlib/runtime/debug.gr b/stdlib/runtime/debug.gr new file mode 100644 index 0000000000..246f473365 --- /dev/null +++ b/stdlib/runtime/debug.gr @@ -0,0 +1,3 @@ +/* compilation-mode: runtime */ +export foreign wasm debug: a -> Void from "console" + diff --git a/stdlib/runtime/malloc.gr b/stdlib/runtime/malloc.gr new file mode 100644 index 0000000000..eaadb9080c --- /dev/null +++ b/stdlib/runtime/malloc.gr @@ -0,0 +1,275 @@ +/* compilation-mode: malloc */ + +import WasmI32, { + add as (+), + sub as (-), + divU as (/), + gtU as (>), + geU as (>=), + ltU as (<), + shl as (<<), + shrU as (>>), + eq as (==), + ne as (!=) +} from "runtime/unsafe/wasmi32" + +primitive (!) : Bool -> Bool = "@not" +primitive (&&) : (Bool, Bool) -> Bool = "@and" +primitive (||) : (Bool, Bool) -> Bool = "@or" + +import foreign wasm _malloc: (WasmI32, WasmI32) -> WasmI32 as extMalloc from "memoryManager" +import foreign wasm _free: (WasmI32) -> WasmI32 as extFree from "memoryManager" +import foreign wasm _growHeap: (WasmI32) -> WasmI32 as extGrowHeap from "memoryManager" +import foreign wasm _initialHeapSize: WasmI32 as initialHeapSize from "memoryManager" + +/* UNDERSTANDING THE STRUCTURE OF THE FREE LIST + * The original K&R definition for the free list entry type was the following: + * + * union header { + * struct { + * union header *ptr; + * unsigned size; + * } s; + * long x; // <- forces 8-byte alignment + * }; + * + * In memory, this is really just two ints (assuming we're working in 32-bit mode). + * As such, we manually lay out the entries on the heap as follows (note that we + * use helpers to facilitate accessing and setting these values): + * + * Grain C Equivalent + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * let ptr === union header *ptr + * getNext(ptr) === ptr->s.ptr + * getSize(ptr) === ptr->s.size + */ + +/** + * Pointer to the start of the free list. This is always a multiple of + * 8, with the exception of its initial value (used as a sentinel). + */ +let mut freePtr = 1n + +/** + * Size (in bytes) of entries in the free list. + */ +let mallocHeaderSize = 8n + +/** + * log_2(mallocHeaderSize) (multiplication by the header + * size is equivalent to left-shifting by this amount) + */ +let logMallocHeaderSize = 3n + +/** + * The current size (in bytes) of the heap. + */ +let mut heapSize = 0n + +let _RESERVED_RUNTIME_SPACE = 4096n; + +let getNext = (ptr: WasmI32) => { + WasmI32.load(ptr, 0n) +} + +let setNext = (ptr: WasmI32, val: WasmI32) => { + WasmI32.store(ptr, val, 0n) +} + +let getSize = (ptr: WasmI32) => { + WasmI32.load(ptr, 4n) +} + +let setSize = (ptr: WasmI32, val: WasmI32) => { + WasmI32.store(ptr, val, 4n) +} + +/** + * Requests that the heap be grown by the given number of bytes. + * + * @param nbytes: WasmI32 - The number of bytes requested + * @return WasmI32 - If unsuccessful, -1. Otherwise, the pointer to the beginning of the extended region. + */ +let growHeap = (nbytes: WasmI32) => { + let mut reqSize = 0n + let mut reqResult = 0n + let mut origSize = heapSize + + // If the size has not been initialized, do so. + if (heapSize == 0n) { + heapSize = initialHeapSize - _RESERVED_RUNTIME_SPACE + if (nbytes > heapSize) { + // More bytes requested than the initial heap size, + // so we need to request more anyway. + reqSize = nbytes - heapSize + reqSize = reqSize >> 16n + reqSize = reqSize + 1n + reqResult = extGrowHeap(reqSize) + if (reqResult == -1n) { + -1n + } else { + heapSize += reqSize << 16n + _RESERVED_RUNTIME_SPACE + } + } else { + _RESERVED_RUNTIME_SPACE + } + } else { + // The size has already been initialized, so call the external function. + reqSize = nbytes + reqSize = reqSize >> 16n + reqSize = reqSize + 1n + reqResult = extGrowHeap(reqSize) + if (reqResult == -1n) { + -1n + } else { + heapSize += reqSize << 16n + reqResult + } + } +} + +/** + * Frees the given allocated pointer. + * + * @param ap: WasmI32 - The pointer to free + */ +export let free = (ap: WasmI32) => { + // Let memory manager know we're freeing this pointer + extFree(ap) + + let mut blockPtr = ap - 16n // 8 bytes for malloc header + 8 bytes for GC header + let mut p = freePtr + + // Edge case: for the first free (called by morecore), the free pointer + // is actually already pointing to this node, so we don't do anything. + if (blockPtr != freePtr) { + // Find the location to insert this block into the free list + for ( ; !((blockPtr > p) && (blockPtr < getNext(p))); p = getNext(p) ) { + if ((p >= getNext(p)) && ((blockPtr > p) || (blockPtr < getNext(p)))) { + break + } + } + + // Merge the block into the adjacent free list entry above, if needed + if (blockPtr + getSize(blockPtr) == getNext(p)) { + let next = getNext(p) + setSize(blockPtr, getSize(blockPtr) + getSize(next)) + setNext(blockPtr, getNext(next)) + } else { + setNext(blockPtr, getNext(p)) + } + // Merge the previous (adjacent) free list entry into this block, if needed + if (p + getSize(p) == blockPtr) { + setSize(p, getSize(p) + getSize(blockPtr)) + setNext(p, getNext(blockPtr)) + } else { + setNext(p, blockPtr) + } + // Set the free list head to this block + freePtr = p; + }; +} + +/** + * Asks the runtime for more heap memory. + * (if you can't tell from the fact that the name is reminiscient + * of the 1970s, the name of this function is taken from K&R). + * + * @param nbytes: WasmI32 - The number of bytes to try to grow the heap by + * @return WasmI32 - If successful, a pointer to the start of the free list. If not successful, -1. + */ +let morecore = (nbytes: WasmI32) => { + let origSize = heapSize + let mut cp = growHeap(nbytes) + + // If there was an error, return + if (cp == -1n) { + -1n + } else { + // Set the size of the new block to the amount the + // heap was grown. + let grownAmount = heapSize - origSize + setSize(cp, grownAmount) + // Call free() with the new block to add it to the free list. + // Add an additional 8 for the expected GC header + free(cp + 8n + 8n) + // Return the free list pointer. + freePtr + } +} + +/** + * Allocates the requested number of bytes, returning a pointer. + * + * @param nbytes: WasmI32 - The number of bytes to allocate + * @return WasmI32 - The pointer to the allocated region (8-byte aligned), or -1 if the allocation failed. + */ +export let malloc = (nb: WasmI32) => { + // Add space for GC header + let mut nbytes = nb + 8n + let mut prevp = freePtr + + // Set nbytes to the next multiple of mallocHeaderSize greater + // than the given size + let mut nunits = (nbytes + mallocHeaderSize - 1n) / mallocHeaderSize + 1n + nbytes = nunits << logMallocHeaderSize // multiply by header size + + // Handle initialization + if (heapSize == 0n) { + WasmI32.store(_RESERVED_RUNTIME_SPACE, _RESERVED_RUNTIME_SPACE, 0n) + freePtr = _RESERVED_RUNTIME_SPACE + prevp = _RESERVED_RUNTIME_SPACE + WasmI32.store(_RESERVED_RUNTIME_SPACE, 0n, 4n) + } + + let mut ret = -1n + + // Search the freelist for any blocks large enough. + for (let mut p = getNext(prevp); ; {prevp = p; p = getNext(p)}) { + let size = getSize(p) + if (size >= nbytes) { + // If this block is big enough, allocate from it. + if (size == nbytes) { + // It's exactly the right size! + setNext(prevp, getNext(p)) + } else { + // Shrink it as needed + let newSize = size - nbytes + setSize(p, newSize) + p = p + newSize + setSize(p, nbytes) + } + // Update the pointer to the free list. + freePtr = prevp; + + // Let runtime set up reference counting + // Address of the region past the malloc header + ret = extMalloc(p + 8n, nb) + break + } + + // We've reached the end of the free list. Time to grow the heap. + if (p == freePtr) { + // Attempt to grow the heap + p = morecore(nbytes) + // If growing the heap failed, return -1. + if (p == -1n) { + // Error + ret = -1n + break + } + } + } + ret +} + +/** + * Returns the current free list pointer + * (used for debugging) + * + * @return WasmI32 - The free list pointer + */ +export let getFreePtr = () => { + freePtr +} diff --git a/stdlib/runtime/unsafe/conv.gr b/stdlib/runtime/unsafe/conv.gr new file mode 100644 index 0000000000..c3120f18bb --- /dev/null +++ b/stdlib/runtime/unsafe/conv.gr @@ -0,0 +1,70 @@ +import Memory from "runtime/unsafe/memory" +import WasmI32 from "runtime/unsafe/wasmi32" +import WasmI64 from "runtime/unsafe/wasmi64" +import WasmF32 from "runtime/unsafe/wasmf32" +import WasmF64 from "runtime/unsafe/wasmf64" +import Tags from "runtime/unsafe/tags" + +@disableGC +export let toInt32 = (n) => { + let ptr = Memory.malloc(12n) + WasmI32.store(ptr, Tags._GRAIN_BOXED_NUM_HEAP_TAG, 0n) + WasmI32.store(ptr, Tags._GRAIN_INT32_BOXED_NUM_TAG, 4n) + WasmI32.store(ptr, n, 8n) + + WasmI32.toGrain(ptr) : Int32 +} + +@disableGC +export let fromInt32 = (n: Int32) => { + let ptr = WasmI32.fromGrain(n) + WasmI32.load(ptr, 8n) +} + +@disableGC +export let toInt64 = (n) => { + let ptr = Memory.malloc(16n) + WasmI32.store(ptr, Tags._GRAIN_BOXED_NUM_HEAP_TAG, 0n) + WasmI32.store(ptr, Tags._GRAIN_INT64_BOXED_NUM_TAG, 4n) + WasmI64.store(ptr, n, 8n) + + WasmI32.toGrain(ptr) : Int64 +} + +@disableGC +export let fromInt64 = (n: Int64) => { + let ptr = WasmI32.fromGrain(n) + WasmI64.load(ptr, 8n) +} + +@disableGC +export let toFloat32 = (n) => { + let ptr = Memory.malloc(12n) + WasmI32.store(ptr, Tags._GRAIN_BOXED_NUM_HEAP_TAG, 0n) + WasmI32.store(ptr, Tags._GRAIN_FLOAT32_BOXED_NUM_TAG, 4n) + WasmF32.store(ptr, n, 8n) + + WasmI32.toGrain(ptr) : Float32 +} + +@disableGC +export let fromFloat32 = (n: Float32) => { + let ptr = WasmI32.fromGrain(n) + WasmF32.load(ptr, 8n) +} + +@disableGC +export let toFloat64 = (n) => { + let ptr = Memory.malloc(16n) + WasmI32.store(ptr, Tags._GRAIN_BOXED_NUM_HEAP_TAG, 0n) + WasmI32.store(ptr, Tags._GRAIN_FLOAT64_BOXED_NUM_TAG, 4n) + WasmF64.store(ptr, n, 8n) + + WasmI32.toGrain(ptr) : Float64 +} + +@disableGC +export let fromFloat64 = (n: Float64) => { + let ptr = WasmI32.fromGrain(n) + WasmF64.load(ptr, 8n) +} diff --git a/stdlib/unsafe/memory.gr b/stdlib/runtime/unsafe/memory.gr similarity index 68% rename from stdlib/unsafe/memory.gr rename to stdlib/runtime/unsafe/memory.gr index 4178dfa24c..7e035017fa 100644 --- a/stdlib/unsafe/memory.gr +++ b/stdlib/runtime/unsafe/memory.gr @@ -1,5 +1,10 @@ -export foreign wasm malloc: WasmI32 -> WasmI32 from "grainRuntime" -export foreign wasm free: WasmI32 -> Void from "grainRuntime" +/* compilation-mode: runtime */ + +import Malloc from "runtime/malloc" + +export let malloc = Malloc.malloc +export let free = Malloc.free + export foreign wasm incRef: WasmI32 -> WasmI32 from "grainRuntime" export foreign wasm decRef: WasmI32 -> WasmI32 from "grainRuntime" diff --git a/stdlib/runtime/unsafe/tags.gr b/stdlib/runtime/unsafe/tags.gr new file mode 100644 index 0000000000..ca624cc1f5 --- /dev/null +++ b/stdlib/runtime/unsafe/tags.gr @@ -0,0 +1,24 @@ +/* compilation-mode: runtime */ + +export let _GRAIN_NUMBER_TAG_TYPE = 0b0001n +export let _GRAIN_CONST_TAG_TYPE = 0b0110n +export let _GRAIN_GENERIC_HEAP_TAG_TYPE = 0b0000n + +export let _GRAIN_NUMBER_TAG_MASK = 0b0001n +export let _GRAIN_GENERIC_TAG_MASK = 0b0111n + +export let _GRAIN_STRING_HEAP_TAG = 1n +export let _GRAIN_CHAR_HEAP_TAG = 2n +export let _GRAIN_ADT_HEAP_TAG = 3n +export let _GRAIN_RECORD_HEAP_TAG = 4n +export let _GRAIN_ARRAY_HEAP_TAG = 5n +export let _GRAIN_BOXED_NUM_HEAP_TAG = 6n +export let _GRAIN_LAMBDA_HEAP_TAG = 7n +export let _GRAIN_TUPLE_HEAP_TAG = 8n + +// Boxed number types +export let _GRAIN_FLOAT32_BOXED_NUM_TAG = 1n +export let _GRAIN_FLOAT64_BOXED_NUM_TAG = 2n +export let _GRAIN_INT32_BOXED_NUM_TAG = 3n +export let _GRAIN_INT64_BOXED_NUM_TAG = 4n +export let _GRAIN_RATIONAL_BOXED_NUM_TAG = 5n diff --git a/stdlib/runtime/unsafe/utils.gr b/stdlib/runtime/unsafe/utils.gr new file mode 100644 index 0000000000..d542d72c3d --- /dev/null +++ b/stdlib/runtime/unsafe/utils.gr @@ -0,0 +1,21 @@ +import Conv from "runtime/unsafe/conv" + +@disableGC +export let printI32 = (val) => { + print(toString(Conv.toInt32(val)) ++ "n") +} + +@disableGC +export let printI64 = (val) => { + print(toString(Conv.toInt64(val)) ++ "N") +} + +@disableGC +export let printF32 = (val) => { + print(toString(Conv.toFloat32(val)) ++ "w") +} + +@disableGC +export let printF64 = (val) => { + print(toString(Conv.toFloat64(val)) ++ "W") +} diff --git a/stdlib/unsafe/wasmf32.gr b/stdlib/runtime/unsafe/wasmf32.gr similarity index 78% rename from stdlib/unsafe/wasmf32.gr rename to stdlib/runtime/unsafe/wasmf32.gr index 563414fabc..c0f77a9f2e 100644 --- a/stdlib/unsafe/wasmf32.gr +++ b/stdlib/runtime/unsafe/wasmf32.gr @@ -1,5 +1,4 @@ -import Memory from "unsafe/memory" -import WasmI32 from "unsafe/wasmi32" +/* compilation-mode: runtime */ // WebAssembly Memory Instructions export primitive load: (WasmI32, WasmI32) -> WasmF32 = "@wasm.load_float32" @@ -36,29 +35,3 @@ export primitive convertI32U: WasmI32 -> WasmF32 = "@wasm.convert_u_int32_to_flo export primitive convertI64S: WasmI64 -> WasmF32 = "@wasm.convert_s_int64_to_float32" export primitive convertI64U: WasmI64 -> WasmF32 = "@wasm.convert_u_int64_to_float32" export primitive demoteF64: WasmF64 -> WasmF32 = "@wasm.demote_float64" - -// Grain Conversions -@disableGC -export let toFloat32 = (n) => { - let _GRAIN_BOXED_NUM_HEAP_TAG = 6n - let _GRAIN_FLOAT32_BOXED_NUM_TAG = 1n - - let ptr = Memory.malloc(12n) - WasmI32.store(ptr, _GRAIN_BOXED_NUM_HEAP_TAG, 0n) - WasmI32.store(ptr, _GRAIN_FLOAT32_BOXED_NUM_TAG, 4n) - store(ptr, n, 8n) - - WasmI32.toGrain(ptr) : Float32 -} - -@disableGC -export let ofFloat32 = (n: Float32) => { - let ptr = WasmI32.fromGrain(n) - load(ptr, 8n) -} - -// Utilities -@disableGC -export let print = (val) => { - print(toString(toFloat32(val)) ++ "w") -} diff --git a/stdlib/unsafe/wasmf64.gr b/stdlib/runtime/unsafe/wasmf64.gr similarity index 78% rename from stdlib/unsafe/wasmf64.gr rename to stdlib/runtime/unsafe/wasmf64.gr index 27a2169db4..aa0c11345d 100644 --- a/stdlib/unsafe/wasmf64.gr +++ b/stdlib/runtime/unsafe/wasmf64.gr @@ -1,5 +1,4 @@ -import Memory from "unsafe/memory" -import WasmI32 from "unsafe/wasmi32" +/* compilation-mode: runtime */ // WebAssembly Memory Instructions export primitive load: (WasmI32, WasmI32) -> WasmF64 = "@wasm.load_float64" @@ -36,29 +35,3 @@ export primitive convertI32U: WasmI32 -> WasmF64 = "@wasm.convert_u_int32_to_flo export primitive convertI64S: WasmI64 -> WasmF64 = "@wasm.convert_s_int64_to_float64" export primitive convertI64U: WasmI64 -> WasmF64 = "@wasm.convert_u_int64_to_float64" export primitive promoteF32: WasmF32 -> WasmF64 = "@wasm.promote_float32" - -// Grain Conversions -@disableGC -export let toFloat64 = (n) => { - let _GRAIN_BOXED_NUM_HEAP_TAG = 6n - let _GRAIN_FLOAT64_BOXED_NUM_TAG = 2n - - let ptr = Memory.malloc(16n) - WasmI32.store(ptr, _GRAIN_BOXED_NUM_HEAP_TAG, 0n) - WasmI32.store(ptr, _GRAIN_FLOAT64_BOXED_NUM_TAG, 4n) - store(ptr, n, 8n) - - WasmI32.toGrain(ptr) : Float64 -} - -@disableGC -export let ofFloat64 = (n: Float64) => { - let ptr = WasmI32.fromGrain(n) - load(ptr, 8n) -} - -// Utilities -@disableGC -export let print = (val) => { - print(toString(toFloat64(val)) ++ "W") -} diff --git a/stdlib/unsafe/wasmi32.gr b/stdlib/runtime/unsafe/wasmi32.gr similarity index 87% rename from stdlib/unsafe/wasmi32.gr rename to stdlib/runtime/unsafe/wasmi32.gr index c3fc6bea4f..63d651bae8 100644 --- a/stdlib/unsafe/wasmi32.gr +++ b/stdlib/runtime/unsafe/wasmi32.gr @@ -1,4 +1,4 @@ -import Memory from "unsafe/memory" +/* compilation-mode: runtime */ // WebAssembly Memory Instructions export primitive load : (WasmI32, WasmI32) -> WasmI32 = "@wasm.load_int32" @@ -56,28 +56,3 @@ export primitive extendS16 : WasmI32 -> WasmI32 = "@wasm.extend_s16_int32" // Grain Conversions export primitive fromGrain : a -> WasmI32 = "@wasm.fromGrain" export primitive toGrain : WasmI32 -> a = "@wasm.toGrain" - -@disableGC -export let toInt32 = (n) => { - let _GRAIN_BOXED_NUM_HEAP_TAG = 6n - let _GRAIN_INT32_BOXED_NUM_TAG = 3n - - let ptr = Memory.malloc(12n) - store(ptr, _GRAIN_BOXED_NUM_HEAP_TAG, 0n) - store(ptr, _GRAIN_INT32_BOXED_NUM_TAG, 4n) - store(ptr, n, 8n) - - toGrain(ptr) : Int32 -} - -@disableGC -export let ofInt32 = (n: Int32) => { - let ptr = fromGrain(n) - load(ptr, 8n) -} - -// Utilities -@disableGC -export let print = (val) => { - print(toString(toInt32(val)) ++ "n") -} diff --git a/stdlib/unsafe/wasmi64.gr b/stdlib/runtime/unsafe/wasmi64.gr similarity index 86% rename from stdlib/unsafe/wasmi64.gr rename to stdlib/runtime/unsafe/wasmi64.gr index e2c963b74e..03d782bf1a 100644 --- a/stdlib/unsafe/wasmi64.gr +++ b/stdlib/runtime/unsafe/wasmi64.gr @@ -1,5 +1,4 @@ -import WasmI32 from "unsafe/wasmi32" -import Memory from "unsafe/memory" +/* compilation-mode: runtime */ // WebAssembly Memory Instructions export primitive load : (WasmI32, WasmI32) -> WasmI64 = "@wasm.load_int64" @@ -58,29 +57,3 @@ export primitive reinterpretF64 : WasmF64 -> WasmI64 = "@wasm.reinterpret_float6 export primitive extendS8 : WasmI64 -> WasmI64 = "@wasm.extend_s8_int64" export primitive extendS16 : WasmI64 -> WasmI64 = "@wasm.extend_s16_int64" export primitive extendS32 : WasmI64 -> WasmI64 = "@wasm.extend_s32_int64" - -// Grain Conversions -@disableGC -export let toInt64 = (n) => { - let _GRAIN_BOXED_NUM_HEAP_TAG = 6n - let _GRAIN_INT64_BOXED_NUM_TAG = 4n - - let ptr = Memory.malloc(16n) - WasmI32.store(ptr, _GRAIN_BOXED_NUM_HEAP_TAG, 0n) - WasmI32.store(ptr, _GRAIN_INT64_BOXED_NUM_TAG, 4n) - store(ptr, n, 8n) - - WasmI32.toGrain(ptr) : Int64 -} - -@disableGC -export let ofInt64 = (n: Int64) => { - let ptr = WasmI32.fromGrain(n) - load(ptr, 8n) -} - -// Utilities -@disableGC -export let print = (val) => { - print(toString(toInt64(val)) ++ "N") -} diff --git a/stdlib/stdlib-external/ascutils/grainRuntime.ts b/stdlib/stdlib-external/ascutils/grainRuntime.ts index 56fa549a7f..76ce00126e 100644 --- a/stdlib/stdlib-external/ascutils/grainRuntime.ts +++ b/stdlib/stdlib-external/ascutils/grainRuntime.ts @@ -1,8 +1,27 @@ -export declare function malloc(bytes: u32): u32 -export declare function free(ptr: u32): u32 +@external("GRAIN$MODULE$runtime/malloc", "malloc") +declare function mallocExt(closure: u32, bytes: u32): u32 +@external("GRAIN$MODULE$runtime/malloc", "GRAIN$EXPORT$malloc") +declare let mallocClosure: u32 +@external("GRAIN$MODULE$runtime/malloc", "free") +declare function freeExt(closure: u32, ptr: u32): u32 +@external("GRAIN$MODULE$runtime/malloc", "GRAIN$EXPORT$free") +declare let freeClosure: u32 + export declare function incRef(ptr: u32): u32 export declare function decRef(ptr: u32): u32 +// @ts-ignore: decorator +@inline +export function malloc(nb: u32): u32 { + return mallocExt(mallocClosure, nb); +} + +// @ts-ignore: decorator +@inline +export function free(ptr: u32): u32 { + return freeExt(freeClosure, ptr); +} + export function calloc(nb: u32): u32 { const ret = malloc(nb) if (ret == -1) return ret diff --git a/stdlib/stdlib-external/runtime/malloc.ts b/stdlib/stdlib-external/runtime/malloc.ts deleted file mode 100644 index 500fd9e564..0000000000 --- a/stdlib/stdlib-external/runtime/malloc.ts +++ /dev/null @@ -1,266 +0,0 @@ -@external("memoryManager", "_malloc") -export declare function extMalloc(rawPtr: u32, bytes: u32): u32 -@external("memoryManager", "_free") -export declare function extFree(ptr: u32): u32 -@external("memoryManager", "_growHeap") -export declare function extGrowHeap(numPages: u32): u32 -@external("memoryManager", "_initialHeapSize") -export declare const initialHeapSize: u32 - -/* UNDERSTANDING THE STRUCTURE OF THE FREE LIST - * The original K&R definition for the free list entry type was the following: - * - * union header { - * struct { - * union header *ptr; - * unsigned size; - * } s; - * long x; // <- forces 8-byte alignment - * }; - * - * In memory, this is really just two ints (assuming we're working in 32-bit mode). - * As such, we manually lay out the entries in the heap as follows (note that we - * use helpers to facilitate accessing and setting these values): - * - * AS C Equivalent - * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - * let ptr === union header *ptr - * getNext(ptr) === ptr->s.ptr - * getSize(ptr) === ptr->s.size - */ - -/** - * Pointer to the start of the free list. This is always a multiple of - * 8, with the exception of its initial value (used as a sentinel). - */ -let freePtr: u32 = 1; - -/** - * Size (in bytes) of entries in the free list. - */ -let mallocHeaderSize: u32 = 8; - -/** - * log_2(mallocHeaderSize) (multiplication by the header - * size is equivalent to left-shifting by this amount) - */ -let logMallocHeaderSize: u32 = 3; - -/** - * The current size (in bytes) of the heap. - */ -let heapSize: u32 = 0; - -/** - * Requests that the heap be grown by the given number of bytes. - * - * @param {u32} nbytes - The number of bytes requested - * @return {u32} - If unsuccessful, -1. Otherwise, the pointer to the beginning of the extended region. - */ -export function growHeap(nbytes: u32): u32 { - nbytes = nbytes; - let reqSize: u32 = 0; - let reqResult: u32 = 0; - let origSize: u32 = 0; - origSize = heapSize; - // If the size has not been initialized, do so. - if (heapSize == 0) { - heapSize = initialHeapSize; - if (nbytes > heapSize) { - // More bytes requested than the initial heap size, - // so we need to request more anyway. - reqSize = nbytes - heapSize; - reqSize = reqSize >> 16; - reqSize = reqSize + 1; - reqResult = extGrowHeap(reqSize); - if (reqResult == -1) { - return -1; - } - heapSize += reqSize << 16; - } - return 0; - } else { - // The size has already been initialized, so call the external function. - reqSize = nbytes; - reqSize = reqSize >> 16; - reqSize = reqSize + 1; - reqResult = extGrowHeap(reqSize); - if (reqResult == -1) { - return -1; - } - heapSize += reqSize << 16; - } - return reqResult; -} - -@inline -function getNext(ptr: u32): u32 { - return load(ptr) -} - -@inline -function setNext(ptr: u32, val: u32): void { - store(ptr, val) -} - -@inline -function getSize(ptr: u32): u32 { - return load(ptr, 4) -} - -@inline -function setSize(ptr: u32, val: u32): void { - store(ptr, val, 4) -} - -/** - * Allocates the requested number of bytes, returning a pointer. - * - * @param nbytes {u32} - The number of bytes to allocate - * @return {u32} - The pointer to the allocated region (8-byte aligned), or -1 if the allocation failed. - */ -export function malloc(nb: u32): u32 { - // Add space for GC header - let nbytes: u32 = nb + 8; - let p: u32 = 0; - let prevp: u32 = 0; - let nunits: u32 = 0; - - // Set nbytes to the next multiple of mallocHeaderSize greater - // than the given size - nunits = (nbytes + mallocHeaderSize - 1) / mallocHeaderSize + 1; - nbytes = nunits << logMallocHeaderSize; // multiply by header size - - prevp = freePtr; - // Handle initialization - if (heapSize == 0) { - store(0, 0) - freePtr = 0; - prevp = 0; - store(4, 0) - } - // Search the freelist for any blocks large enough. - for (p = getNext(prevp); ; prevp = p, p = getNext(p)) { - let size = getSize(p); - if (size >= nbytes) { - // If this block is big enough, allocate from it. - if (size == nbytes) { - // It's exactly the right size! - setNext(prevp, getNext(p)); - } else { - // Shrink it as needed - let newSize = size - nbytes; - setSize(p, newSize) - p = p + newSize; - setSize(p, nbytes) - } - // Update the pointer to the free list. - freePtr = prevp; - - // Let runtime set up reference counting - // Address of the region past the malloc header - return extMalloc(p + 8, nb); - } - // We've reached the end of the free list. Time to grow the heap. - if (p == freePtr) { - // Attempt to grow the heap - p = morecore(nbytes); - // If growing the heap failed, return -1. - if (p == -1) { - // Error - return -1; - } - } - } - // Error - return -1; -} - -/** - * Asks the runtime for more heap memory. - * (if you can't tell from the fact that the name is reminiscient - * of the 1970s, the name of this function is taken from K&R). - * - * @param nbytes {u32} - The number of bytes to try to grow the heap by - * @return {u32} - If successful, a pointer to the start of the free list. If not successful, -1. - */ -export function morecore(nbytes: u32): u32 { - let cp: u32 = 0; - let up: u32 = 0; - - let origSize = heapSize; - - cp = growHeap(nbytes); - // If there was an error, return - if (cp == -1) { - return -1; - } - // Set the size of the new block to the amount the - // heap was grown. - let grownAmount = heapSize - origSize; - up = cp; - setSize(up, grownAmount); - // Call free() with the new block to add it to the free list. - // Add an additional 8 for the expected GC header - free(up + 8 + 8); - // Return the free list pointer. - return freePtr; -} - -/** - * Frees the given allocated pointer. - * - * @param ap {u32} - The pointer to free - */ -export function free(ap: u32): void { - // Let memory manager know we're freeing this pointer - extFree(ap); - - let blockPtr: u32 = ap - 16; // 8 bytes for malloc header + 8 bytes for GC header - let p: u32 = 0; - - // Edge case: for the first free (called by morecore), the free pointer - // is actually already pointing to this node, so we don't do anything. - if (blockPtr == freePtr) { - return; - } - - // Find the location to insert this block into the free list - for ( - p = freePtr; - !((blockPtr > p) && (blockPtr < getNext(p))); - p = getNext(p) - ) { - if ((p >= getNext(p)) && ((blockPtr > p) || (blockPtr < getNext(p)))) { - break; - } - } - - // Merge the block into the adjacent free list entry above, if needed - if (blockPtr + getSize(blockPtr) == getNext(p)) { - let next = getNext(p); - setSize(blockPtr, getSize(blockPtr) + getSize(next)) - setNext(blockPtr, getNext(next)) - } else { - setNext(blockPtr, getNext(p)) - } - // Merge the previous (adjacent) free list entry into this block, if needed - if (p + getSize(p) == blockPtr) { - setSize(p, getSize(p) + getSize(blockPtr)) - setNext(p, getNext(blockPtr)) - } else { - setNext(p, blockPtr) - } - // Set the free list head to this block - freePtr = p; -} - -/** - * Returns the current free list pointer - * (used for debugging) - * - * @return {u32} - The free list pointer - */ -export function getFreePtr(): u32 { - return freePtr; -}