diff --git a/rts/Makefile b/rts/Makefile index 481bdce8d5d..a2a21d8822e 100644 --- a/rts/Makefile +++ b/rts/Makefile @@ -177,6 +177,7 @@ mo-rts.wasm: $(RTS_RUST_WASM_O) $(RTS_WASM_O) $(TOMMATH_WASM_O) $(MUSL_WASM_O) $(WASM_LD) -o $@ \ --import-memory --shared --no-entry --gc-sections \ --export=__wasm_call_ctors \ + --export=memcpy \ --whole-archive \ $+ diff --git a/rts/bigint.c b/rts/bigint.c index 00ee1941acf..9af9e8e8c19 100644 --- a/rts/bigint.c +++ b/rts/bigint.c @@ -50,7 +50,7 @@ export void* mp_realloc(void *ptr, size_t old_size, size_t new_size) { if (new_size > FIELD(r, 1)) { void *newptr = mp_alloc(new_size); if (old_size != FIELD(r, 1)) bigint_trap(); - as_memcpy(newptr, ptr, old_size); + memcpy(newptr, ptr, old_size); return newptr; } else if (new_size == FIELD(r, 1)) { // No need to grow diff --git a/rts/motoko-rts/Cargo.toml b/rts/motoko-rts/Cargo.toml index 435fe343215..c3c2b244e4e 100644 --- a/rts/motoko-rts/Cargo.toml +++ b/rts/motoko-rts/Cargo.toml @@ -7,9 +7,19 @@ edition = "2018" [dependencies.libc] version = "0.2.73" -# added here so that it ends up in Cargo.lock, so that nix will pre-fetch it +# Added here so that it ends up in Cargo.lock, so that nix will pre-fetch it [dependencies.compiler_builtins] version = "0.1.32" +# Without this feature we get dozens of duplicate symbol errors when generating +# the final shared .wasm file: +# +# wasm-ld: error: duplicate symbol: __multi3 +# >>> defined in _build/wasm/libmotoko_rts.a(compiler_builtins-d709bd899857aa61.compiler_builtins.3abndchk-cgu.0.rcgu.o) +# >>> defined in _build/wasm/libmotoko_rts.a(compiler_builtins-06d1ead628e1f468.compiler_builtins.6moz1ltd-cgu.0.rcgu.o) +# +# It seems like we're linking multiple versions of compiler_builtins in the same +# shared library, which we should fix at some point. TODO +features = ["mangled-names"] [lib] crate-type = ["staticlib"] diff --git a/rts/motoko-rts/Xargo.toml b/rts/motoko-rts/Xargo.toml index 511af6a58fa..2fdd43a522b 100644 --- a/rts/motoko-rts/Xargo.toml +++ b/rts/motoko-rts/Xargo.toml @@ -3,5 +3,4 @@ stage = 0 [dependencies.compiler_builtins] stage = 1 -features = [ "mem" ] version = "0.1.32" diff --git a/rts/motoko-rts/src/alloc.rs b/rts/motoko-rts/src/alloc.rs new file mode 100644 index 00000000000..432fec3af74 --- /dev/null +++ b/rts/motoko-rts/src/alloc.rs @@ -0,0 +1,41 @@ +//! Implements allocation routines used by the generated code and the GC. + +use core::arch::wasm32; + +use crate::gc; +use crate::rts_trap_with; +use crate::types::{skew, Bytes, SkewedPtr, Words}; + +#[no_mangle] +unsafe extern "C" fn alloc_bytes(n: Bytes) -> SkewedPtr { + alloc_words(n.to_words()) +} + +#[no_mangle] +unsafe extern "C" fn alloc_words(n: Words) -> SkewedPtr { + let bytes = n.to_bytes(); + // Update ALLOCATED + gc::ALLOCATED += Bytes(bytes.0 as u64); + + // Update heap pointer + let old_hp = gc::HP; + let new_hp = old_hp + bytes.0; + gc::HP = new_hp; + + // Grow memory if needed + grow_memory(new_hp as usize); + + skew(old_hp as usize) +} + +/// Page allocation. Ensures that the memory up to the given pointer is allocated. +pub(crate) unsafe fn grow_memory(ptr: usize) { + let total_pages_needed = ((ptr / 65536) + 1) as i32; + let current_pages = wasm32::memory_size(0) as i32; + let new_pages_needed = total_pages_needed - current_pages; + if new_pages_needed > 0 { + if wasm32::memory_grow(0, new_pages_needed as usize) == core::usize::MAX { + rts_trap_with("Cannot grow memory\0".as_ptr()); + } + } +} diff --git a/rts/motoko-rts/src/gc.rs b/rts/motoko-rts/src/gc.rs new file mode 100644 index 00000000000..3998cdb4c58 --- /dev/null +++ b/rts/motoko-rts/src/gc.rs @@ -0,0 +1,402 @@ +use crate::alloc; +use crate::rts_trap_with; +use crate::types::*; + +extern "C" { + /// Get __heap_base. Provided by the code generator (src/codegen/compile.ml). + fn get_heap_base() -> u32; + + /// Skewed pointer to a skewed pointer to an array. See closure-table.c for details. + fn closure_table_loc() -> SkewedPtr; + + /// Get pointer to the static memory with an array to the static roots. Provided by the + /// generated code. + fn get_static_roots() -> SkewedPtr; +} + +/// Maximum live data retained in a GC. +static mut MAX_LIVE: Bytes = Bytes(0); + +/// Amount of garbage collected so far. +static mut RECLAIMED: Bytes = Bytes(0); + +/// Counter for total allocations +pub(crate) static mut ALLOCATED: Bytes = Bytes(0); + +/// Heap pointer +pub(crate) static mut HP: u32 = 0; + +#[no_mangle] +unsafe extern "C" fn init() { + HP = get_heap_base() as u32; +} + +unsafe fn note_live_size(live: Bytes) { + MAX_LIVE = ::core::cmp::max(MAX_LIVE, live); +} + +#[no_mangle] +unsafe extern "C" fn get_max_live_size() -> Bytes { + MAX_LIVE +} + +unsafe fn note_reclaimed(reclaimed: Bytes) { + RECLAIMED += Bytes(reclaimed.0 as u64); +} + +#[no_mangle] +unsafe extern "C" fn get_reclaimed() -> Bytes { + RECLAIMED +} + +#[no_mangle] +unsafe extern "C" fn get_total_allocations() -> Bytes { + ALLOCATED +} + +#[no_mangle] +unsafe extern "C" fn get_heap_size() -> Bytes { + Bytes(HP - get_heap_base()) +} + +/// Returns object size in words +unsafe fn object_size(obj: usize) -> Words { + let obj = obj as *const Obj; + match (*obj).tag { + TAG_OBJECT => { + let object = obj as *const Object; + let size = (*object).size; + size_of::() + Words(size) + } + + TAG_OBJ_IND => size_of::(), + + TAG_ARRAY => { + let array = obj as *const Array; + let size = (*array).len; + size_of::() + Words(size) + } + + TAG_BITS64 => Words(3), + + TAG_MUTBOX => size_of::(), + + TAG_CLOSURE => { + let closure = obj as *const Closure; + let size = (*closure).size; + size_of::() + Words(size) + } + + TAG_SOME => size_of::(), + + TAG_VARIANT => size_of::(), + + TAG_BLOB => { + let blob = obj as *const Blob; + size_of::() + (*blob).len.to_words() + } + + TAG_FWD_PTR => { + rts_trap_with("object_size: forwarding pointer\0".as_ptr()); + } + + TAG_BITS32 => Words(2), + + TAG_BIGINT => size_of::(), + + TAG_CONCAT => size_of::(), + + _ => { + rts_trap_with("object_size: invalid object tag\0".as_ptr()); + } + } +} + +fn is_tagged_scalar(p: SkewedPtr) -> bool { + p.0 & 0b1 == 0 +} + +unsafe fn memcpy_words(to: usize, from: usize, n: Words) { + libc::memcpy(to as *mut _, from as *const _, n.to_bytes().0 as usize); +} + +unsafe fn memcpy_bytes(to: usize, from: usize, n: Bytes) { + libc::memcpy(to as *mut _, from as *const _, n.0 as usize); +} + +/// Evacuate (copy) an object in from-space to to-space, update end_to_space. If the object was +/// already evacuated end_to_space is not changed. +/// +/// Arguments: +/// +/// - begin_from_space: Where the dynamic heap starts. Used for two things: +/// +/// - An object is static if its address is below this value. These objects either don't point to +/// dynamic heap, or listed in static_roots array. Objects in static_roots are scavenged +/// separately in `evac_static_roots` below. So we skip these objects here. +/// +/// - After all objects are evacuated we move to-space to from-space, to be able to do that the +/// pointers need to point to their (eventual) locations in from-space, which is calculated with +/// `end_to_space - begin_to_space + begin_from_space`. +/// +/// - begin_to_space: Where to-space starts. See above for how this is used. +/// +/// - end_to_space: Where the object in `ptr_loc` will be copied. +/// +/// - ptr_loc: Location of the object to evacuate, e.g. an object field address. +/// +unsafe fn evac( + begin_from_space: usize, + begin_to_space: usize, + end_to_space: &mut usize, + ptr_loc: usize, +) { + // Field holds a skewed pointer to the object to evacuate + let ptr_loc = ptr_loc as *mut SkewedPtr; + + if is_tagged_scalar(*ptr_loc) { + return; + } + + // Ignore static objects, they can't point to dynamic heap + if (*ptr_loc).unskew() < begin_from_space { + return; + } + + let obj = (*ptr_loc).unskew() as *mut Obj; + + // Update the field if the object is already evacauted + if (*obj).tag == TAG_FWD_PTR { + let fwd = (*(obj as *const FwdPtr)).fwd; + *ptr_loc = fwd; + return; + } + + let obj_size = object_size(obj as usize); + let obj_size_bytes = obj_size.to_bytes(); + + // Grow memory if needed + alloc::grow_memory(*end_to_space + obj_size_bytes.0 as usize); + + // Copy object to to-space + memcpy_words(*end_to_space, obj as usize, obj_size); + + // Final location of the object after copying to-space back to from-space + let obj_loc = (*end_to_space - begin_to_space) + begin_from_space; + + // Set forwarding pointer + let fwd = obj as *mut FwdPtr; + (*fwd).header.tag = TAG_FWD_PTR; + (*fwd).fwd = skew(obj_loc); + + // Update evacuated field + *ptr_loc = skew(obj_loc); + + // Update end of to-space + *end_to_space += obj_size_bytes.0 as usize +} + +/// Evacuate a blob payload pointed by a bigint. bigints are special in that a bigint's first field +/// is an internal pointer: it points to the _payload_ of a blob object, instead of skewedly pointing to the object start +/// +/// - `ptr_loc`: Address of a `data_ptr` field of a BigInt (see types.rs). Points to payload of a +/// blob. See types.rs for blob layout. +unsafe fn evac_bigint_blob( + begin_from_space: usize, + begin_to_space: usize, + end_to_space: &mut usize, + ptr_loc: *mut usize, // address of field with a pointer to a blob payload +) { + let blob_payload_addr = *ptr_loc; + + // Get blob object from the payload + let mut blob_obj_addr = skew(blob_payload_addr - size_of::().0 as usize); + // Create a temporary field to the blob object, to be passed to `evac`. + let blob_obj_addr_field = &mut blob_obj_addr; + let blob_obj_addr_field_ptr = blob_obj_addr_field as *mut _; + + evac( + begin_from_space, + begin_to_space, + end_to_space, + blob_obj_addr_field_ptr as usize, + ); + + // blob_obj_addr_field now has the new location of the blob, get the payload address + let blob_new_addr = (*blob_obj_addr_field).unskew(); + let blob_new_payload_addr = blob_new_addr + 2 * (WORD_SIZE as usize); + + // Update evacuated field + *ptr_loc = blob_new_payload_addr; // not skewed! +} + +unsafe fn scav( + begin_from_space: usize, + begin_to_space: usize, + end_to_space: &mut usize, + obj: usize, +) { + let obj = obj as *const Obj; + + match (*obj).tag { + TAG_OBJECT => { + let obj = obj as *const Object; + let obj_payload = obj.payload_addr(); + for i in 0..(*obj).size as isize { + evac( + begin_from_space, + begin_to_space, + end_to_space, + obj_payload.offset(i) as usize, + ); + } + } + + TAG_ARRAY => { + let array = obj as *const Array; + let array_payload = array.payload_addr(); + for i in 0..(*array).len as isize { + evac( + begin_from_space, + begin_to_space, + end_to_space, + array_payload.offset(i) as usize, + ); + } + } + + TAG_MUTBOX => { + let mutbox = obj as *mut MutBox; + let field_addr = ((&mut (*mutbox).field) as *mut _) as usize; + evac(begin_from_space, begin_to_space, end_to_space, field_addr); + } + + TAG_CLOSURE => { + let closure = obj as *const Closure; + let closure_payload = closure.payload_addr(); + for i in 0..(*closure).size as isize { + evac( + begin_from_space, + begin_to_space, + end_to_space, + closure_payload.offset(i) as usize, + ); + } + } + + TAG_SOME => { + let some = obj as *mut Some; + let field_addr = ((&mut (*some).field) as *mut _) as usize; + evac(begin_from_space, begin_to_space, end_to_space, field_addr); + } + + TAG_VARIANT => { + let variant = obj as *mut Variant; + let field_addr = ((&mut (*variant).field) as *mut _) as usize; + evac(begin_from_space, begin_to_space, end_to_space, field_addr); + } + + TAG_BIGINT => { + let bigint = obj as *mut BigInt; + let data_ptr_addr = (&mut (*bigint).data_ptr) as *mut _; + + evac_bigint_blob( + begin_from_space, + begin_to_space, + end_to_space, + data_ptr_addr, + ); + } + + TAG_CONCAT => { + let concat = obj as *mut Concat; + let field1_addr = ((&mut (*concat).text1) as *mut _) as usize; + evac(begin_from_space, begin_to_space, end_to_space, field1_addr); + let field2_addr = ((&mut (*concat).text2) as *mut _) as usize; + evac(begin_from_space, begin_to_space, end_to_space, field2_addr); + } + + TAG_OBJ_IND => { + let obj_ind = obj as *mut ObjInd; + let field_addr = ((&mut (*obj_ind).field) as *mut _) as usize; + evac(begin_from_space, begin_to_space, end_to_space, field_addr); + } + + TAG_BITS64 | TAG_BITS32 | TAG_BLOB => { + // These don't include pointers, skip + } + + TAG_FWD_PTR | _ => { + // Any other tag is a bug + rts_trap_with("invalid object tag in scav\0".as_ptr()); + } + } +} + +// We have a special evacuation routine for "static roots" array: we don't evacuate elements of +// "static roots", we just scavenge them. +unsafe fn evac_static_roots( + begin_from_space: usize, + begin_to_space: usize, + end_to_space: &mut usize, + roots: *const Array, +) { + // The array and the objects pointed by the array are all static so we don't evacuate them. We + // only evacuate fields of objects in the array. + for i in 0..(*roots).len { + let obj = roots.get(i); + scav(begin_from_space, begin_to_space, end_to_space, obj.unskew()); + } +} + +/// The entry point. Called by the generated code. +#[no_mangle] +unsafe extern "C" fn collect() { + let begin_from_space = get_heap_base() as usize; + let end_from_space = HP as usize; + let begin_to_space = end_from_space; + let mut end_to_space = begin_to_space; + + let static_roots = get_static_roots().unskew() as *const Array; + + // Evacuate roots + evac_static_roots( + begin_from_space, + begin_to_space, + &mut end_to_space, + static_roots, + ); + + evac( + begin_from_space, + begin_to_space, + &mut end_to_space, + closure_table_loc().unskew(), + ); + + // Scavenge to-space + let mut p = begin_to_space; + while p < end_to_space { + // NB: end_to_space keeps changing within this loop + scav(begin_from_space, begin_to_space, &mut end_to_space, p); + p += object_size(p).to_bytes().0 as usize; + } + + // Note the stats + let new_live_size = end_to_space - begin_to_space; + note_live_size(Bytes(new_live_size as u32)); + + let reclaimed = (end_from_space - begin_from_space) - (end_to_space - begin_to_space); + note_reclaimed(Bytes(reclaimed as u32)); + + // Copy to-space to the beginning of from-space + memcpy_bytes( + begin_from_space, + begin_to_space, + Bytes((end_to_space - begin_to_space) as u32), + ); + + // Reset the heap pointer + let new_hp = begin_from_space + (end_to_space - begin_to_space); + HP = new_hp as u32; +} diff --git a/rts/motoko-rts/src/lib.rs b/rts/motoko-rts/src/lib.rs index 63433bd1563..8fba91a50ab 100644 --- a/rts/motoko-rts/src/lib.rs +++ b/rts/motoko-rts/src/lib.rs @@ -2,6 +2,11 @@ //! utilities. #![no_std] +#![feature(arbitrary_self_types)] + +mod alloc; +mod gc; +mod types; extern "C" { pub(crate) fn rts_trap_with(msg: *const u8) -> !; diff --git a/rts/motoko-rts/src/types.rs b/rts/motoko-rts/src/types.rs new file mode 100644 index 00000000000..0c4b79eda26 --- /dev/null +++ b/rts/motoko-rts/src/types.rs @@ -0,0 +1,219 @@ +use core::ops::{Add, AddAssign}; + +pub fn size_of() -> Words { + Bytes(::core::mem::size_of::() as u32).to_words() +} + +pub const WORD_SIZE: u32 = 4; + +/// The unit "words": `Words(123u32)` means 123 words. +#[repr(C)] +#[derive(PartialEq, Eq, Clone, Copy, PartialOrd, Ord)] +pub struct Words(pub A); + +impl Words { + pub fn to_bytes(self) -> Bytes { + Bytes(self.0 * WORD_SIZE) + } +} + +impl> Add for Words { + type Output = Self; + + fn add(self, rhs: Self) -> Self::Output { + Words(self.0 + rhs.0) + } +} + +impl AddAssign for Words { + fn add_assign(&mut self, rhs: Self) { + self.0 += rhs.0; + } +} + +impl From> for Words { + fn from(bytes: Bytes) -> Words { + bytes.to_words() + } +} + +/// The unit "bytes": `Bytes(123u32)` means 123 bytes. +#[repr(C)] +#[derive(PartialEq, Eq, Clone, Copy, PartialOrd, Ord)] +pub struct Bytes(pub A); + +impl Bytes { + // Rounds up + pub fn to_words(self) -> Words { + // Rust issue for adding ceiling_div: https://github.com/rust-lang/rfcs/issues/2844 + Words((self.0 + WORD_SIZE - 1) / WORD_SIZE) + } +} + +impl> Add for Bytes { + type Output = Self; + + fn add(self, rhs: Self) -> Self::Output { + Bytes(self.0 + rhs.0) + } +} + +impl AddAssign for Bytes { + fn add_assign(&mut self, rhs: Self) { + self.0 += rhs.0; + } +} + +impl From> for Bytes { + fn from(words: Words) -> Bytes { + words.to_bytes() + } +} + +#[repr(C)] +#[derive(Clone, Copy)] +pub struct SkewedPtr(pub usize); + +impl SkewedPtr { + pub fn unskew(self) -> usize { + self.0.wrapping_add(1) + } +} + +pub fn skew(ptr: usize) -> SkewedPtr { + SkewedPtr(ptr.wrapping_sub(1)) +} + +// NOTE: We don't create an enum for tags as we can never assume to do exhaustive pattern match on +// tags, because of heap corruptions and other bugs (in the code generator or RTS, or maybe because +// of an unsafe API usage). +pub type Tag = u32; + +pub const TAG_OBJECT: Tag = 1; +pub const TAG_OBJ_IND: Tag = 2; +pub const TAG_ARRAY: Tag = 3; +pub const TAG_BITS64: Tag = 5; +pub const TAG_MUTBOX: Tag = 6; +pub const TAG_CLOSURE: Tag = 7; +pub const TAG_SOME: Tag = 8; +pub const TAG_VARIANT: Tag = 9; +pub const TAG_BLOB: Tag = 10; +pub const TAG_FWD_PTR: Tag = 11; +pub const TAG_BITS32: Tag = 12; +pub const TAG_BIGINT: Tag = 13; +pub const TAG_CONCAT: Tag = 14; + +// Common parts of any object. Other object pointers can be coerced into a pointer to this. +#[repr(C)] +pub struct Obj { + pub tag: Tag, +} + +#[repr(C)] +#[rustfmt::skip] +pub struct Array { + pub header: Obj, + pub len: u32, // number of elements + + // Array elements follow, each u32 sized. We can't have variable-sized structs in Rust so we + // can't add a field here for the elements. + // https://doc.rust-lang.org/nomicon/exotic-sizes.html +} + +impl Array { + pub unsafe fn payload_addr(self: *const Self) -> *const SkewedPtr { + self.offset(1) as *const SkewedPtr // skip array header + } + + pub unsafe fn get(self: *const Self, idx: u32) -> SkewedPtr { + let slot_addr = self.payload_addr() as usize + (idx * WORD_SIZE) as usize; + *(slot_addr as *const SkewedPtr) + } +} + +#[repr(C)] +pub struct Object { + pub header: Obj, + pub size: u32, + pub hash_ptr: u32, // Pointer to static information about object field labels. Not important + // for GC (does not contain pointers). +} + +impl Object { + pub unsafe fn payload_addr(self: *const Self) -> *const SkewedPtr { + self.offset(1) as *const SkewedPtr // skip object header + } +} + +#[repr(C)] +pub struct ObjInd { + pub header: Obj, + pub field: SkewedPtr, +} + +#[repr(C)] +pub struct Closure { + pub header: Obj, + pub funid: u32, + pub size: u32, // number of elements + // other stuff follows ... +} + +impl Closure { + pub unsafe fn payload_addr(self: *const Self) -> *const SkewedPtr { + self.offset(1) as *const SkewedPtr // skip closure header + } +} + +#[repr(C)] +pub struct Blob { + pub header: Obj, + pub len: Bytes, + // data follows .. +} + +/// A forwarding pointer placed by the GC in place of an evacuated object. +#[repr(C)] +pub struct FwdPtr { + pub header: Obj, + pub fwd: SkewedPtr, +} + +#[repr(C)] +pub struct BigInt { + pub header: Obj, + // the data following now must describe the `mp_int` struct + // (https://github.com/libtom/libtommath/blob/44ee82cd34d0524c171ffd0da70f83bba919aa38/tommath.h#L174-L179) + pub size: u32, + pub alloc: u32, + pub sign: u32, + // Unskewed pointer to a blob payload. data_ptr - 2 (words) gives us the blob header. + pub data_ptr: usize, +} + +#[repr(C)] +pub struct MutBox { + pub header: Obj, + pub field: SkewedPtr, +} + +#[repr(C)] +pub struct Some { + pub header: Obj, + pub field: SkewedPtr, +} + +#[repr(C)] +pub struct Variant { + pub header: Obj, + pub tag: u32, + pub field: SkewedPtr, +} + +#[repr(C)] +pub struct Concat { + pub header: Obj, + pub n_bytes: u32, + pub text1: SkewedPtr, + pub text2: SkewedPtr, +} diff --git a/rts/principal.c b/rts/principal.c index ccd9192aa41..ef620cca907 100644 --- a/rts/principal.c +++ b/rts/principal.c @@ -186,7 +186,7 @@ export blob_t blob_of_principal(text_t t) { rts_trap_with("blob_of_principal: principal too short"); } blob_t stripped = alloc_blob(BLOB_LEN(bytes) - 4); - as_memcpy(BLOB_PAYLOAD(stripped), BLOB_PAYLOAD(bytes) + 4, BLOB_LEN(bytes) - 4); + memcpy(BLOB_PAYLOAD(stripped), BLOB_PAYLOAD(bytes) + 4, BLOB_LEN(bytes) - 4); // check encoding blob_t expected = principal_of_blob(stripped); if (blob_compare(b0, expected) != 0) { diff --git a/rts/rts.c b/rts/rts.c index a65c9c4b27a..8210870afb2 100644 --- a/rts/rts.c +++ b/rts/rts.c @@ -12,12 +12,6 @@ char *alloc(size_t n) { return (char *)&FIELD(r,2); } -export void as_memcpy(char *str1, const char *str2, size_t n) { - for (size_t i = 0; i < n; i++) { - str1[i] = str2[i]; - } -} - export int as_memcmp(const char *str1, const char *str2, size_t n) { for (size_t i = 0; i < n; i++) { if (str1[i] != str2[i]) @@ -36,8 +30,8 @@ void __attribute__ ((noreturn)) trap_with_prefix(const char* prefix, const char int len1 = as_strlen(prefix); int len2 = as_strlen(str); char msg[len1 + len2]; - as_memcpy(msg, prefix, len1); - as_memcpy(msg + len1, str, len2); + memcpy(msg, prefix, len1); + memcpy(msg + len1, str, len2); rts_trap(msg, len1 + len2); } diff --git a/rts/rts.h b/rts/rts.h index 9d6aa210556..b4ace6a589c 100644 --- a/rts/rts.h +++ b/rts/rts.h @@ -84,7 +84,6 @@ from_rts __attribute__ ((noreturn)) void rts_trap(const char* str, size_t n); from_rts __attribute__ ((noreturn)) void bigint_trap(); /** Functions used in multiple modules of the RTS */ -export void as_memcpy(char *str1, const char *str2, size_t n); export int as_memcmp(const char *str1, const char *str2, size_t n); export size_t as_strlen(const char *str1); diff --git a/rts/text.c b/rts/text.c index 5c8cbff32f4..a927cf4d17a 100644 --- a/rts/text.c +++ b/rts/text.c @@ -54,7 +54,7 @@ static blob_t alloc_text_blob(size_t n) { // Create export text_t text_of_ptr_size(const char *buf, size_t n) { as_ptr r = alloc_text_blob(n); - as_memcpy(BLOB_PAYLOAD(r), buf, n); + memcpy(BLOB_PAYLOAD(r), buf, n); return r; } @@ -75,8 +75,8 @@ export text_t text_concat(text_t s1, text_t s2) { // short texts are copied into a single blob if (n < MIN_CONCAT_SIZE) { as_ptr r = alloc_text_blob(n1 + n2); - as_memcpy(BLOB_PAYLOAD(r), BLOB_PAYLOAD(s1), n1); - as_memcpy(BLOB_PAYLOAD(r) + n1, BLOB_PAYLOAD(s2), n2); + memcpy(BLOB_PAYLOAD(r), BLOB_PAYLOAD(s1), n1); + memcpy(BLOB_PAYLOAD(r) + n1, BLOB_PAYLOAD(s2), n2); return r; } // Check max size @@ -106,7 +106,7 @@ export void text_to_buf(text_t s, char *buf) { crumb *next_crumb = NULL; // what do do after we are done with s while (true) { if (TAG(s) == TAG_BLOB) { - as_memcpy(buf, BLOB_PAYLOAD(s), BLOB_LEN(s)); + memcpy(buf, BLOB_PAYLOAD(s), BLOB_LEN(s)); // return if we are done if (next_crumb == NULL) return; diff --git a/rts/utf8_valid.c b/rts/utf8_valid.c index 40ee982da1d..18a5a55c1eb 100644 --- a/rts/utf8_valid.c +++ b/rts/utf8_valid.c @@ -76,7 +76,7 @@ utf8_check(const char *src, size_t len, size_t *cursor) { if (cur == end) break; buf[0] = buf[1] = buf[2] = buf[3] = 0; - as_memcpy((char *)buf, (const char *)cur, end - cur); + memcpy((char *)buf, (const char *)cur, end - cur); p = (const unsigned char *)buf; } else { p = cur; diff --git a/src/codegen/compile.ml b/src/codegen/compile.ml index 0c61da14291..3fea4bc49b3 100644 --- a/src/codegen/compile.ml +++ b/src/codegen/compile.ml @@ -341,12 +341,6 @@ module E = struct let add_global32 (env : t) name mut init = add_global32_delayed env name mut init - let add_global64 (env : t) name mut init = - add_global env name (Lib.Promise.make_fulfilled ( - nr { gtype = GlobalType (I64Type, mut); - value = nr (G.to_instr_list (G.i (Const (nr (Wasm.Values.I64 init))))) - })) - let get_global (env : t) name : int32 = match NameEnv.find_opt name !(env.global_names) with | Some gi -> gi @@ -718,7 +712,7 @@ end (* Func *) module RTS = struct (* The connection to the C parts of the RTS *) let system_imports env = - E.add_func_import env "rts" "as_memcpy" [I32Type; I32Type; I32Type] []; + E.add_func_import env "rts" "memcpy" [I32Type; I32Type; I32Type] [I32Type]; (* standard libc memcpy *) E.add_func_import env "rts" "as_memcmp" [I32Type; I32Type; I32Type] [I32Type]; E.add_func_import env "rts" "version" [] [I32Type]; E.add_func_import env "rts" "parse_idl_header" [I32Type; I32Type; I32Type; I32Type] []; @@ -768,7 +762,6 @@ module RTS = struct E.add_func_import env "rts" "remember_closure" [I32Type] [I32Type]; E.add_func_import env "rts" "recall_closure" [I32Type] [I32Type]; E.add_func_import env "rts" "closure_count" [] [I32Type]; - E.add_func_import env "rts" "closure_table_loc" [] [I32Type]; E.add_func_import env "rts" "closure_table_size" [] [I32Type]; E.add_func_import env "rts" "blob_of_text" [I32Type] [I32Type]; E.add_func_import env "rts" "text_compare" [I32Type; I32Type] [I32Type]; @@ -805,6 +798,14 @@ module RTS = struct E.add_func_import env "rts" "char_is_lowercase" [I32Type] [I32Type]; E.add_func_import env "rts" "char_is_uppercase" [I32Type] [I32Type]; E.add_func_import env "rts" "char_is_alphabetic" [I32Type] [I32Type]; + E.add_func_import env "rts" "get_max_live_size" [] [I32Type]; + E.add_func_import env "rts" "get_reclaimed" [] [I64Type]; + E.add_func_import env "rts" "collect" [] []; + E.add_func_import env "rts" "alloc_bytes" [I32Type] [I32Type]; + E.add_func_import env "rts" "alloc_words" [I32Type] [I32Type]; + E.add_func_import env "rts" "get_total_allocations" [] [I64Type]; + E.add_func_import env "rts" "get_heap_size" [] [I32Type]; + E.add_func_import env "rts" "init" [] []; () end (* RTS *) @@ -820,123 +821,27 @@ module Heap = struct let get_heap_base env = G.i (GlobalGet (nr (E.get_global env "__heap_base"))) - (* We keep track of the end of the used heap in this global, and bump it if - we allocate stuff. This is the actual memory offset, not-skewed yet *) - let get_heap_ptr env = - G.i (GlobalGet (nr (E.get_global env "end_of_heap"))) - let set_heap_ptr env = - G.i (GlobalSet (nr (E.get_global env "end_of_heap"))) - let get_skewed_heap_ptr env = get_heap_ptr env ^^ compile_add_const ptr_skew - let register_globals env = (* end-of-heap pointer, we set this to __heap_base upon start *) - E.add_global32 env "end_of_heap" Mutable 0xDEADBEEFl; - - (* counter for total allocations *) - E.add_global64 env "allocations" Mutable 0L; - - (* counter for total reclaimed bytes *) - E.add_global64 env "reclaimed" Mutable 0L; - - (* counter for max live bytes *) - E.add_global64 env "max_live" Mutable 0L - - let count_allocations env = - (* assumes number of allocated bytes on the stack *) - G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^ - G.i (GlobalGet (nr (E.get_global env "allocations"))) ^^ - G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^ - G.i (GlobalSet (nr (E.get_global env "allocations"))) + E.add_global32 env "end_of_heap" Mutable 0xDEADBEEFl let get_total_allocation env = - G.i (GlobalGet (nr (E.get_global env "allocations"))) - - let add_reclaimed env = - (* assumes number of reclaimed bytes on the stack *) - G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^ - G.i (GlobalGet (nr (E.get_global env "reclaimed"))) ^^ - G.i (Binary (Wasm.Values.I64 I64Op.Add)) ^^ - G.i (GlobalSet (nr (E.get_global env "reclaimed"))) + E.call_import env "rts" "get_total_allocations" let get_reclaimed env = - G.i (GlobalGet (nr (E.get_global env "reclaimed"))) + E.call_import env "rts" "get_reclaimed" let get_memory_size = G.i MemorySize ^^ compile_mul_const page_size - let note_live_size env = - (* assumes size of live set on the stack *) - let (set_live_size, get_live_size) = new_local env "live_size" in - set_live_size ^^ - get_live_size ^^ G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^ - G.i (GlobalGet (nr (E.get_global env "max_live"))) ^^ - G.i (Compare (Wasm.Values.I64 I64Op.LtU)) ^^ - G.if_ [] G.nop begin - get_live_size ^^ G.i (Convert (Wasm.Values.I64 I64Op.ExtendUI32)) ^^ - G.i (GlobalSet (nr (E.get_global env "max_live"))) - end - let get_max_live_size env = - G.i (GlobalGet (nr (E.get_global env "max_live"))) - - - (* Page allocation. Ensures that the memory up to the given unskewed pointer is allocated. *) - let grow_memory env = - Func.share_code1 env "grow_memory" ("ptr", I32Type) [] (fun env get_ptr -> - let (set_pages_needed, get_pages_needed) = new_local env "pages_needed" in - get_ptr ^^ compile_divU_const page_size ^^ - compile_add_const 1l ^^ - G.i MemorySize ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - set_pages_needed ^^ - - (* Check that the new heap pointer is within the memory *) - get_pages_needed ^^ - compile_unboxed_zero ^^ - G.i (Compare (Wasm.Values.I32 I32Op.GtS)) ^^ - G.if_ [] - ( get_pages_needed ^^ - G.i MemoryGrow ^^ - (* Check result *) - compile_unboxed_zero ^^ - G.i (Compare (Wasm.Values.I32 I32Op.LtS)) ^^ - E.then_trap_with env "Cannot grow memory." - ) G.nop - ) - - let dyn_alloc_words env = G.i (Call (nr (E.built_in env "alloc_words"))) - let dyn_alloc_bytes env = G.i (Call (nr (E.built_in env "alloc_bytes"))) + E.call_import env "rts" "get_max_live_size" - let declare_alloc_functions env = - (* Dynamic allocation *) - Func.define_built_in env "alloc_words" [("n", I32Type)] [I32Type] (fun env -> - (* expects the size (in words), returns the skewed pointer *) - let get_n = G.i (LocalGet (nr 0l)) in - (* return the current pointer (skewed) *) - get_skewed_heap_ptr env ^^ - - (* Count allocated bytes *) - get_n ^^ compile_mul_const word_size ^^ - count_allocations env ^^ - - (* Update heap pointer *) - get_heap_ptr env ^^ - get_n ^^ compile_mul_const word_size ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - set_heap_ptr env ^^ - - (* grow memory if needed *) - get_heap_ptr env ^^ grow_memory env - ); - Func.define_built_in env "alloc_bytes" [("n", I32Type)] [I32Type] (fun env -> - let get_n = G.i (LocalGet (nr 0l)) in - (* Round up to next multiple of the word size and convert to words *) - get_n ^^ - compile_add_const 3l ^^ - compile_divU_const word_size ^^ - dyn_alloc_words env - ) + let dyn_alloc_words env = + E.call_import env "rts" "alloc_words" + let dyn_alloc_bytes env = + E.call_import env "rts" "alloc_bytes" (* Static allocation (always words) (uses dynamic allocation for smaller and more readable code) *) @@ -994,27 +899,22 @@ module Heap = struct (* Convenience functions related to memory *) (* Copying bytes (works on unskewed memory addresses) *) - let memcpy env = E.call_import env "rts" "as_memcpy" + let memcpy env = E.call_import env "rts" "memcpy" ^^ G.i Drop (* Comparing bytes (works on unskewed memory addresses) *) let memcmp env = E.call_import env "rts" "as_memcmp" - (* Copying words (works on skewed memory addresses) *) - let memcpy_words_skewed env = - Func.share_code3 env "memcpy_words_skewed" (("to", I32Type), ("from", I32Type), ("n", I32Type)) [] (fun env get_to get_from get_n -> - get_n ^^ - from_0_to_n env (fun get_i -> - get_to ^^ - get_i ^^ compile_mul_const word_size ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ + let register env = + let get_heap_base_fn = E.add_fun env "get_heap_base" (Func.of_body env [] [I32Type] (fun env -> + get_heap_base env + )) in - get_from ^^ - get_i ^^ compile_mul_const word_size ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - load_ptr ^^ + E.add_export env (nr { + name = Wasm.Utf8.decode "get_heap_base"; + edesc = nr (FuncExport (nr get_heap_base_fn)) + }) - store_ptr - ) - ) + let get_heap_size env = + E.call_import env "rts" "get_heap_size" end (* Heap *) @@ -1068,7 +968,6 @@ module ClosureTable = struct let recall env : G.t = E.call_import env "rts" "recall_closure" let count env : G.t = E.call_import env "rts" "closure_count" let size env : G.t = E.call_import env "rts" "closure_table_size" - let root env : G.t = E.call_import env "rts" "closure_table_loc" end (* ClosureTable *) module Bool = struct @@ -1227,10 +1126,10 @@ module Tagged = struct | Some (* For opt *) | Variant | Blob - | Indirection + (* | FwdPtr -- Only used by the GC *) | Bits32 (* Contains a 32 bit unsigned number *) | BigInt - | Concat (* String concatenation, used by rts/text.c *) + (* | Concat -- String concatenation, used by rts/text.c *) | StableSeen (* Marker that we have seen this thing before *) (* Let's leave out tag 0 to trap earlier on invalid memory *) @@ -1244,10 +1143,8 @@ module Tagged = struct | Some -> 8l | Variant -> 9l | Blob -> 10l - | Indirection -> 11l | Bits32 -> 12l | BigInt -> 13l - | Concat -> 14l | StableSeen -> 0xffffffffl (* The tag *) @@ -1278,12 +1175,6 @@ module Tagged = struct set_tag ^^ go cases - (* like branch_default but the tag is known statically *) - let branch env retty = function - | [] -> G.i Unreachable - | [_, code] -> G.i Drop ^^ code - | (_, code) :: cases -> branch_default env retty code cases - (* like branch_default but also pushes the scrutinee on the stack for the * branch's consumption *) let _branch_default_with env retty def cases = @@ -2878,9 +2769,6 @@ module Text = struct This is internal to rts/text.c, with the exception of GC-related code. *) - let concat_field1 = Int32.add Tagged.header_size 1l - let concat_field2 = Int32.add Tagged.header_size 2l - let of_ptr_size env = E.call_import env "rts" "text_of_ptr_size" let concat env = @@ -3345,7 +3233,7 @@ module Dfinity = struct G.i (Call (nr (E.built_in env "init"))) ^^ (* Collect garbage *) - G.i (Call (nr (E.built_in env "collect"))) ^^ + E.call_import env "rts" "collect" ^^ Lifecycle.trans env Lifecycle.Idle ) in @@ -3382,7 +3270,7 @@ module Dfinity = struct Lifecycle.trans env Lifecycle.InPostUpgrade ^^ G.i (Call (nr (E.built_in env "post_exp"))) ^^ Lifecycle.trans env Lifecycle.Idle ^^ - G.i (Call (nr (E.built_in env "collect"))) + E.call_import env "rts" "collect" )) in E.add_export env (nr { @@ -3511,15 +3399,6 @@ end (* Dfinity *) module RTS_Exports = struct let system_exports env = - Heap.declare_alloc_functions env; - E.add_export env (nr { - name = Wasm.Utf8.decode "alloc_bytes"; - edesc = nr (FuncExport (nr (E.built_in env "alloc_bytes"))) - }); - E.add_export env (nr { - name = Wasm.Utf8.decode "alloc_words"; - edesc = nr (FuncExport (nr (E.built_in env "alloc_words"))) - }); let bigint_trap_fi = E.add_fun env "bigint_trap" ( Func.of_body env [] [] (fun env -> E.trap_with env "bigint function error" @@ -3543,157 +3422,6 @@ module RTS_Exports = struct end (* RTS_Exports *) - -module HeapTraversal = struct - (* Returns the object size (in words) *) - let object_size env = - Func.share_code1 env "object_size" ("x", I32Type) [I32Type] (fun env get_x -> - get_x ^^ - Tagged.branch env [I32Type] - [ Tagged.Bits64, - compile_unboxed_const 3l - ; Tagged.Bits32, - compile_unboxed_const 2l - ; Tagged.BigInt, - compile_unboxed_const 5l (* HeapTag + sizeof(mp_int) *) - ; Tagged.Some, - compile_unboxed_const 2l - ; Tagged.Variant, - compile_unboxed_const 3l - ; Tagged.ObjInd, - compile_unboxed_const 2l - ; Tagged.MutBox, - compile_unboxed_const 2l - ; Tagged.Array, - get_x ^^ - Heap.load_field Arr.len_field ^^ - compile_add_const Arr.header_size - ; Tagged.Blob, - get_x ^^ - Heap.load_field Blob.len_field ^^ - compile_add_const 3l ^^ - compile_divU_const Heap.word_size ^^ - compile_add_const Blob.header_size - ; Tagged.Object, - get_x ^^ - Heap.load_field Object.size_field ^^ - compile_add_const Object.header_size - ; Tagged.Closure, - get_x ^^ - Heap.load_field Closure.len_field ^^ - compile_add_const Closure.header_size - ; Tagged.Concat, - compile_unboxed_const 4l - ] - (* Indirections have unknown size. *) - ) - - let walk_heap_from_to env compile_from compile_to mk_code = - let (set_x, get_x) = new_local env "x" in - compile_from ^^ set_x ^^ - compile_while - (* While we have not reached the end of the area *) - ( get_x ^^ - compile_to ^^ - G.i (Compare (Wasm.Values.I32 I32Op.LtU)) - ) - ( mk_code get_x ^^ - get_x ^^ - get_x ^^ object_size env ^^ compile_mul_const Heap.word_size ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - set_x - ) - - let for_each_array_elem env get_array mk_code = - get_array ^^ - Heap.load_field Arr.len_field ^^ - from_0_to_n env (fun get_i -> - mk_code ( - get_array ^^ - get_i ^^ - Arr.idx env - ) - ) - - (* Calls mk_code for each pointer in the object pointed to by get_x, - passing code get the address of the pointer, - and code to get the offset of the pointer (for the BigInt payload field). *) - let for_each_pointer env get_x mk_code mk_code_offset = - let (set_ptr_loc, get_ptr_loc) = new_local env "ptr_loc" in - let code = mk_code get_ptr_loc in - let code_offset = mk_code_offset get_ptr_loc in - get_x ^^ - Tagged.branch_default env [] G.nop - [ Tagged.MutBox, - get_x ^^ - compile_add_const (Int32.mul Heap.word_size MutBox.field) ^^ - set_ptr_loc ^^ - code - ; Tagged.BigInt, - get_x ^^ - compile_add_const (Int32.mul Heap.word_size 4l) ^^ - set_ptr_loc ^^ - code_offset Blob.unskewed_payload_offset - ; Tagged.Some, - get_x ^^ - compile_add_const (Int32.mul Heap.word_size Opt.payload_field) ^^ - set_ptr_loc ^^ - code - ; Tagged.Variant, - get_x ^^ - compile_add_const (Int32.mul Heap.word_size Variant.payload_field) ^^ - set_ptr_loc ^^ - code - ; Tagged.ObjInd, - get_x ^^ - compile_add_const (Int32.mul Heap.word_size 1l) ^^ - set_ptr_loc ^^ - code - ; Tagged.Array, - for_each_array_elem env get_x (fun get_elem_ptr -> - get_elem_ptr ^^ - set_ptr_loc ^^ - code - ) - ; Tagged.Object, - get_x ^^ - Heap.load_field Object.size_field ^^ - - from_0_to_n env (fun get_i -> - get_i ^^ - compile_add_const Object.header_size ^^ - compile_mul_const Heap.word_size ^^ - get_x ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - set_ptr_loc ^^ - code - ) - ; Tagged.Closure, - get_x ^^ - Heap.load_field Closure.len_field ^^ - - from_0_to_n env (fun get_i -> - get_i ^^ - compile_add_const Closure.header_size ^^ - compile_mul_const Heap.word_size ^^ - get_x ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - set_ptr_loc ^^ - code - ) - ; Tagged.Concat, - get_x ^^ - compile_add_const (Int32.mul Heap.word_size Text.concat_field1) ^^ - set_ptr_loc ^^ - code ^^ - get_x ^^ - compile_add_const (Int32.mul Heap.word_size Text.concat_field2) ^^ - set_ptr_loc ^^ - code - ] - -end (* HeapTraversal *) - module Serialization = struct (* The general serialization strategy is as follows: @@ -4937,195 +4665,17 @@ module Stabilization = struct end module GC = struct - (* This is a very simple GC: - It copies everything live to the to-space beyond the bump pointer, - then it memcpies it back, over the from-space (so that we still neatly use - the beginning of memory). - - Roots are: - * All objects in the static part of the memory. - * the closure_table (see module ClosureTable) - *) - - let gc_enabled = true - - (* If the pointer at ptr_loc points after begin_from_space, copy - to after end_to_space, and replace it with a pointer, adjusted for where - the object will be finally. *) - (* Returns the new end of to_space *) - (* Invariant: Must not be called on the same pointer twice. *) - (* All pointers, including ptr_loc and space end markers, are skewed *) - - let evacuate_common env - get_obj update_ptr - get_begin_from_space get_begin_to_space get_end_to_space - = - - let (set_len, get_len) = new_local env "len" in - - (* If this is static, ignore it *) - get_obj ^^ - get_begin_from_space ^^ - G.i (Compare (Wasm.Values.I32 I32Op.LtU)) ^^ - G.if_ [] (get_end_to_space ^^ G.i Return) G.nop ^^ - - (* If this is an indirection, just use that value *) - get_obj ^^ - Tagged.branch_default env [] G.nop [ - Tagged.Indirection, - update_ptr (get_obj ^^ Heap.load_field 1l) ^^ - get_end_to_space ^^ G.i Return - ] ^^ - - (* Get object size *) - get_obj ^^ HeapTraversal.object_size env ^^ set_len ^^ - - (* Grow memory if needed *) - get_end_to_space ^^ - get_len ^^ compile_mul_const Heap.word_size ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - Heap.grow_memory env ^^ - - (* Copy the referenced object to to space *) - get_obj ^^ HeapTraversal.object_size env ^^ set_len ^^ - - get_end_to_space ^^ get_obj ^^ get_len ^^ Heap.memcpy_words_skewed env ^^ - - let (set_new_ptr, get_new_ptr) = new_local env "new_ptr" in - - (* Calculate new pointer *) - get_end_to_space ^^ - get_begin_to_space ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - get_begin_from_space ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - set_new_ptr ^^ - - (* Set indirection *) - get_obj ^^ - Tagged.(store Indirection) ^^ - get_obj ^^ - get_new_ptr ^^ - Heap.store_field 1l ^^ - - (* Update pointer *) - update_ptr get_new_ptr ^^ - - (* Calculate new end of to space *) - get_end_to_space ^^ - get_len ^^ compile_mul_const Heap.word_size ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) - - (* Used for normal skewed pointers *) - let evacuate env = Func.share_code4 env "evacuate" (("begin_from_space", I32Type), ("begin_to_space", I32Type), ("end_to_space", I32Type), ("ptr_loc", I32Type)) [I32Type] (fun env get_begin_from_space get_begin_to_space get_end_to_space get_ptr_loc -> - - let get_obj = get_ptr_loc ^^ load_ptr in - - (* If this is an unboxed scalar, ignore it *) - get_obj ^^ - BitTagged.if_tagged_scalar env [] (get_end_to_space ^^ G.i Return) G.nop ^^ - - let update_ptr new_val_code = - get_ptr_loc ^^ new_val_code ^^ store_ptr in - - evacuate_common env - get_obj update_ptr - get_begin_from_space get_begin_to_space get_end_to_space - ) - - (* A variant for pointers that point into the payload (used for the bignum objects). - These are never scalars. *) - let evacuate_offset env offset = - let name = Printf.sprintf "evacuate_offset_%d" (Int32.to_int offset) in - Func.share_code4 env name (("begin_from_space", I32Type), ("begin_to_space", I32Type), ("end_to_space", I32Type), ("ptr_loc", I32Type)) [I32Type] (fun env get_begin_from_space get_begin_to_space get_end_to_space get_ptr_loc -> - let get_obj = get_ptr_loc ^^ load_ptr ^^ compile_sub_const offset in - - let update_ptr new_val_code = - get_ptr_loc ^^ new_val_code ^^ compile_add_const offset ^^ store_ptr in - - evacuate_common env - get_obj update_ptr - get_begin_from_space get_begin_to_space get_end_to_space - ) let register env static_roots = - Func.define_built_in env "get_heap_size" [] [I32Type] (fun env -> - Heap.get_heap_ptr env ^^ - Heap.get_heap_base env ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Sub)) - ); - - Func.define_built_in env "collect" [] [] (fun env -> - if not gc_enabled then G.nop else - - (* Copy all roots. *) - let (set_begin_from_space, get_begin_from_space) = new_local env "begin_from_space" in - let (set_begin_to_space, get_begin_to_space) = new_local env "begin_to_space" in - let (set_end_to_space, get_end_to_space) = new_local env "end_to_space" in - - Heap.get_heap_base env ^^ compile_add_const ptr_skew ^^ set_begin_from_space ^^ - let get_end_from_space = get_begin_to_space in - Heap.get_skewed_heap_ptr env ^^ set_begin_to_space ^^ - Heap.get_skewed_heap_ptr env ^^ set_end_to_space ^^ - - - (* Common arguments for evacuate *) - let evac get_ptr_loc = - get_begin_from_space ^^ - get_begin_to_space ^^ - get_end_to_space ^^ - get_ptr_loc ^^ - evacuate env ^^ - set_end_to_space in - - let evac_offset get_ptr_loc offset = - get_begin_from_space ^^ - get_begin_to_space ^^ - get_end_to_space ^^ - get_ptr_loc ^^ - evacuate_offset env offset ^^ - set_end_to_space in - - (* Go through the roots, and evacuate them *) - HeapTraversal.for_each_array_elem env (compile_unboxed_const static_roots) (fun get_elem_ptr -> - let (set_static, get_static) = new_local env "static_obj" in - get_elem_ptr ^^ load_ptr ^^ set_static ^^ - HeapTraversal.for_each_pointer env get_static evac evac_offset - ) ^^ - evac (ClosureTable.root env) ^^ - - (* Go through the to-space, and evacuate that. - Note that get_end_to_space changes as we go, but walk_heap_from_to can handle that. - *) - HeapTraversal.walk_heap_from_to env - get_begin_to_space - get_end_to_space - (fun get_x -> HeapTraversal.for_each_pointer env get_x evac evac_offset) ^^ - - (* Note some stats *) - get_end_to_space ^^ get_begin_to_space ^^ G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - Heap.note_live_size env ^^ - - get_end_from_space ^^ get_begin_from_space ^^ G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - get_end_to_space ^^ get_begin_to_space ^^ G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - Heap.add_reclaimed env ^^ - - (* Copy the to-space to the beginning of memory. *) - get_begin_from_space ^^ compile_add_const ptr_unskew ^^ - get_begin_to_space ^^ compile_add_const ptr_unskew ^^ - get_end_to_space ^^ get_begin_to_space ^^ G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - Heap.memcpy env ^^ - (* Reset the heap pointer *) - get_begin_from_space ^^ compile_add_const ptr_unskew ^^ - get_end_to_space ^^ get_begin_to_space ^^ G.i (Binary (Wasm.Values.I32 I32Op.Sub)) ^^ - G.i (Binary (Wasm.Values.I32 I32Op.Add)) ^^ - Heap.set_heap_ptr env - ) + let get_static_roots = E.add_fun env "get_static_roots" (Func.of_body env [] [I32Type] (fun env -> + compile_unboxed_const static_roots + )) in - let get_heap_size env = - G.i (Call (nr (E.built_in env "get_heap_size"))) + E.add_export env (nr { + name = Wasm.Utf8.decode "get_static_roots"; + edesc = nr (FuncExport (nr get_static_roots)) + }) let store_static_roots env = Arr.vanilla_lit env (E.get_static_roots env) @@ -5536,7 +5086,7 @@ module FuncDec = struct let message_cleanup env sort = match sort with | Type.Shared Type.Write -> - G.i (Call (nr (E.built_in env "collect"))) ^^ + E.call_import env "rts" "collect" ^^ Lifecycle.trans env Lifecycle.Idle | Type.Shared Type.Query -> Lifecycle.trans env Lifecycle.PostQuery @@ -7180,7 +6730,7 @@ and compile_exp (env : E.t) ae exp = | OtherPrim "rts_heap_size", [] -> SR.Vanilla, - GC.get_heap_size env ^^ Prim.prim_word32toNat env + Heap.get_heap_size env ^^ Prim.prim_word32toNat env | OtherPrim "rts_memory_size", [] -> SR.Vanilla, @@ -7196,7 +6746,7 @@ and compile_exp (env : E.t) ae exp = | OtherPrim "rts_max_live_size", [] -> SR.Vanilla, - Heap.get_max_live_size env ^^ BigNum.from_word64 env + Heap.get_max_live_size env ^^ BigNum.from_word32 env | OtherPrim "rts_callback_table_count", [] -> SR.Vanilla, @@ -8021,13 +7571,14 @@ and conclude_module env start_fi_o = let set_heap_base = E.add_global32_delayed env "__heap_base" Immutable in E.export_global env "__heap_base"; + Heap.register env; GC.register env static_roots; set_heap_base (E.get_end_of_static_memory env); (* Wrap the start function with the RTS initialization *) let rts_start_fi = E.add_fun env "rts_start" (Func.of_body env [] [] (fun env1 -> - Heap.get_heap_base env ^^ Heap.set_heap_ptr env ^^ + E.call_import env "rts" "init" ^^ match start_fi_o with | Some fi -> G.i (Call fi)