@@ 2,140 2,13 @@
""""compiler.pilot.arcmem
=====================
- arcmem (short for "atomic reference counted memory" or "archivable memory")
- is a backwards compatible heap scheme with integrated memory and
- resource management, enabling applications to safely and efficiently process
- and serialize memory and host resources. arcmem is agnostic to application-
- specific schemas and types, merely requiring pointer locations in memory
- to be tagged.
-
- arcmem allocates in dynamic-array-friendly exp2-sized chunks; the resulting
- allocations are segregated by -- and aligned to -- size, which permits to
- recover the starting address of an allocation from an arbitrary address
- within its range merely by masking out its least significant bits, and gives
- rise to safe pointers that act as array iterators within their allocation.
-
- Each allocation is atomically reference counted and supported by a 1:64
- byte shadow bitmap that tags pointer locations, so that allocations can be
- efficiently and agnostically scanned for dependencies.
-
- The persistence policy of arcmem ensures that, as long as threads agree that
- only uniquely held allocations may be written to, threads may concurrently
- share data and perform single threaded copy-on-write operations on it.
-
- The ability to share references and to tell for any heap address which other
- addresses are reachable from there elevates the heap to a true acyclic
- digraph structure, permitting us to eagerly (and lazily) free unused
- resources, as well as de/serialize (and make copies of) allocations and
- their dependencies.
-
- Finally, function pointers tagged as handlers, which can be placed at any
- point within an allocation, permit us to manage foreign resources such as
- memory maps and file- or GPU-memory handles even within inlined
- heterogeneous structures, decoupling allocation from resource management
- entirely.
-
-#
- future optimizations / improvements:
-
- * hangles should be registered with arcmem prior to their use, and
- referenced by index, so that hangles can be redirected and thunked,
- and we can store more options with them, such as security levels,
- how they're serialized, and so on.
-
- * guard against refcount overflow
-
- * ASAN: we need to capture the stack at the time of important operations
- so we can help with diagnosis; within UVM, this is not a problem because
- we have safety guarantees, but that is only when everything works -
- when it doesn't, we need to know what failed where.
-
- * use empty u64 in header to store requested allocation size (unless we
- can think of something better to put there); the benefit of a clear
- allocation size is that we can safely automate digraph serialization and
- hashing independent of user data structures, without transferring
- cruft or exposing implementation details; take, for instance, two
- arcmem implementations that differ in the amount of space reserved for
- the header; trading data back and forth, allocations are going to get
- larger and larger - so it helps here to know how much memory was
- actually reserved.
- we need to reuse the size/bits slot to queue the allocation for deletion,
- so at the time that we start scanning, we lose the exact size info;
- so scanning has to be performed conservatively, though since we just
- check bits, that's not much of a loss, since it increases the overhead
- from 1/64 to at most 1/32, which is still pretty good.
-
- * use remaining bits of u64 in header for flags:
- * persistence flag that prevents writes
- * unique flag that prevents sharing
- * burn out flag that prevents an allocation from being reused
- after 2^21 allocations (see further down)
-
- * for bitmaps hosted in allocations, header has flag whether allocation has
- bitmap or not; we can clear the bitmap and reuse the allocation.
- primary advantage: save on scanning and memory, drop bitmap and
- instantly gain more memory. -- however, would always require checking
- if this is an allocation with or without bitmaps.
-
- * making a mutable shared value threadsafe involves making a real copy;
- all mutable sub-elements then also need to be deep-copied; but the
- persistent elements can just be shared. this is automatable at thread
- boundaries; once we've filtered a value this way, it is safe. the
- user can easily control the amount of work performed by tagging values
- as persistent.
- generally this whole approach can be summed up as a smart copy-by-value
- that avoids making a real copy when the referenced value is persistent.
- however where we're not as smart is in making just one copy for multiple
- pointers.
-
- * the arc serializer does not reproduce the offset of the root pointer, but
- loads the entire object. either don't allow offset pointers to be
- passed, or fix that.
-
- * arcdedup: deduplicate all nodes in digraph; will clear all soft pointers
- that point out of the graph.
-
- * offer deduplication on serialization.
+using import .lib
# 0 = nothing
# 1 = major heap events
# 2 = everything
VERBOSITY := 0
-# when uncommented, a breakpoint will be hit when this allocation is being freed
-#TRACE_PTR_FREE := 0x400000000a0:u64
-# when uncommented, a breakpoint will be hit when this allocation is being created
-#TRACE_PTR_ALLOC := 0x44000000000:u64
-# when uncommented, a breakpoint will be hit when this allocation is being shared
-#TRACE_PTR_SHARE := 0x400000000a0:u64
-
-# aggressive integrity check; checks integrity of the heap at every junction.
- enabling this setting will slow down performance to a crawl.
-USE_AIC := false
-
-# on alloc, clear allocations with deterministic garbage (BADF00DBADC0FFEE)
-USE_ALLOC_GARBAGE := true
-# on free, clear allocations with deterministic garbage; arcmem-check will
- include a check that verifies no stray writes have been performed in
- unallocated regions; however, when this is turned on, it becomes harder
- to pinpoint release count mismatches.
-USE_FREE_GARBAGE := true
-
-# we use versioned allocations to implement soft (weak) pointers rather than
- refcounting, which allows us to reuse an allocation right away rather
- than waiting for the last soft pointer to vanish, reduces the number of
- atomic operations required to drop a pointer, permits to invalidate
- weak references just on the grounds of a mutation and removes all header
- operations on soft pointers, making their duplication free. upgrading
- a versioned soft pointer is no more involved than a refcounted one.
- the pointer can be offset relative to the mmap base address,
- guaranteeing 21 bits for tagging in the soft pointer. that is sufficient
- to keep a soft pointer stable for all but every ~ 2 million-nth
- reallocation; another option could be to regard a slot reaching its
- allocation maximum as "burned out", and move it to the back of the
- queue. at 60 allocations per second, an allocation would be burned out
- after about 9 hours. we could control this by flag.
-
arc@ := sc_pointer_type void pointer-flag-managed 'arc
type softarc@ : intptr
@@ 234,11 107,13 @@ spice arcpointer-compatible? (T)
run-stage;
-using import struct print format C.stdio C.mman C.errno C.string enum bitset
+#using import struct print format C.stdio C.mman C.errno C.string enum bitset
\ hash
-from (import itertools) let iterbits
+#using import struct print format enum bitset hash
+#from (import itertools) let iterbits
+using import print struct format hash
-using import .bitmem
+#using import .bitmem
arclog := static-if (VERBOSITY < 2)
pass
@@ 249,430 124,78 @@ arclog1 := static-if (VERBOSITY < 1)
else
report
-page-size := 4096:usize
-min-align-bits := 4
-min-align := 1:usize << min-align-bits
-
-pool-min-size-bits := 5 # 32 bytes = 16 bytes + header
-pool-max-size-bits := 37 # log2 of size of largest pool (presently 128 GB)
-pool-index-bits := 5
-pool-count := pool-max-size-bits - pool-min-size-bits
-pool-offset-mask := (1:u64 << pool-count) - 1
-# ensure pool count fits mask
-static-assert (pool-count <= (1 << pool-index-bits))
-
-pool-min-size := 1:usize << pool-min-size-bits
-
-pointer-size := sizeof voidstar
-pointer-bitcount := bitcountof intptr
-
-inline incptr (ptr bytes)
- inttoptr ((ptrtoint (view ptr) intptr) + bytes) voidstar
-inline diffptr (a b)
- (ptrtoint (view a) intptr) - (ptrtoint (view b) intptr)
-
-# round S to the next power of 2 and return the log2 of it.
-inline... logsize (S : usize)
- (findmsb (S - 1)) + 1
-
-# determine the correct capacity bits that fit the requested size
-inline... best-capacity-bits (size : usize)
- logsize (max size pool-min-size)
-
-inline capacity-bits-poolid (bits)
- bits - pool-min-size-bits
-
-pool-size := 1:u64 << pool-max-size-bits
-pool-index-mask := (1:u64 << pool-index-bits) - 1
-pointer-bits-needed := pool-max-size-bits + pool-index-bits
-# any more and it will be difficult to get the mmap for it
-static-assert (pointer-bits-needed <= 45)
-pool-capacity := pool-size * pool-count
-
-inline iptr-poolid (p)
- p := storagecast (view p)
- (p >> pool-max-size-bits) & pool-index-mask
-
-inline ptr-poolid (p)
- p := ptrtoint (view p) intptr
- iptr-poolid p
-
-inline ptr-capacity-bits (p)
- (iptr-poolid p) + pool-min-size-bits
-
-inline ptr-mask (p)
- pool-min-size << (iptr-poolid p)
-
-# active bits used in a pointer
-pointer-mask := -1:u64 >> 16
-
-version-bits := 21
-version-mask := (1:u64 << version-bits) - 1
-soft-pointer-bits := 63 - version-bits # bit 63 is used for soft pointer flag
-soft-pointer-mask := -1:u64 >> (version-bits + 1)
-
-# stored in upper bits of Header.version
-# prevent sharing
-flag-unique := 1:u32 << 31
-flag-bits := flag-unique
-
-# Header is for live allocations, FreeList for dead ones;
-
- both headers use the same location for each allocation, at the tail of it;
- that way, if the application writes past an object, it will destroy the
- object's own metadata.
-struct Header plain
- hard : i32
- version : u32
- # used for storing size when alive, as well as temporary drop stack when
- dead; points to next object to be dropped.
- the last two bytes are unused / used by the pointer bitmap
- _size_or_next : intptr
-
- inline both (self)
- (& self.hard) as ~@u64
-
- inline flags (self)
- self.version & flag-bits
-
- # only safe to use outside of dropping structure
- inline size (self)
- self._size_or_next & pointer-mask
- # only safe to use within arcmalloc
- inline setsize (self size)
- self._size_or_next = (size & pointer-mask) | (self._size_or_next & ~pointer-mask)
-
- # only safe to use while dropping structure (which is single-threaded)
- inline nextptr (self)
- inttoptr (self._size_or_next & pointer-mask) voidstar
- inline setnextptr (self ptr)
- self._size_or_next = ((ptrtoint ptr intptr) & pointer-mask) | (self._size_or_next & ~pointer-mask)
-
-header-size := sizeof Header
-header-unused-bytes := 2:usize
-header-align := alignof Header
-
-static-assert (header-align <= pointer-size)
-
-#if this fails, you must adjust pool-min-size-bits
-static-assert (header-size < (1 << pool-min-size-bits))
-header-used-bytes := header-size - header-unused-bytes
-inline ptr-mask-capacity (m)
- # real available space
- cap := m - header-used-bytes
- # subtract required bitmap space and truncate unaligned bytes
- (cap * pointer-bitcount // (pointer-bitcount + 1)) & -header-align
-inline ptr-mask-bitmap-offset (m)
- (ptr-mask-capacity m) + header-used-bytes
-inline ptr-capacity (p)
- p := storagecast (view p)
- ptr-mask-capacity (ptr-mask p)
-
-# we pick an address above the bits we need for the mapping; pointer. if we
- failed to reliably get this address range, we could try multiples of it and
- it won't affect pointer-basing (but it will be more costly overall -
- so fixed is most performant.)
-
- this address scheme also has the benefit that the top bit above the pointer
- bits is always set, which helps with objectid encoding.
-mmap-address := 1:u64 << pointer-bits-needed
-
-mmap-size := pool-capacity
-
-bit63 := 0x8000000000000000:u64
-bit62 := 0x4000000000000000:u64
-
-soft-bit := bit63
-handler-bit := bit62
-both-by-one := 0x0000000100000001:u64
-hard-minus-soft-plus := 0xffffffff:u64
-
-# for a pool, the number of free allocations
-FreeRootSet := u64
-num-free-roots := bitcountof FreeRootSet
+inline arcptr? (ptr)
+ (arcptrkind (ptrtoint ptr intptr)) == ArcKindHard
-enum HangleMethod : i32
- # free resource associated with the handle; The return value must be null.
- Drop
- # encode the handle to duplicable form, e.g. an arbitrary host-dependent
- value or arcpointer (e.g. a C namespace symbol that can be used to
- retrieve the function using dlsym) and possibly rewrite the handle into
- canonical form.
- Encode
- # in-place decode the handle from duplicable form
- may possibly create the handle from canonical form.
- `self` is still in encoded form and must be replaced with a function
- pointer (e.g. to the function itself). The return value must be null.
- Decode
- # in-place duplicate the handle; if the method is not supported, the
- function should simply return false, and its Encode/Decode methods
- will be called instead.
- Copy
-
-HanglePointer := @intptr
-
-# receives pointer to the drop function itself, located within the arcpointer
- fn handler (method self)
-HangleFunction := @ (function bool HangleMethod HanglePointer)
-
-inline arcptr? (p)
- addr := ptrtoint p intptr
- (addr - mmap-address) < pool-capacity
-
-# test increment
-#fold (x = 0x1:usize) for i in (range pool-count)
- print x "->" /..
- k := getpoolid x
- cap := poolid-capacity k
- print "" cap (/p k)
- k2 := getpoolid cap
- assert (cap >= x)
- assert (k2 == k)
- (cap + 1)
-#print (getpoolid pool-size)
-#print (getpoolid (pool-size - 1))
-
-inline mapping-failed? (ptr)
- (ptrtoint ptr usize) == -1:usize
-
-inline bigendian32 (x)
- x := ((x & 0xff00ff00:u32) >> 8:u32) | ((x & 0x00ff00ff:u32) << 8:u32)
- x := ((x & 0xffff0000:u32) >> 16:u32) | ((x & 0x0000ffff:u32) << 16:u32)
-
-inline bigendian64 (x)
- x := ((x & 0xff00ff00ff00ff00:u64) >> 8:u64) | ((x & 0x00ff00ff00ff00ff:u64) << 8:u64)
- x := ((x & 0xffff0000ffff0000:u64) >> 16:u64) | ((x & 0x0000ffff0000ffff:u64) << 16:u64)
- x := ((x & 0xffffffff00000000:u64) >> 32:u64) | ((x & 0x00000000ffffffff:u64) << 32:u64)
-
-uninitialized-u32 := bigendian32 0xcacacaca:u32
-uninitialized-u64 := bigendian64 0xbadf00dbadc0ffee:u64
-
-# purposefully chosen so that `hard` would be negative in an object header.
-free-list-magic := uninitialized-u32
-
-struct FreeList plain
- magic : u32 = free-list-magic
- # overlaps with version field
- version : u32
- # points to base address; last 2 bytes are unused
- next : intptr
-
-static-assert ((sizeof FreeList) == (sizeof Header))
+inline nativeptr? (ptr)
+ switch (arcptrkind (ptrtoint ptr intptr))
+ pass ArcKindHard
+ pass ArcKindUnmanaged
+ do true
+ default false
-struct Pool plain
- size : usize
- # pool size rounded to the next unprotected page
- page_size : usize
- # points to base address
- first : intptr
-
-inline iptr-base (p)
- cap := ptr-mask p
- p & -cap
-inline iptr-base-offset (p)
- bp := iptr-base p
- bp, p - bp
-inline ptr-base (p)
- p := ptrtoint p intptr
- inttoptr (iptr-base p) voidstar
-inline ptr-base-offset (p)
- p := ptrtoint p intptr
- base offset := iptr-base-offset p
- inttoptr base voidstar, offset
+#inline ptr-soft? (ptr)
+ (arcptrkind (ptrtoint ptr intptr)) == ArcKindSoft
-# compute the memory offset in bits to the bit that designates whether this
- pointer overlaps with an address stored in memory
-inline ptr-bitptr-floor (p)
- p := ptrtoint (view p) intptr
- cap := ptr-mask p
- offset := p & (cap - 1)
- (p - offset + (ptr-mask-bitmap-offset cap)) * 8 + offset // pointer-size
-inline ptr-bitptr-ceil (p)
- p := ptrtoint (view p) intptr
- cap := ptr-mask p
- offset := p & (cap - 1)
- (p - offset + (ptr-mask-bitmap-offset cap)) * 8 + (offset + pointer-size - 1) // pointer-size
-inline bitptr-ptr (b)
- # the bitmap is within the same allocation, so we can find the base address
- p := b // 8 # convert to byte position
- cap := ptr-mask p
- offset := p & (cap - 1)
- base := p - offset
- bbase := (base + (ptr-mask-bitmap-offset cap)) * 8
- bmoffset := (b - bbase) * pointer-size
- inttoptr (base + bmoffset) voidstar
-
-inline... ptr-range (ptr : voidstar, size : usize)
- pass ptr
- inttoptr
- (ptrtoint ptr intptr) + size
- voidstar
-inline gen-ptr-bitptr-range (f0 f1)
- inline... "ptr-bitptr-range"
- case (p0 : voidstar, p1 : voidstar)
- f0 p0, f1 p1
- case (ptr : voidstar, size : usize)
- p0 p1 := ptr-range ptr size
- f0 p0, f1 p1
-# include partially overlapping pointers
-ptr-bitptr-range-outer := gen-ptr-bitptr-range ptr-bitptr-floor ptr-bitptr-ceil
-# exclude partially overlapping pointers
-ptr-bitptr-range-inner := gen-ptr-bitptr-range ptr-bitptr-ceil ptr-bitptr-floor
-# include left partial overlap, exclude right partial overlap
-ptr-bitptr-range := gen-ptr-bitptr-range ptr-bitptr-floor ptr-bitptr-floor
-
-inline iptr-soft? (p)
- (bitcast p i64) < 0:i64
-inline ptr-soft? (p)
- iptr-soft? (ptrtoint p i64)
-inline ptr-handler? (p)
- ((ptrtoint p intptr) & handler-bit) != 0
-inline ptr-harden (p)
- version := (p >> soft-pointer-bits) & version-mask
- p := (p & soft-pointer-mask) + mmap-address
- inttoptr p voidstar, version
-inline ptr-soften (p version)
- p := (ptrtoint (view p) intptr) - mmap-address
- assert (p <= soft-pointer-mask)
- assert (version <= version-mask)
- p | (version as u64 << soft-pointer-bits) | soft-bit
+inline ptr-base-offset (ptr)
+ addr := ptrtoint (view ptr) intptr
+ baseaddr := arcbase addr
+ offset := addr - baseaddr
+ pass baseaddr offset
inline elementsizeof (T)
sizeof (elementof T)
-inline ptr-aligned-H (p T)
- p := ptrtoint (view p) intptr
- cap := ptr-capacity p
- inttoptr (p + cap) ~@T, cap
-# for an object-aligned pointer address, get the header
-inline ptr-aligned-header (p)
- ptr-aligned-H p Header
-# for an object-aligned pointer address, get the freelist
-inline ptr-aligned-freelist (p)
- ptr-aligned-H p FreeList
-
-inline ptr-aligned-object-size (p)
- h := ptr-aligned-header (view p)
- ('size @h) as usize
-
-inline ptr-object-size (p)
- p := view p
- if (not arcptr? p)
- return 0:usize
- ptr-aligned-object-size (ptr-base p)
+inline seekptr (ptr f)
+ ptr := deref ptr
+ T := qualifiersof ptr
+ baseaddr offset := ptr-base-offset ptr
+ newaddr := f T baseaddr offset
+ if (view? T)
+ dest := alloca (viewof uniqueintptr T)
+ store newaddr (bitcast dest ~@intptr)
+ deref (bitcast& @dest T)
+ else
+ lose ptr
+ inttoptr newaddr T
inline first (p)
- p := deref p
- T := typeof p
- p := ptrtoint p uniqueintptr
- m := ptr-mask p
- inttoptr (p & (bitcast -m uniqueintptr)) T
+ seekptr p
+ inline (T baseaddr offset) baseaddr
inline end (p)
- p := deref p
- sz := ptr-object-size p
- T := typeof p
- p := ptrtoint p uniqueintptr
- m := ptr-mask p
- ET := elementsizeof T
- p := p & (bitcast -m uniqueintptr)
- inttoptr
- p + (bitcast sz uniqueintptr)
- T
+ seekptr p
+ inline (T baseaddr offset)
+ baseaddr + (arcsize (inttoptr baseaddr voidstar))
inline last (p)
- p := deref p
- T := typeof p
- p := ptrtoint (end p) uniqueintptr
- ET := elementsizeof T
- p := p - (bitcast ET uniqueintptr)
- inttoptr p T
-
-inline lastcap (p)
- p := deref p
- T := typeof p
- p := ptrtoint p uniqueintptr
- m := ptr-mask p
- ET := elementsizeof T
- p := p & (bitcast -m uniqueintptr)
- inttoptr
- p +
- bitcast ((ptr-mask-capacity m) - ET) uniqueintptr
- T
+ seekptr p
+ inline (T baseaddr offset)
+ baseaddr + (arcsize (inttoptr baseaddr voidstar)) - (elementsizeof T)
-inline seek (P d)
- P := deref P
- sz := ptr-object-size P
- T := typeof P
- p := ptrtoint (view P) intptr
- m := ptr-mask p
- ET := (elementsizeof T) * (d as usize)
- offset := p & (m - 1)
- if ((offset + ET) >= sz)
- static-if (view? P)
- nullof T
- else
- bitcast (nullof voidstar) T
- else
- inttoptr ((ptrtoint P uniqueintptr) + (bitcast ET uniqueintptr)) T
-
-inline seekcap (P d)
- P := deref P
- T := typeof P
- p := ptrtoint (view P) intptr
- m := ptr-mask p
- ET := (elementsizeof T) * (d as usize)
- offset := p & (m - 1)
- if ((offset + ET) >= (ptr-mask-capacity m))
- static-if (view? P)
- nullof T
- else
- bitcast (nullof voidstar) T
- else
- inttoptr ((ptrtoint P uniqueintptr) + (bitcast ET uniqueintptr)) T
+inline seek (p d)
+ seekptr p
+ inline (T baseaddr offset)
+ sz := arcsize (inttoptr baseaddr voidstar)
+ newofs := offset + (elementsizeof T) * (d as usize)
+ if (newofs >= sz)
+ nullof intptr
+ else
+ baseaddr + newofs
inline seek% (p d s)
- p := deref p
- sz := ptr-object-size p
- T := typeof p
- p := ptrtoint p uniqueintptr
- poffset := storagecast (view p)
- m := ptr-mask poffset
- ETsz := elementsizeof T
- ET := ETsz * (d as usize)
- base := p & (bitcast -m uniqueintptr)
- h := static-if (none? s) sz
- else
- min sz (s * ETsz)
- newoffset := poffset - (storagecast (view base)) + ET
- inttoptr
- base +
- bitcast
- mod (newoffset as i64) (h as i64)
- uniqueintptr
- T
-
-inline seekcap% (p d s)
- p := deref p
- T := typeof p
- p := ptrtoint p uniqueintptr
- poffset := storagecast (view p)
- m := ptr-mask poffset
- ETsz := elementsizeof T
- ET := ETsz * (d as usize)
- base := p & (bitcast -m uniqueintptr)
- h := ptr-mask-capacity m
- h := static-if (none? s) h
- else
- min h (s * ETsz)
- newoffset := poffset - (storagecast (view base)) + ET
- inttoptr
- base +
- bitcast
- mod (newoffset as i64) (h as i64)
- uniqueintptr
- T
+ seekptr p
+ inline (T baseaddr offset)
+ sz := arcsize (inttoptr baseaddr voidstar)
+ ETsz := elementsizeof T
+ ET := ETsz * (d as usize)
+ h := static-if (none? s) sz
+ else
+ min sz (s * ETsz)
+ newoffset := offset + ET
+ baseaddr +
+ (mod (newoffset as i64) (h as i64)) as intptr
inline prev (p)
seek p -1
@@ 686,114 209,66 @@ inline prev% (p s)
inline next% (p s)
seek% p 1 s
+inline first (p)
+ seekptr p
+ inline (T baseaddr offset) baseaddr
+
inline tell (p)
p := deref (view p)
T := typeof p
- p := ptrtoint (view p) intptr
- m := ptr-mask p
ET := elementsizeof T
- (p & (m - 1)) // ET
+ __ offset := ptr-base-offset p
+ offset // ET
inline rtell (p)
p := deref (view p)
- sz := ptr-object-size p
T := typeof p
+ ET := elementsizeof T
+ sz := bitcast (arcsize p) usize
p := ptrtoint (view p) intptr
if ((p == 0) or (sz == 0))
0:usize
else
- m := ptr-mask p
- ET := elementsizeof T
- (sz - (p & (m - 1))) // ET
+ sz // ET
inline rtellcap (p)
- p := deref p
+ p := deref (view p)
T := typeof p
+ ET := elementsizeof T
+ cap := bitcast (arcobjcap (view p)) usize
+ __ offset := ptr-base-offset p
p := ptrtoint (view p) intptr
- if (p == 0)
+ if ((p == 0) or (cap == 0))
0:usize
else
- m := ptr-mask p
- ET := elementsizeof T
- ((ptr-mask-capacity m) - (p & (m - 1))) // ET
-
-struct Heap plain
- # base addr; should be a multiple of mmap-address
- base : intptr
- pool : array Pool pool-count
-
- inline __typecall (cls)
- arclog1 "arcmem: initializing arcmem..."
- result := mmap
- inttoptr mmap-address voidstar
- mmap-size
- PROT_NONE
- | MAP_PRIVATE MAP_ANONYMOUS MAP_NORESERVE MAP_FIXED_NOREPLACE
- -1
- 0:usize
- if (mapping-failed? result)
- print2 "arcmem: mmap failed to reserve"
- \ (/hex mmap-address) ".." (/hex (mmap-address + mmap-size))
- ":"
- (strerror (errno)) as rawstring
- abort;
- # TODO: actually retry several factors before giving up - requires
- replacement of several constants in code.
- addr := ptrtoint result intptr
- assert (mmap-address == addr)
- "arcmem: failed to get our preferred base address"
- arclog1 "arcmem: mapped" (/hex addr) ".." (/hex (addr + mmap-size))
- local self := super-type.__typecall cls
- base = addr
- self
-
-global heap : Heap
-
-@@ typed
-fn getheap ()
- return heap
-
-@@ typed
-fn arcinit ()
- getheap;
- ;
-
-fshr := extern 'llvm.fshr.i64 (function u64 u64 u64 u64)
-inline rotr (x c)
- fshr x x c
-# starting at offset i, return the position of the next set lowest bit
-inline findlsbofs (x i)
- x := rotr x i
- ((findlsb x) + i) % 64
-
-inline valid-bitmap-bitptr? (bitptr) true
-
-inline ptralignment (p)
- (ptrtoint p intptr) & (pointer-size - 1)
-inline ptraligned? (p)
- (ptralignment p) == 0
+ (cap - offset) // ET
fn... arcprint (ptr : voidstar, print)
if (not arcptr? ptr)
'__storageprinter ptr print
return;
+ #baseptr offset := ptr-base-offset ptr
+ #h capacity := ptr-aligned-header baseptr
+ addr := ptrtoint ptr intptr
baseptr offset := ptr-base-offset ptr
- h capacity := ptr-aligned-header baseptr
print
Styled.Operator "@"
/..
Styled.Number
- /hex (ptrtoint baseptr intptr)
- bad-header? := (h.hard < 0) or (h.version > version-mask)
- if bad-header?
- if ((@ ('both @h)) == free-list-magic)
- print /..
- Styled.Error "<expired>"
- else
- print /..
- Styled.Error "<corrupt>"
+ /hex (arcbase (ptrtoint ptr intptr))
+ switch (arccheckh ptr)
+ case ArcDead
+ print /..
+ Styled.Error "<expired>"
return;
- size := 'size @h
+ case ArcCorrupt
+ print /..
+ Styled.Error "<corrupt>"
+ return;
+ default;
+ size := arcsize (inttoptr baseptr voidstar)
+ rc := arcrefs ptr
+ rev := arcobjrev ptr
print /..
/ps
@@ printer
@@ 807,46 282,39 @@ fn... arcprint (ptr : voidstar, print)
/..
print
Styled.Number
- dec size
+ /dec size
print /..
- Styled.Operator "v"
+ Styled.Operator "r"
/..
- /hex h.version
- if (h.hard != 1)
+ /hex rev
+ if (rc != 1)
print /..
Styled.Operator "*"
/..
- h.hard
+ rc
+
+inline arcmem-check () 0
-inline ptralignd (p)
- inttoptr ((ptrtoint p intptr) & -pointer-size) voidstar
-inline ptralignu (p)
- inttoptr (((ptrtoint p intptr) + (pointer-size - 1)) & -pointer-size) voidstar
-# true if pointer points to pointer
-inline ptrptr? (p)
- ptr bit := bitptr-split8 (ptr-bitptr-floor p)
- ((load ptr) & (1:u8 << bit)) != 0
-# set as pointer
-inline setptrptr (p)
- ptr bit := bitptr-split8 (ptr-bitptr-floor p)
- atomicrmw bor ptr (1:u8 << bit)
-# pointer only partially points to pointer
-inline badptrptr? (p)
- (not ptraligned? p) and (ptrptr? p)
+inline ptrptr? (ptr)
+ arcisptrtype (view ptr)
+pointer-size := sizeof intptr
fn archexdump (ptr print include-header?)
- if (not arcptr? ptr)
- return;
- if (ptr-soft? ptr)
+ switch (arcptrkind (ptrtoint ptr intptr))
+ case ArcKindHard
+ default
return;
ptr offset := ptr-base-offset ptr
- h cap := ptr-aligned-header ptr
+ ptr := inttoptr ptr voidstar
+ cap := arcobjcap ptr
realcap := cap
cap := if include-header?
- cap + (sizeof Header)
+ # we assume the header follows the capacity; but this is
+ implementation-dependent.
+ cap + (archdrsize)
else
- 'size @h
+ arcsize ptr
ptr := ptr as @u8
N := 16:u64
for i in (range cap)
@@ 948,823 416,6 @@ inline /arcdebugdata (ptr)
archexdump ptr print true
print ""
-
-@@ typed voidstar usize
-fn clearbitmap (ptr size)
- assert (ptraligned? ptr)
- bitmemclearrange
- ptr-bitptr-floor ptr
- ptr-bitptr-ceil
- inttoptr ((ptrtoint (view ptr) intptr) + size) voidstar
-
-# init memory with garbage; this operation won't free any pointers.
-@@ typed voidstar usize
-fn arcundef (ptr size)
- clearbitmap ptr size
- ptr := ptr as ~@u64
- for i in (range (size // (sizeof u64)))
- ptr @ i = uninitialized-u64
-
-# return the next ptr <= position < endptr that contains a pointer or endptr
-@@ typed voidstar voidstar
-fn arcnextptr (ptr endptr)
- assert (arcptr? ptr)
- endptr := if (endptr == null)
- end (ptr as rawstring)
- else
- assert (arcptr? endptr)
- delta := (ptrtoint endptr intptr) - (ptrtoint ptr intptr)
- assert (delta <= (rtell (ptr as rawstring)))
- endptr
- beginbitptr := ptr-bitptr-ceil ptr
- endbitptr := ptr-bitptr-floor endptr
- beginptr beginbit := bitptr-split64 beginbitptr
- endptr endbit := bitptr-split64 endbitptr
- if (beginptr == endptr)
- beginmask := -1:u64 << beginbit
- endmask := ~ (-1:u64 << endbit)
- word := load beginptr
- word := word & (beginmask & endmask)
- return
- if (word == 0)
- null
- else
- bitptr-ptr
- beginbitptr - beginbit + (findlsb word)
- beginptr := if (beginbit != 0)
- beginmask := -1:u64 << beginbit
- word := load beginptr
- word := word & beginmask
- if (word != 0)
- return
- bitptr-ptr
- beginbitptr - beginbit + (findlsb word)
- & (beginptr @ 1)
- else beginptr
- for addr in
- range
- ptrtoint beginptr intptr
- ptrtoint endptr intptr
- sizeof u64
- word := load (inttoptr addr @u64)
- if (word != 0)
- return
- bitptr-ptr
- addr * 8 + (findlsb word)
- if (endbit != 0)
- endmask := ~ (-1:u64 << endbit)
- word := load endptr
- word := word & endmask
- if (word != 0)
- return
- bitptr-ptr
- endbitptr - endbit + (findlsb word)
- null as voidstar
-
-inline eacharcpointer (beginptr endptr)
- Generator
- inline ()
- arcnextptr beginptr endptr
- inline (ptr)
- ptr != null
- inline (ptr)
- assert (ptrptr? ptr)
- @ (ptr as ~@voidstar)
- inline (ptr)
- arcnextptr (incptr ptr pointer-size) endptr
-
-# generates a pointer-iterating function
-inline pointer-iterator (f)
- fn arcdropscanword (bitoffset word ...)
- for k in (iterbits word)
- f (bitoffset + k) ...
-
- fn (beginbitptr endbitptr ...)
- assert (endbitptr >= beginbitptr)
- beginptr beginbit := bitptr-split64 beginbitptr
- endptr endbit := bitptr-split64 endbitptr
- beginmask := -1:u64 << beginbit
- endmask := ~ (-1:u64 << endbit)
- if (beginptr == endptr)
- word := load beginptr
- word := word & (beginmask & endmask)
- arcdropscanword (beginbitptr - beginbit) word ...
- else
- beginptr := if (beginbit != 0)
- word := load beginptr
- word := word & beginmask
- arcdropscanword (beginbitptr - beginbit) word ...
- & (beginptr @ 1)
- else beginptr
- for addr in
- range
- ptrtoint beginptr intptr
- ptrtoint endptr intptr
- sizeof u64
- word := load (inttoptr addr @u64)
- arcdropscanword (addr * 8) word ...
- if (endbit != 0)
- word := load endptr
- word := word & endmask
- arcdropscanword (endbitptr - endbit) word ...
-
-
-arcmem-check := do
- using import Map Set
- RefcountCheckMap := Map intptr (tuple i32 i32)
-
- @@ typed intptr intptr ~&i32 bool ~&RefcountCheckMap
- let bitptr-arcmem-check =
- pointer-iterator
- inline (bitptr errors verbose? map)
- inline logerr (...)
- if verbose?
- print2 ...
- errors += 1
- locptr := bitptr-ptr bitptr
- if (not ptrptr? locptr)
- report "check" bitptr
- assert (ptrptr? locptr)
- ptr := @ (locptr as ~@voidstar)
- if (ptr-handler? ptr)
- func := (ptrtoint (deref ptr) intptr) & ~handler-bit
- if ((func & (-1:u64 << 48)) != 0)
- logerr "corrupt arc handler address located here:"
- /arcdata locptr
- elseif (ptr != null)
- origptr := ptr
- soft? := ptr-soft? ptr
- ptr := if soft?
- inttoptr ((ptrtoint (deref ptr) intptr) & ~soft-bit) voidstar
- else ptr
- if (not arcptr? ptr)
- addr := ptrtoint origptr intptr
- # we reluctantly permit foreign pointers to be tagged,
- but do a simple sanity-check.
- if ((addr & (-1:u64 << 48)) != 0)
- logerr "corrupt pointer address located here:"
- /arcdata locptr
- ptr := ptr-base ptr
- dest := 'setdefault map (ptr as intptr) (tupleof 0 0)
- if soft?
- dest @ 1 += 1
- else
- dest @ 0 += 1
-
- @@ typed intptr intptr intptr
- let bitptr-arcmem-print-users =
- pointer-iterator
- inline (bitptr searchaddr)
- locptr := bitptr-ptr bitptr
- assert (ptrptr? locptr)
- ptr := ptr-base (deref (@ (locptr as ~@voidstar)))
- if ((ptrtoint ptr intptr) == searchaddr)
- print2 "user located here:"
- /arcdata locptr
-
- @@ typed intptr
- fn list-users (searchaddr)
- for poolid in (range pool-count)
- pool := heap.pool @ poolid
- pooladdr := heap.base + pool-size * poolid
- cap := 1:usize << (poolid + pool-min-size-bits)
- numallocs := pool.size // cap
- for i in (range numallocs)
- ptraddr := pooladdr + cap * i
- ptr := inttoptr ptraddr @u64
- fl := ptr-aligned-freelist ptr
- if (fl.magic != free-list-magic)
- # scan for users
- p0 p1 := ptr-range ptr (ptr-capacity ptraddr)
- bp0 bp1 := ptr-bitptr-range p0 p1
- bitptr-arcmem-print-users bp0 bp1 searchaddr
-
- # check arcmem integrity
- @@ typed bool
- fn arcmem-check (verbose?)
- inline logmsg (...)
- if verbose?
- print2 ...
- local errors = 0
- inline logerr (...)
- if verbose?
- print2 ...
- errors += 1
-
- logmsg "checking arcmem..."
-
- local refcounts : RefcountCheckMap
-
- local committed = 0:usize
- local used = 0:usize
- local freed = 0:usize
- for poolid in (range pool-count)
- pool := heap.pool @ poolid
- pooladdr := heap.base + pool-size * poolid
- cap := 1:usize << (poolid + pool-min-size-bits)
- numallocs := pool.size // cap
- committed += numallocs * cap
- # todo: for separate headers, count memory used as well;
- also count bitmap size.
- also compute overall overhead.
- local freeptrs : Set intptr
- loop (first = (volatile-load &pool.first))
- if (first == 0)
- break;
- ptr := inttoptr first voidstar
- fl := ptr-aligned-freelist ptr
- if (fl.magic == free-list-magic)
- 'insert freeptrs first
- else
- logerr (/arc ptr) /.. ": used allocation in freelist"
- logerr (/arcdebugdata ptr)
- volatile-load &fl.next
- for i in (range numallocs)
- ptraddr := pooladdr + cap * i
- ptr := inttoptr ptraddr @u64
- fl := ptr-aligned-freelist ptr
- if (fl.magic == free-list-magic)
- freed += cap
- @if USE_FREE_GARBAGE
- # free
- fcap := ptr-mask-capacity cap
- for i in (range (fcap // (sizeof u64)))
- if ((ptr @ i) != uninitialized-u64)
- logerr (/arc ptr) /.. ": freed allocation contains stray write"
- break;
- @endif
- if (ptraddr in freeptrs)
- 'discard freeptrs ptraddr
- else
- logerr (/arc ptr) /.. ": freed allocation not in freelist"
- else
- used += cap
- # allocated
- h := ptr-aligned-header ptr
- if (h.hard < 0)
- logerr (/arc ptr) /.. ": bad hard user count " /.. h.hard
- if (h.version > version-mask)
- logerr (/arc ptr) /.. ": bad version " /.. (/hex h.version)
- # verify pointers
- p0 p1 := ptr-range ptr (ptr-capacity ptraddr)
- bp0 bp1 := ptr-bitptr-range p0 p1
- bitptr-arcmem-check bp0 bp1 errors verbose? refcounts
- if (not (empty? freeptrs))
- logerr "pool" poolid /.. ": freelist has more entries than free allocations"
-
- local numobjects = 0:usize
- local numleaks = 0:usize
- for poolid in (range pool-count)
- pool := heap.pool @ poolid
- pooladdr := heap.base + pool-size * poolid
- cap := 1:usize << (poolid + pool-min-size-bits)
- numallocs := pool.size // cap
- for i in (range numallocs)
- ptraddr := pooladdr + cap * i
- hard soft := unpack ('getdefault refcounts ptraddr (tupleof 0 0))
- ptr := inttoptr ptraddr @u64
- fl := ptr-aligned-freelist ptr
- local listusers? = false
- if (fl.magic == free-list-magic)
- if ((max hard soft) != 0)
- logerr (/arc ptr) /.. ": freed allocation is still being pointed to"
- listusers? = true
- else
- numobjects += 1
- h := ptr-aligned-header ptr
- if (h.hard == hard)
- continue;
- numleaks += 1
- if (h.hard != hard)
- if (hard > h.hard)
- logerr (/arc ptr) /.. ": corrupt hard user count, is"
- /dec h.hard
- "but should be"
- /dec hard
- listusers? = true
- else
- n := h.hard - hard
- logmsg (/arc ptr) /.. ": has" n "opaque hard user(s)"
- if (verbose? and listusers?)
- list-users ptraddr
-
- logmsg (/dec numobjects) "objects," (/dec numleaks) "leaking"
- logmsg "committed:" (/byteunit committed)
- logmsg "in use:" (/byteunit used)
- logmsg "free:" (/byteunit freed)
- if (errors != 0)
- logmsg
- Styled.Error
- /nostyle (/dec errors) "error(s) found."
- else
- logmsg "no error(s) found."
-
- errors
-
-@if USE_AIC
-inline verify-integrity ()
- if ((arcmem-check false) != 0)
- report "arcmem integrity check failed."
- arcmem-check true
- abort;
-@else
-inline verify-integrity ()
-@endif
-
-@@ typed usize
-fn arcmalloc (size)
- verify-integrity;
- if (size == 0)
- return (null as voidstar)
- requested-size := size
- # align to header alignment
- size := (size + header-align - 1) & -header-align
- # actual required size: aligned size + header + bitmap (with overlapping bytes)
- size := size + (max header-size ((size + 63) // 64 + header-used-bytes))
- assert (size >= min-align)
-
- capbits := best-capacity-bits size
- poolid := capacity-bits-poolid capbits
-
- if (poolid >= pool-count)
- report "arcmalloc: requested allocation is too large"
- return (null as voidstar)
-
- # capacity includes header
- capacity := 1:usize << capbits
- pool := heap.pool @ poolid
-
- pfirst := &pool.first
- ptr := loop (first = (volatile-load pfirst))
- first ok? := cmpxchg pfirst first 1:u64
- if (first == 1) # was already locked, try again
- repeat (volatile-load pfirst)
- if (first == 0) # no previously freed allocations available
- # release lock
- volatile-store first pfirst
- # grow pool
- offset := atomicrmw add &pool.size capacity
- nextoffset := offset + capacity
- if (nextoffset > pool-size)
- # pool is spent; only fix the pool size if we broke it
- if (offset <= pool-size)
- # if this fails, that's ok - then a free-op fixed it
- we don't presently ever decrease pool size anywhere, but
- might in the future.
- cmpxchg &pool.size nextoffset offset
- # todo: allocate memory from one of the other pools
- report "arcmalloc: pool is out of memory"
- return (null as voidstar)
- pooladdr := heap.base + pool-size * poolid
- # offset of first unused page outside range
- endpage := (nextoffset + page-size - 1) & -page-size
- pagesize := volatile-load &pool.page_size
- ptr := inttoptr (pooladdr + offset) voidstar
- if (endpage > pagesize) # new pages need to become writable
- # multiple threads race, but their actions will not disagree
- with each other, as we're not shrinking pages again.
- # offset of next protected page
- beginpage := (offset + page-size - 1) & -page-size
- arclog1 "arcmem: growing heap pool" (/dec poolid) ":"
- \ (/hex beginpage) ".." (/hex endpage)
- mprotect
- inttoptr (pooladdr + beginpage) voidstar
- endpage - beginpage
- PROT_READ | PROT_WRITE
- # we also possibly need to unprotect a bitmap page
- endptr := inttoptr (pooladdr + offset + capacity) voidstar
- beginbitpage := ((ptrtoint (bitptr-split8 (ptr-bitptr-floor ptr)) intptr) + page-size - 1) & -page-size
- endbitpage := ((ptrtoint (bitptr-ceil8 (ptr-bitptr-floor endptr)) intptr) + page-size - 1) & -page-size
- if (beginbitpage != endbitpage)
- arclog1 "arcmem: growing heap bitmap pool" (/dec poolid) ":"
- \ (/hex beginbitpage) ".." (/hex endbitpage)
- mprotect
- inttoptr beginbitpage voidstar
- endbitpage - beginbitpage
- PROT_READ | PROT_WRITE
- atomicrmw umax &pool.page_size endpage
- arclog "malloc new"
- /nolines (/arc ptr) size
- break ptr
- ptr := inttoptr first voidstar
- h := ptr-aligned-freelist ptr
- if (h.magic != free-list-magic)
- assert false "arcmalloc: bad freelist header"
- # this also releases the lock
- volatile-store h.next pfirst
- arclog "malloc reuse"
- /nolines ptr size
- break ptr
- cap := ptr-mask-capacity capacity
- # init usable memory
- @if USE_ALLOC_GARBAGE
- arcundef ptr cap
- @else
- clearbitmap ptr cap
- @endif
- h := ptr-aligned-header ptr
- assert (h.version <= version-mask)
- # bump version to make sure old soft pointers stay dead
- atomicrmw add &h.version 1:u32
- volatile-store 1 &h.hard
- 'setsize @h requested-size
- @if (defined? TRACE_PTR_ALLOC)
- if ((ptrtoint ptr intptr) == (iptr-base TRACE_PTR_ALLOC))
- report "arcmem: breakpoint hit while allocating"
- /arcdebugdata ptr
- abort;
- @endif
-
- ptr
-
-@@ typed voidstar
-fn arcshare-internal (ptr)
- if (arcptr? ptr)
- origptr := ptr
- ptr := ptr-base ptr
- @if (defined? TRACE_PTR_SHARE)
- if ((ptrtoint ptr intptr) == (iptr-base TRACE_PTR_SHARE))
- report "arcmem: breakpoint hit while sharing"
- /arcdebugdata ptr
- abort;
- @endif
- h := ptr-aligned-header ptr
- if (ptr-soft? ptr)
- return ptr
- oldval := atomicrmw add (& h.hard) 1
- if (oldval <= 0)
- report "while sharing arcpointer at"
- /arcdata origptr
- assert false "arcmem: internal error: use after free detected"
- ptr
-
-@@ typed voidstar
-fn arcshare (ptr)
- verify-integrity;
- arcshare-internal ptr
-
-null-softarc-pointer := 0:u64
-
-@@ typed voidstar
-fn arcsoften (ptr)
- verify-integrity;
- if (ptr-soft? ptr)
- return (ptrtoint ptr intptr)
- if (not arcptr? ptr)
- return null-softarc-pointer
- origptr := ptr
- ptr := ptr-base ptr
- h := ptr-aligned-header ptr
- ptr-soften origptr h.version
-
-enum SoftArcError plain
- Null
- Unrecognizable
- ActuallyHard
- OutOfArcRange
- Dead
- Moved
-
-@@ typed intptr
-fn softarc-validate (ptr)
- if (ptr == null-softarc-pointer)
- raise SoftArcError.Null
- if (not iptr-soft? ptr)
- if (arcptr? (inttoptr ptr voidstar))
- raise SoftArcError.ActuallyHard
- raise SoftArcError.Unrecognizable
- ptr version := ptr-harden ptr
- if (not arcptr? ptr)
- raise SoftArcError.OutOfArcRange
- newptr := ptr
- ptr := ptr-base ptr
- h := ptr-aligned-header ptr
- both := 'both @h
- s := volatile-load both
- if (s as u32 as i32 <= 0) # he's dead jim
- raise SoftArcError.Dead
- if ((s >> 32) != version) # moved
- raise SoftArcError.Moved
- pass newptr version
-
-@@ typed intptr
-fn archarden (ptr)
- raising void
- verify-integrity;
- if (not iptr-soft? ptr)
- raise;
- ptr version := ptr-harden ptr
- if (not arcptr? ptr)
- raise;
- newptr := ptr
- ptr := ptr-base ptr
- h := ptr-aligned-header ptr
- both := 'both @h
- s := volatile-load both
- loop (s = s)
- if (s as u32 as i32 <= 0) # he's dead jim
- raise;
- if ((s >> 32) != version) # moved
- raise;
- # try to increment; a better atomic op here would be "inc if != 0",
- saving us this entire silly loop, but i don't think it exists.
- s ok? := cmpxchg both s (s + 1)
- if ok? # it's aliiive!
- return newptr
- s
-
-# equivalent to free(); do not call arcvacate directly, but use arcfree instead.
-@@ typed voidstar
-fn arcvacate (ptr)
- #verify-integrity;
- if (arcptr? ptr)
- assert (ptr == (ptr-base ptr))
- "arcvacate: pointer does not point at valid object"
- h := ptr-aligned-freelist ptr
- assert (h.magic != free-list-magic)
- "arcvacate: double free detected"
- # capacity includes header
- ptraddr := ptrtoint ptr intptr
- @if (defined? TRACE_PTR_FREE)
- if (ptraddr == (iptr-base TRACE_PTR_FREE))
- report "arcmem: breakpoint hit while freeing"
- /arcdebugdata ptr
- abort;
- @endif
- capacity := ptr-mask ptraddr
- cap := ptr-mask-capacity capacity
- @if USE_FREE_GARBAGE
- arcundef ptr cap
- @else
- clearbitmap ptr cap
- @endif
- h.magic = free-list-magic
- h.next = 0
- poolid := ptr-poolid ptr
- assert (poolid < pool-count)
- pool := heap.pool @ poolid
-
- pfirst := &pool.first
- loop (first = (volatile-load pfirst))
- first ok? := cmpxchg pfirst first 1:u64
- if (first == 1) # was already locked, try again
- repeat (volatile-load pfirst)
- h.next = first
- # this also releases the lock
- volatile-store (ptrtoint ptr intptr) pfirst
- break;
- else
- arclog "arcvacate attempted on non-arcptr"
- # fallback to regular free
- #free ptr
-
-inline harddrop (name ptr h)
- assert ((volatile-load &h.hard) == 0)
- arclog (/nolines name "free" (/arc ptr))
- arcvacate ptr
-
-@@ typed voidstar ~&voidstar
-fn arcdrop1 (ptr stack)
- verify-integrity;
- if (ptr-soft? ptr)
- return;
- if (not arcptr? ptr)
- return;
- origptr := ptr
- ptr := ptr-base ptr
- h := ptr-aligned-header ptr
- s := atomicrmw sub &h.hard 1
- if (s == 1) # was ordered owner of last hard reference, clean up
- # push on stack for deferred finalization
- 'setnextptr @h stack
- stack = ptr
- return;
- elseif (s <= 0)
- report "while dropping arcpointer at"
- /arcdebugdata origptr
- assert false "arcmem: internal error: use after free detected"
-
-inline dropbitptrit (bitptr stack)
- assert ((ptr-bitptr-floor (bitptr-ptr bitptr)) == bitptr)
- locptr := bitptr-ptr bitptr
- assert (ptrptr? locptr)
- ptrp := @ (locptr as ~@voidstar)
- ptr := deref ptrp
- if (ptr-handler? ptr)
- func := (ptrtoint (deref ptr) intptr) & ~handler-bit
- if (func != (func & pointer-mask))
- report "while dropping arcpointer at"
- /arcdebugdata locptr
- assert false "arcmem: corrupt arc handler encountered"
- arclog "invoking handler @" (/hex func)
- func := inttoptr func HangleFunction
- func HangleMethod.Drop (&ptrp as HanglePointer)
- else
- ptrp = null
- arcdrop1 ptr stack
- ptrp
-
-@@ typed intptr intptr ~&voidstar
-let bitptr-droptostack =
- pointer-iterator dropbitptrit
-
-@@ typed intptr intptr ~&voidstar
-let bitptr-dropandcleartostack =
- pointer-iterator
- inline (bitptr stack)
- ptr := dropbitptrit bitptr stack
- ptr = null
-
-inline sharebitptrit (bitptr)
- assert ((ptr-bitptr-floor (bitptr-ptr bitptr)) == bitptr)
- locptr := bitptr-ptr bitptr
- if (not ptrptr? locptr)
- report "while sharing arcpointer at"
- /arcdata locptr
- assert false "arcmem: internal error: phantom pointer bit"
- ptr := @ (locptr as ~@voidstar)
- if (ptr-handler? ptr)
- # todo: request pointer to copy
- func := (ptrtoint (deref ptr) intptr) & ~handler-bit
- if (func != (func & pointer-mask))
- report "while sharing arcpointer at"
- /arcdata locptr
- assert false "arcmem: corrupt arc handler encountered"
- arclog "invoking handler @" (/hex func)
- func := inttoptr func HangleFunction
- func HangleMethod.Copy (&ptr as HanglePointer)
- else
- arcshare-internal (deref ptr)
- ;
- ptr
-
-@@ typed intptr intptr
-let bitptr-share =
- pointer-iterator sharebitptrit
-
-@@ typed ~&voidstar
-fn arcmemdropstack (stack)
- loop ()
- ptr := deref stack
- if (ptr == null) # nothing to do
- break;
- # pop off stack
- h cap := ptr-aligned-header ptr
- stack = 'nextptr @h
- r0 r1 := ptr-bitptr-range ptr cap
- # 1. scan bitmap for pointers and drop them as well
- @if USE_AIC
- bitptr-dropandcleartostack r0 r1 stack
- @else
- bitptr-droptostack r0 r1 stack
- @endif
- # 2. free for good
- harddrop "hard" ptr h
- repeat;
-
-@@ typed voidstar
-fn arcfree (ptr)
- verify-integrity;
- local stack : voidstar = null
- arcdrop1 ptr stack
- arcmemdropstack stack
-
-# used by arcmemcpy and arcsethandlerfn.
- drop all pointers across range; will only zero pointers at endpoints and
- clear the pointer bits, but assumes the memory is going to be overwritten
- right after.
-@@ typed voidstar usize
-fn ptr-memdrop (ptr size)
- if (not arcptr? ptr)
- return;
- assert (size <= (rtell (ptr as rawstring)))
- d0 d1 := ptr-range ptr size
- assert (d0 <= d1)
- bd0 bd1 := ptr-bitptr-range-outer d0 d1
- assert (bd0 <= bd1)
- # drop all pointers overlapping destination
- local stack : voidstar = null
- bitptr-dropandcleartostack bd0 bd1 stack
- # clear all pointer bits
- bitmemclearrange bd0 bd1
- # cleanup dependencies
- arcmemdropstack stack
-
-# used by arcmemcpy; share all pointers within range
-@@ typed voidstar usize
-fn ptr-memshare (ptr size)
- if (not arcptr? ptr)
- return;
- assert (size <= (rtell (ptr as rawstring)))
- d0 d1 := ptr-range ptr size
- bd0 bd1 := ptr-bitptr-range-inner d0 d1
- if (bd0 < bd1)
- bitptr-share bd0 bd1
-
-@@ typed voidstar HangleFunction
-fn archangle (ptr func)
- if (not arcptr? ptr)
- return;
- if (not ptraligned? ptr)
- return;
- if ((rtell (ptr as rawstring)) < pointer-size)
- return;
- ptr-memdrop ptr pointer-size
- func := (ptrtoint func intptr) | handler-bit
- store func
- bitcast ptr ~@intptr
- setptrptr ptr
- return;
-
-#inline bitptr-memcopy-data (size dest src copied)
- srcptr := deref src
- destptr := deref dest
- # free all existing pointers at destination
- ptr-memdrop destptr size
- # copy everything up to this location, which is not a pointer
- memcpy (destptr as ~rawstring)
- srcptr as rawstring
- size
- copied += size
- srcptr := inttoptr ((ptrtoint srcptr intptr) + size) voidstar
- destptr := inttoptr ((ptrtoint destptr intptr) + size) voidstar
- src = inttoptr ((ptrtoint srcptr intptr) + pointer-size) voidstar
- dest = inttoptr ((ptrtoint destptr intptr) + pointer-size) voidstar
- destptr
-
-#@@ typed intptr intptr voidstar
-#let bitptr-copy =
- pointer-iterator
- inline (bitptr dest src copied)
- srcptr := (bitptr-ptr bitptr) as ~@voidstar
- offset := (ptrtoint srcptr intptr) - (ptrtoint src intptr)
- destptr := bitptr-memcopy-data offset dest src copied
- # todo: we could move this branch further up
- if (ptraligned? destptr)
- copied += pointer-size
- @ (destptr as ~@voidstar) = arcshare (deref (@ srcptr))
- # todo: copy bits separately, in one pass
- if (arcptr? destptr)
- setptrptr destptr
- else
- @ (destptr as ~@voidstar) = null
-
-# copy memory between two non-overlapping locations.
-
- partially covered pointers at the back or front of `src` will be copied
- as null.
-
- to unaligned offsets, pointers will also be copied as null.
-
- all pointers fully or partially overwritten at `dest` will be untagged,
- dropped and nulled as if arcfree() were called on them.
-
- pointers duplicated from `src` will be copied as if arcshare() were called
- on them, and the destination address will be tagged as pointer.
-@@ typed voidstar voidstar usize
-fn arcmemcpy (dest src size)
- local copied : usize = 0
- if (arcptr? dest)
- # free all existing pointers at destination
- ptr-memdrop dest size
- if (arcptr? src)
- s0 s1 := ptr-range src size
- unlet size
- # don't transfer overlapped pointer at the back
- s1 := if (badptrptr? s1) (ptralignd s1)
- else s1
- # skip heading bytes of overlapping pointer
- dest s0 := if (badptrptr? s0)
- as0 := ptralignu s0
- dest := inttoptr
- (ptrtoint dest intptr) +
- (ptrtoint as0 intptr) - (ptrtoint s0 intptr)
- voidstar
- pass dest as0
- else
- pass dest s0
- trunc_size := (ptrtoint s1 intptr) - (ptrtoint s0 intptr)
- memcpy (dest as ~rawstring)
- s0 as rawstring
- trunc_size
- copied += trunc_size
- if ((arcptr? dest) and ((ptralignment src) == (ptralignment dest)))
- # transfer all pointer bits
- bs0 bs1 := ptr-bitptr-range s0 s1
- bd0 := ptr-bitptr-floor dest
- bitmemcpy
- bd0
- bs0
- bs1 - bs0
- # share all pointers for which bits are set
- ptr-memshare dest trunc_size
- else
- memcpy (dest as ~rawstring)
- src as rawstring
- size
- copied += size
- copied
-
inline... arcmemcopyn (dest, src, count : usize)
dest := view dest
src := view src
@@ 1772,356 423,19 @@ inline... arcmemcopyn (dest, src, count
ETsz := sizeof ET
(arcmemcpy dest src (ETsz * count)) // ETsz
-@@ typed voidstar i32 usize
-fn arcmemset (dest value size)
- local copied : usize = 0
- if (arcptr? dest)
- # free all existing pointers at destination
- ptr-memdrop dest size
- memset (dest as ~rawstring) value size
- copied += size
- copied
-
inline... arcmemsetn (dest, value, count : usize)
dest := view dest
ETsz := sizeof (elementof (typeof dest))
(arcmemset dest value (ETsz * count)) // ETsz
-# under the assumption that there are no references to memory past `size`,
- shorten the reported size of the allocation.
-@@ typed voidstar usize
-fn arctrunc (ptr size)
- verify-integrity;
- if (not arcptr? ptr)
- return;
- remainder := rtell (bitcast ptr rawstring)
- baseptr offsetptr := ptr-base-offset ptr
- h cap := ptr-aligned-header baseptr
- if (size < remainder) # truncate
- # clear pointers from size to remainder
- ptr-memdrop
- inttoptr
- (ptrtoint ptr intptr) + size
- voidstar
- remainder - size
- 'setsize @h (offsetptr + size)
-
-# if pointer isn't the only reference on the data or the remaining capacity is
- smaller than `size`, make a copy of the data, starting at the pointer, and
- grow it to ensure that `size` bytes are available; returns the new capacity
- of the buffer or 0 if the pointer is not an arcpointer.
-@@ typed ~&voidstar usize
-fn arcresize (dest size)
- verify-integrity;
- ptr := deref dest
- if ((ptr == null) and (size != 0:usize))
- newptr := arcmalloc size
- dest = newptr
- return (rtell (bitcast newptr rawstring))
- if (not arcptr? ptr)
- return 0:usize
- remainder := rtell (bitcast ptr rawstring)
- baseptr offsetptr := ptr-base-offset ptr
- h cap := ptr-aligned-header baseptr
- s := volatile-load &h.hard
- if (s == 1)
- # a soft pointer could upgrade while we're performing this operation,
- changing the refcount; so we make sure our refcount is zero for
- the duration of the operation.
- __ ok? := cmpxchg &h.hard s 0
- if ok?
- inline restore-refcount ()
- assert ((volatile-load &h.hard) == 0)
- volatile-store 1 &h.hard
- # existing size still covers this size, all soft pointers are still
- valid.
- if (remainder == size)
- #report "same size"
- restore-refcount;
- return remainder
- elseif (size < remainder) # truncate
- #report "truncate"
- # not all soft pointers will be reconstructible, bump version
- atomicrmw add &h.version 1:u32
- # clear pointers from size to remainder
- ptr-memdrop
- inttoptr
- (ptrtoint ptr intptr) + size
- voidstar
- remainder - size
- 'setsize @h (offsetptr + size)
- restore-refcount;
- return size
- elseif (size <= (cap - offsetptr)) # expand, but we can reuse the allocation
- #report "expand"
- # existing soft pointers will stay alive
- 'setsize @h (offsetptr + size)
- restore-refcount;
- return size
- else
- #report "need-realloc" size remainder cap
- # need to reallocate
- restore-refcount;
- #else
- report "need-copy"
- newptr := arcmalloc (max remainder size)
- if (newptr != null)
- # todo: for s = 1, we can move all references and free ptr directly
- arcmemcpy newptr ptr remainder
- dest = newptr
- arcfree ptr
- rtell (bitcast newptr rawstring)
-
inline... resize
case (ptr, count : usize)
ETsz := sizeof (elementof (typeof ptr))
- (arcresize ptr (count * ETsz)) // ETsz
+ ptr := bitcast& (view ptr) voidstar
+ assign (arcresize (view ptr) (count * ETsz)) ptr
case (ptr)
- ETsz := sizeof (elementof (typeof ptr))
- count := rtell ptr
- (arcresize ptr (count * ETsz)) // ETsz
-
-# compatible with fwrite
-ArcWriter := @ (function u64 voidstar u64 u64 voidstar)
-# compatible with fread
-ArcReader := @ (function u64 voidstar u64 u64 voidstar)
-# since this bit only appears in headers, we do not collide with the weak
- reference bit.
-forward-declaration-bit := bit63
-
-@@ typed ArcReader voidstar
-fn arcread (reader ctx)
- # todo: better validation. currently too unsafe for foreign data; do not
- use this on untrusted data.
- using import Map
- noresult := null as voidstar
- # serialized base pointer to base pointer
- local idmap : Map intptr voidstar
- fn freetmp (idmap)
- for k v in idmap
- arcfree v
- defer freetmp idmap
- local root : voidstar = null
- # read forward declaration
- local tmp : u64
- static-assert ((sizeof tmp) == pointer-size)
- inline read (ptr size)
- if ((reader ptr size 1 ctx) != 1)
- raise;
- loop ()
- try
- read &tmp (sizeof tmp)
- else
- # acceptable end of file
- return (arcshare root)
- idsz := deref tmp
- id size := iptr-base-offset idsz
- size := size + 1
- forward-decl? := (id & forward-declaration-bit) != 0
- id := id & ~forward-declaration-bit
- ptr := try
- 'get idmap id
- else
- ptr := arcmalloc size
- if (ptr == null)
- raise;
- 'set idmap id ptr
- ptr
- if forward-decl?
- repeat;
- bitmapsize := size // pointer-size # in bits
- # read bitmap
- p0 p1 := ptr-range ptr size
- bp0 bp1 := ptr-bitptr-range p0 p1
- src := tobitptr &tmp
- loop (bp0)
- if (bp0 == bp1)
- break;
- toread := min (bp1 - bp0) 64:u64
- bytes := (toread + 7) // 8
- read &tmp bytes
- bitmemcpy bp0 src toread
- bp0 + toread
- # transfer data according to bitmap
- local last_offset : u64 = ptrtoint ptr intptr
- for ptr in (eacharcpointer ptr null)
- offset := ptrtoint &ptr intptr
- assert (offset >= last_offset)
- delta := offset - last_offset
- if (delta != 0)
- read (inttoptr last_offset voidstar) delta
- last_offset = offset
- read &tmp (sizeof tmp)
- srcptr := if (tmp != 0)
- id ptrofs := iptr-base-offset tmp
- srcptr := try
- 'get idmap id
- else
- report "reference to undeclared pointer encountered"
- raise;
- srcptr := incptr srcptr ptrofs
- arcshare srcptr
- else
- null
- ptr = srcptr
- last_offset += pointer-size
- endoffset := ptrtoint (incptr ptr size) intptr
- assert (endoffset >= last_offset)
- delta := endoffset - last_offset
- if (delta != 0)
- read (inttoptr last_offset voidstar) delta
- if (root == null)
- root = dupe ptr
-
-ArcWriteContext := do
- using import Map Array Set
-
- # first, build topological order to know strong pointers that are actually
- contained, then forward declare
-
- struct ArcWriteContext
- order : Array voidstar
- # pointer begin, pointer end
- stack : Array (tuple voidstar voidstar)
- # base pointer to serialized base pointer
- idmap : Map voidstar intptr
- # next free id
- poolids : array intptr pool-count
-
- fn toposort (self root)
- if (not arcptr? root)
- return;
- do
- root := ptr-base root
- if ('ensureid self root)
- endptr := incptr root (ptr-aligned-object-size root)
- 'append self.stack (tupleof root endptr)
- while (not empty? self.stack)
- beginptr endptr := unpack ('last self.stack)
- nextptr := arcnextptr beginptr endptr
- if (nextptr == null)
- # we're done
- 'append self.order
- ptr-base beginptr
- 'pop self.stack
- ;
- else
- assert (ptrptr? nextptr)
- ptr := @ (nextptr as ~@voidstar)
- beginptr = incptr nextptr pointer-size # advance iterator
- if (ptr-handler? ptr)
- # todo
- #func := (ptrtoint (deref ptr) intptr) & ~handler-bit
- elseif (arcptr? ptr)
- ptr := ptr-base ptr
- if ('ensureid self ptr)
- endptr := incptr ptr (ptr-aligned-object-size ptr)
- 'append self.stack (tupleof ptr endptr)
-
- # assuming ptr is a base ptr
- fn... ensureid (self, ptr : voidstar)
- if (ptr in self.idmap)
- return false
- size := ptr-aligned-object-size ptr
- capbits := best-capacity-bits size
- poolid := capacity-bits-poolid capbits
- assert (poolid < pool-count)
- nextid := self.poolids @ poolid
- objectid := copy nextid
- nextid += 1
- capacity := 1:usize << capbits
- id := mmap-address + pool-size * poolid + objectid * capacity
- 'set self.idmap ptr id
- true
-
- fn writeto (self writer ctx)
- inline write (ptr sz)
- count := writer ptr sz 1 ctx
- if (count != 1)
- raise;
- local tmp : u64 = 0
- static-assert ((sizeof tmp) == pointer-size)
- inline declare (ptr forward?)
- id := try! 'get self.idmap ptr
- id := static-if forward?
- id | forward-declaration-bit
- else id
- sz := ptr-aligned-object-size ptr
- assert (sz != 0)
- tmp = id | (sz - 1)
- write &tmp (sizeof tmp)
- sz
- local declared : Set voidstar
- for ptr in ('reverse self.order)
- ptr := deref ptr
- 'insert declared ptr
- # forward-declare all unseen pointers
- for ptr in (eacharcpointer ptr null)
- if (ptr-handler? ptr)
- # todo
- #func := (ptrtoint (deref ptr) intptr) & ~handler-bit
- continue;
- elseif (arcptr? ptr)
- ptr := ptr-base ptr
- if (ptr in declared)
- continue;
- 'insert declared ptr
- declare ptr
- forward? = true
- size := declare ptr
- forward? = false
- local written = 0:u64
- do
- # stream bitmap, one u64 at a time, but ultimately aligned
- to 8 bytes.
- p0 p1 := ptr-range ptr size
- bp0 bp1 := ptr-bitptr-range p0 p1
- assert ((bp1 - bp0) == size // pointer-size)
- dest := tobitptr &tmp
- loop (bp0)
- if (bp0 >= bp1)
- break;
- tmp = 0
- towrite := min (bp1 - bp0) 64:u64
- bitmemcpy dest bp0 towrite
- bytes := (towrite + 7) // 8
- write &tmp bytes
- written += bytes
- bp0 + towrite
- assert (written == (((size // pointer-size) + 7) // 8))
- # now stream actual content
- local last_offset : u64 = ptrtoint ptr intptr
- written = 0
- for ptr in (eacharcpointer ptr null)
- offset := ptrtoint &ptr intptr
- assert (offset >= last_offset)
- delta := offset - last_offset
- if (delta != 0)
- write (inttoptr last_offset voidstar) delta
- written += delta
- last_offset = offset + pointer-size
- tmp = 0
- # todo: soft pointers, arcane pointers
- if (arcptr? ptr)
- ptr ptrofs := ptr-base-offset ptr
- id := try! 'get self.idmap ptr
- tmp = ptrofs + id
- write &tmp (sizeof tmp)
- written += sizeof tmp
- endoffset := ptrtoint (incptr ptr size) intptr
- assert (endoffset >= last_offset)
- delta := endoffset - last_offset
- if (delta != 0)
- write (inttoptr last_offset voidstar) delta
- written += delta
- assert (written == size)
-
-# arcwrite streams an arcmem digraph, root node first.
-@@ typed voidstar ArcWriter voidstar
-fn arcwrite (root writer ctx)
- local self : ArcWriteContext
- 'toposort self root
- 'writeto self writer ctx
+ ptr := bitcast& (view ptr) voidstar
+ assign (arcresize (view ptr) (arcsize ptr)) ptr
struct archashctx plain
data : u128
@@ 2149,68 463,6 @@ fn archash (root maxsize)
false
bitcast (sc_rhash_digest ctx.data) uhash, ctx.size, complete?
-@if main-module?
-do
- p := arcmalloc 1
- p2 := arcmalloc 600
- print
- ptr-capacity (ptrtoint p intptr)
- p
- print
- ptr-capacity (ptrtoint p2 intptr)
- p2
-
-
-do
- p1 := arcmalloc 1
- p2 := arcmalloc 1
- p3 := arcmalloc 1
- p4 := arcmalloc 1
- print p1 p2 p3 p4
-
- p3b := arcshare p3
-
- arcfree p1
- arcfree p2
- arcfree p3
- arcfree p4
- print "-"
- q1 := arcmalloc 1
- q2 := arcmalloc 1
- q3 := arcmalloc 1
- q4 := arcmalloc 1
- q5 := arcmalloc 1
- print q1 q2 q3 q4 q5
- arcfree p3b
-
- p := arcmalloc 256
- do
- p := p as ~rawstring
- for i in (range (ptr-capacity (ptrtoint p intptr)))
- p @ i = i as i8
-
- do
- q := ptr-offset p (8 * 12)
- store q1 (q as ~@voidstar)
- setptrptr q
- q := ptr-offset q 8
- store q2 (q as ~@voidstar)
- setptrptr q
- do
- q := ptr-offset p (8 * 50)
- store q3 (q as ~@voidstar)
- setptrptr q
- q := ptr-offset q (8 * 3)
- store q4 (q as ~@voidstar)
- setptrptr q
-
- p := ptr-offset p 260
- print
- /p
- /arcdata p
-
-@endif
-
#@if main-module?
#do
# testing
@@ 2225,40 477,29 @@ do
rpfree p
#@endif
+inline incptr (ptr bytes)
+ inttoptr ((ptrtoint (view ptr) intptr) + bytes) voidstar
+inline diffptr (a b)
+ (ptrtoint (view a) intptr) - (ptrtoint (view b) intptr)
+
# will not release any memory
inline arcstore (source dest volatile?)
- verify-integrity;
+ #verify-integrity;
dest := view dest
ST := storageof (typeof source)
assert (arcptr? dest)
volatile? := static-if (none? volatile?) false
else true
store := volatile? volatile-store store
- if (ptrptr? dest)
- destp := bitcast dest ~@voidstar
- ptr := load destp
- store (nullof voidstar) destp
- arcfree ptr
- store (autocopy source) dest
- bitmemclearrange
- ptr-bitptr-floor dest
- ptr-bitptr-ceil
- inttoptr ((ptrtoint (view dest) intptr) + (sizeof ST)) voidstar
+ #destp := bitcast dest ~@voidstar
+ arcmemset dest 0 (sizeof ST)
va-map
inline (offset)
- dcheck := inttoptr ((ptrtoint dest intptr) + offset) voidstar
- dest := (seek (bitcast dest rawstring) offset) as voidstar
- assert (dest == dcheck)
- assert (ptraligned? dest)
- # we accept tagging even non-arcptrs, which cannot be shared or
- dropped, but can be cleared on a half-overwrite or treated
- as opaque.
- #do
- dest := load (bitcast dest @voidstar)
- assert ((dest == null) or (arcptr? dest))
- setptrptr dest
+ arcinitptr
+ incptr dest offset
arcpointer-offsets ST
- verify-integrity;
+ store (autocopy source) dest
+ #verify-integrity;
;
inline copy& (...)
@@ 2341,7 582,10 @@ type+ softarc@
inline __hard (self)
cls := typeof self
- bitcast (archarden (storagecast self)) (arc@ cls.ElementType)
+ ptr := archarden (storagecast self)
+ if (ptr == null)
+ raise;
+ bitcast ptr (arc@ cls.ElementType)
inline __soft (self) self
@@ 2354,36 598,31 @@ type+ softarc@
fn __storageprinter (self print)
ptr := storagecast (view self)
- try
- softarc-validate ptr
- then (ptr)
+ result := archarden_verbose ptr
+ err := result._1
+ switch err
+ case ArcGood
+ ptr := result._0
print (/arc ptr)
- except (err)
- if (err == 'Null)
+ arcfree ptr
+ default
+ if (err == ArcIsNull)
print
Styled.Number "null"
return;
- ptr version := ptr-harden ptr
print
- Styled.Number "0x" /.. (/hex (ptrtoint ptr intptr))
- /..
- Styled.Operator "v"
- /..
- /hex version
+ Styled.Number "0x" /.. (/hex ptr)
switch err
- case 'ActuallyHard
+ case ArcActuallyHard
print
Styled.Error "<corrupt: looks like a hard pointer>"
- case 'Unrecognizable
+ case ArcUnrecognizable
print
Styled.Error "<corrupt: unrecognizable>"
- case 'OutOfArcRange
- print
- Styled.Error "<corrupt: not an arcpointer>"
- case 'Dead
+ case ArcDead
print
Styled.Error "<lost: dead>"
- case 'Moved
+ case ArcMoved
print
Styled.Error "<lost: moved>"
default
@@ 2461,7 700,7 @@ type+ arc@
spice __store (target value volatile?)
spice-quote
- assert (not ptr-soft? (view target))
+ assert (nativeptr? (view target))
arcstore value target volatile?
spice __load (value volatile?)
@@ 2472,8 711,8 @@ type+ arc@
validate := (sc_expression_new)
sc_expression_append validate
spice-quote
- assert (not ptr-soft? (view value))
- "arcpointer appears to be soft"
+ assert (nativeptr? (view value))
+ "cannot load from non-native arcpointer"
if ('plain? ('elementof T))
spice-quote
validate
@@ 2488,13 727,6 @@ type+ arc@
spice-quote
validate
result := load (bitcast (view value) NT)
- spice-unquote
- if (USE_AIC and (('elementof T) <= this-type))
- spice-quote
- if ((arcptr? result) and (not pointerpointer? value))
- report "warning: loading pointer from untagged arcmem address"
- else
- `()
result := copy result
drop value
result
@@ 2578,19 810,31 @@ inline memset (...)
static-error "memset is unsafe; use arcmemsetn"
do
+ let assign
+ let store memcpy memset
+ let archangle
+ let first last prev next tell rtell seek seek% prev% next% rtellcap
+ let resize
+ let arc@ softarc@ new soft ~arc@
+ let arc& copy&
+ let share share&
+ let archash popswap swap
+ let arcmemcopyn arcmemsetn
+ let /arc /arcdata /arcdebugdata
+ let arcmem-check
+ let arcpointer-offsets arcintptr
+ let hard soft soft?
+ locals;
+#do
let arcmalloc arcshare arcfree archangle arcinit arcresize arctrunc
let /arc /arcdata /arcdebugdata
let arcmem-check hard soft soft?
let arcmemcopyn arcmemsetn
let __arcmemcpy = arcmemcpy
let __arcmemset = arcmemset
- let first last prev next tell rtell rtellcap seek seek% prev% next% resize
- let arc@ softarc@ new soft ~arc@
- let arc& copy&
let HangleMethod
let arcsoften archarden ptr-harden
let arcwrite arcread ArcWriter ArcReader
- let archash popswap swap
let arcpointer-offsets arcintptr
let arccat arccat1
let share share&