Routines for copying, comparing, creating and destroying block values, and for reading and writing them as if they were arrays.
- §1. Overview
- §2. Short Block Format
- §3. Long Block Access
- §4. Weak Kind
- §5. Reference counting
- §6. Changing Reference Counts
- §7. Long Block Capacity
- §8. Long Block Array Access
- §9. First Zero Entry
- §10. Mass Copy Entries
- §11. Mass Copy From Array
- §12. Creation
- §13. Errors
- §14. Short Block Allocation
- §15. Long Block Allocation
- §16. Block Values On Stack
- §17. Freeing
- §18. Quick Copy
- §21. Slow Copy
- §22. Copy
- §23. Destruction
- §24. Recycling
- §25. Mutability
- §26. Casting
- §27. Comparison
- §28. Debugging
- §29. Printing Memory Addresses
- §30. Hexadecimal Printing
§1. Overview. Each I7 value is represented at run-time by an I6 word: on the Z-machine, a 16-bit number, and on Glulx, a 32-bit number. The correspondence between these numbers and the original values depends on the kind of value: "number" comes out as a signed twos-complement number, but "time" as an integer number of minutes since midnight, "rulebook" as the index of the rulebook in order of creation, and so on.
Even if a 32-bit number is available, this is not enough to represent the full range of values we might want: consider all the possible hundred-word essays of text, for instance. So for a whole range of kinds — "text", "list of K", "stored action" and so on — the I6 value at run-time is only a pointer to what is called a "short block". This is typically only a few words long, and often only a single word: hence the term "short". It has no header or other overhead, and its contents depend on the kind of value.
If we know that a given kind of value can be stored in, say, exactly 128 bits, then it's possible simply to store the whole thing in the short block. More often, though, the data needs to be flexible in size, or needs to be large. In that case, the short block will include (and sometimes, will consist only of) a pointer to data stored in a "long block". Unlike the short block, the long block is a chunk of memory stored using the Flex system, and thus is genuinely a "block" in the sense of the Flex documentation.
It's possible to have several different short blocks each pointing to the same long block of underlying data: for example, the result of the I7 code
let L1 be { 2, 3, 5, 7, 11 }; let L2 be L1;
is to create L1 and L2 as pointers to two different short blocks, but the two SBs each point to the same long block, which contains the data for the list 2, 3, 5, 7, 11. Note that this makes it very fast to copy L1's contents into L2, because only L2's short block needs to change.
The rules for customers who want to deal with values like this are much like the rules for allocating memory with Flex. Calling BlkValueCreate creates a new value, but this must always, and only once, later be disposed of using BlkValueFree.
So if the short blocks of L1 and L2 both point to the same long block of actual data, what happens when only one of them is freed? The answer is that every long block has a reference count attached, which counts the number of short blocks pointing to it. In our example, this count is 2. If list L1 is freed, the long block's reference count is decremented to 1, but it remains in memory, and only L1's short block is given up; when list L2 is subsequently freed, both its short block and the now unwanted long block are given up.
The harder case to handle is what happens when L1 and L2 share a long block containing 2, 3, 5, 7, 11, but when the source text asks to "add 13 to L1". If we simply changed the long block, that would affect L2 as well. So we must first make L1 "mutable". This means copying the long block to make a new unique copy with reference count 1; assigning that to L1 in place of the original; and decrementing the reference count of the original from 2 to 1. L1 and L2 now point to two different long blocks, so it's safe to modify L1's.
Subtle and beautiful bugs can occur as a result of making a value mutable at the wrong moment. Beware in particular of reading data out of a long block, then writing it back again, because the act of writing may force the value owning the long block to become mutable; this will make a new copy of the data; but you will be left holding the old copy. Since these are functionally identical, you may not even notice, but calamities will occur later because the version of the value you're holding really belongs to somebody else and may be freed at any point.
Finally, note that the I7 compiler also creates block values representing constants. For example, the source text
let L1 be { 2, 3, 5, 7, 11 };
causes a block value representing this list to be stored in memory. The long block for a constant needs to be immortal, since this memory must never be freed: it's therefore given a reference count of "infinity".
Constant RC_INFINITY = MAX_POSITIVE_NUMBER;
§2. Short Block Format. A short block begins with a word which is usually, but not always, a pointer to the long block. There are three possibilities:
- (a) 0 means the short block has length 1 and the long block begins at the very next word in memory. This makes it more convenient for I7 to compile BV constants, but isn't otherwise used.
- (b) 1 to 255 means the short block has length 2 or more. The value is expected to be a bitmap in bits 4 to 8 together with a nonzero ID in bits 1 to 4. If the BLK_BVBITMAP_LONGBLOCK bit is set, a pointer to the long block is stored in the second word of the short block.
- (c) Otherwise the short block has length 1 and contains only a pointer to the long block.
Constant BLK_BVBITMAP = $ff; Constant BLK_BVUSERBITMAP = $0f; Constant BLK_BVBITMAP_LONGBLOCK = $10; Word 1 of SB is pointer to LB Constant BLK_BVBITMAP_TEXT = $20; BV holds a TEXT_TY value Constant BLK_BVBITMAP_CONSTANT = $40; BV holds a constant value Constant BLK_BVBITMAP_SBONLY = $80; No LB, and kind ID is in word 1 of SB #IFTRUE WORDSIZE == 4; Constant BLK_BVBITMAP_USERBITMAPMASK = $fffffff0; Constant BLK_BVBITMAP_LONGBLOCKMASK = $ffffff10; Constant BLK_BVBITMAP_TEXTMASK = $ffffff20; Constant BLK_BVBITMAP_CONSTANTMASK = $ffffff40; #IFNOT; Constant BLK_BVBITMAP_USERBITMAPMASK = $fff0; Constant BLK_BVBITMAP_LONGBLOCKMASK = $ff10; Constant BLK_BVBITMAP_TEXTMASK = $ff20; Constant BLK_BVBITMAP_CONSTANTMASK = $ff40; #ENDIF;
§3. Long Block Access. Illustrating this:
[ BlkValueGetLongBlock bv o; if (bv) { o = bv-->0; if (o == 0) return bv + WORDSIZE; if (o & BLK_BVBITMAP == o) { if (o & BLK_BVBITMAP_LONGBLOCK) return bv-->1; return 0; } return o; } return bv; ];
§4. Weak Kind. This returns the weak kind ID of a block value. Most of the time this information is stored in the long block, but that poses a problem for BVs which have no long block: we must use the bitmap instead.
[ BlkValueWeakKind bv o; if (bv) { o = bv-->0; if (o == 0) return bv-->(BLK_HEADER_KOV+1); if (o & BLK_BVBITMAP == o) { if (o & BLK_BVBITMAP_TEXT) return TEXT_TY; if (o & BLK_BVBITMAP_SBONLY) return KindWeakID(bv-->1); o = bv-->1; } return o-->BLK_HEADER_KOV; } return NIL_TY; ];
§5. Reference counting. Reference counts lie in a word at a fixed offset from the start of the long block: doctrinally, any block value with no long block at all (such as a piece of packed text) has reference count infinity.
[ BlkValueGetRefCountPrimitive bv long_block; long_block = BlkValueGetLongBlock(bv); if (long_block) return long_block-->BLK_HEADER_RCOUNT; return RC_INFINITY; ];
§6. Changing Reference Counts. When incrementing, infinity's the limit; when decrementing, it never reduces. Note that the decrement function returns the new reference count, but the increment function returns nothing. It's only when reference counts go downwards that we have to worry about whether something happens.
[ BlkValueIncRefCountPrimitive bv long_block refc; long_block = BlkValueGetLongBlock(bv); if (long_block) { refc = long_block-->BLK_HEADER_RCOUNT; if (refc < RC_INFINITY) long_block-->BLK_HEADER_RCOUNT = refc + 1; } ]; [ BlkValueDecRefCountPrimitive bv long_block refc; long_block = BlkValueGetLongBlock(bv); if (long_block) { refc = long_block-->BLK_HEADER_RCOUNT; if (refc < RC_INFINITY) { refc--; if (refc < 0) BlkValueError("reference count negative"); long_block-->BLK_HEADER_RCOUNT = refc; } return refc; } if ((bv-->0) & BLK_BVBITMAP_SBONLY) return 0; return RC_INFINITY; ];
§7. Long Block Capacity. As we've seen, the long block has some metadata in a header, but otherwise it's organised as if it were an array, with byte or word-sized entries. At any given time, the "capacity" of the LB is the number of entries in this array: that doesn't mean that the BV is using them all at any given moment.
[ BlkValueLBCapacity bv long_block array_size_in_bytes; long_block = BlkValueGetLongBlock(bv); if (long_block == 0) return 0; array_size_in_bytes = FlexTotalSize(long_block); if ((long_block->BLK_HEADER_FLAGS) & BLK_FLAG_WORD) return array_size_in_bytes / WORDSIZE; return array_size_in_bytes; ]; [ BlkValueSetLBCapacity bv new_capacity long_block; if (bv == 0) rfalse; BlkMakeMutable(bv); long_block = BlkValueGetLongBlock(bv); if (long_block == 0) rfalse; if ((long_block->BLK_HEADER_FLAGS) & BLK_FLAG_WORD) FlexResize(long_block, new_capacity*WORDSIZE); else FlexResize(long_block, new_capacity); rtrue; ];
§8. Long Block Array Access. Though the customer thinks he's getting an array, in fact the storage in the LB is not necessarily contiguous, since it can span multiple Flex blocks. We abstract that with two routines to read and write entries.
BlkValueRead takes two compulsory arguments and one optional one. Thus:
BlkValueRead(bv, n)
reads the nth entry in the long block for bv, whereas
BlkValueRead(long_block, n, true)
read it from the given long block directly. BlkValueWrite is similar.
[ BlkValueRead from pos do_not_indirect; if (do_not_indirect) return BlkValueReadLB(from, pos); return BlkValueReadSB(from, pos); ]; [ BlkValueReadLB from pos long_block chunk_size_in_bytes header_size_in_bytes flags seek_byte_position; long_block = from; if (long_block == 0) rfalse; flags = long_block->BLK_HEADER_FLAGS; if (flags & BLK_FLAG_MULTIPLE) header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else header_size_in_bytes = BLK_DATA_OFFSET; seek_byte_position = pos; if (flags & BLK_FLAG_WORD) seek_byte_position = seek_byte_position*WORDSIZE; for (: long_block~=NULL: long_block=long_block-->BLK_NEXT) { chunk_size_in_bytes = FlexSize(long_block) - header_size_in_bytes; if ((seek_byte_position >= 0) && (seek_byte_position<chunk_size_in_bytes)) { long_block = long_block + header_size_in_bytes + seek_byte_position; if (flags & BLK_FLAG_WORD) return long_block-->0; else return long_block->0; } seek_byte_position = seek_byte_position - chunk_size_in_bytes; } print_ret "*** BlkValueRead: reading from index out of range: ", pos, " in ", from, " ***"; ]; [ BlkValueReadSB from pos long_block chunk_size_in_bytes header_size_in_bytes flags seek_byte_position; if (from == 0) rfalse; long_block = BlkValueGetLongBlock(from); flags = long_block->BLK_HEADER_FLAGS; if (flags & BLK_FLAG_MULTIPLE) header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else header_size_in_bytes = BLK_DATA_OFFSET; seek_byte_position = pos; if (flags & BLK_FLAG_WORD) seek_byte_position = seek_byte_position*WORDSIZE; for (: long_block~=NULL: long_block=long_block-->BLK_NEXT) { chunk_size_in_bytes = FlexSize(long_block) - header_size_in_bytes; if ((seek_byte_position >= 0) && (seek_byte_position<chunk_size_in_bytes)) { long_block = long_block + header_size_in_bytes + seek_byte_position; if (flags & BLK_FLAG_WORD) return long_block-->0; else return long_block->0; } seek_byte_position = seek_byte_position - chunk_size_in_bytes; } print_ret "*** BlkValueRead: reading from index out of range: ", pos, " in ", from, " ***"; ]; [ BlkValueWrite to pos val do_not_indirect; if (do_not_indirect) return BlkValueWriteLB(to, pos, val); return BlkValueWriteSB(to, pos, val); ]; [ BlkValueWriteSB to pos val long_block chunk_size_in_bytes header_size_in_bytes flags seek_byte_position; if (to == 0) rfalse; BlkMakeMutable(to); long_block = BlkValueGetLongBlock(to); flags = long_block->BLK_HEADER_FLAGS; if (flags & BLK_FLAG_MULTIPLE) header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else header_size_in_bytes = BLK_DATA_OFFSET; seek_byte_position = pos; if (flags & BLK_FLAG_WORD) seek_byte_position = seek_byte_position*WORDSIZE; for (:long_block~=NULL:long_block=long_block-->BLK_NEXT) { chunk_size_in_bytes = FlexSize(long_block) - header_size_in_bytes; if ((seek_byte_position >= 0) && (seek_byte_position<chunk_size_in_bytes)) { long_block = long_block + header_size_in_bytes + seek_byte_position; if (flags & BLK_FLAG_WORD) { long_block-->0 = val; return; } long_block->0 = val; return; } seek_byte_position = seek_byte_position - chunk_size_in_bytes; } print_ret "*** BlkValueWrite: writing to index out of range: ", pos, " in ", to, " ***"; ]; [ BlkValueWriteLB to pos val long_block chunk_size_in_bytes header_size_in_bytes flags entry_size_in_bytes seek_byte_position; long_block = to; if (long_block == 0) rfalse; flags = long_block->BLK_HEADER_FLAGS; if (flags & BLK_FLAG_MULTIPLE) header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else header_size_in_bytes = BLK_DATA_OFFSET; seek_byte_position = pos; if (flags & BLK_FLAG_WORD) seek_byte_position = seek_byte_position*WORDSIZE; for (:long_block~=NULL:long_block=long_block-->BLK_NEXT) { chunk_size_in_bytes = FlexSize(long_block) - header_size_in_bytes; if ((seek_byte_position >= 0) && (seek_byte_position<chunk_size_in_bytes)) { long_block = long_block + header_size_in_bytes + seek_byte_position; if (flags & BLK_FLAG_WORD) { long_block-->0 = val; return; } long_block->0 = val; return; } seek_byte_position = seek_byte_position - chunk_size_in_bytes; } print_ret "*** BlkValueWriteLB: writing to index out of range: ", pos, " in ", to, " ***"; ];
§9. First Zero Entry. This returns the entry index of the first zero entry in the long block's array, or -1 if it has no zeros.
[ BlkValueSeekZeroEntry from long_block chunk_size_in_bytes header_size_in_bytes flags byte_position addr from_addr to_addr; if (from == 0) return -1; long_block = BlkValueGetLongBlock(from); flags = long_block->BLK_HEADER_FLAGS; if (flags & BLK_FLAG_MULTIPLE) header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else header_size_in_bytes = BLK_DATA_OFFSET; byte_position = 0; for (: long_block~=NULL: long_block=long_block-->BLK_NEXT) { chunk_size_in_bytes = FlexSize(long_block) - header_size_in_bytes; from_addr = long_block + header_size_in_bytes; to_addr = from_addr + chunk_size_in_bytes; if (flags & BLK_FLAG_WORD) { for (addr = from_addr: addr < to_addr: addr=addr + WORDSIZE) if (addr-->0 == 0) return (byte_position + addr - from_addr)/WORDSIZE; } else { for (addr = from_addr: addr < to_addr: addr++) if (addr->0 == 0) return byte_position + addr - from_addr; } byte_position = byte_position + chunk_size_in_bytes; } return -1; ];
§10. Mass Copy Entries. This copies a given number of entries from one BV's long block to another; they must both be of the same word size but can differ in header size. Functionally, it's identical to
for (n=0: n<no_entries_to_copy: n++) BlkValueWrite(to_bv, n, BlkValueRead(from_bv, n));
but it's much, much faster, and runs in a reasonably small number of cycles given what it needs to do.
[ BlkValueMassCopyEntries to_bv from_bv no_entries_to_copy from_long_block from_addr from_bytes_left from_header_size_in_bytes to_long_block to_addr to_bytes_left to_header_size_in_bytes bytes_to_copy flags min; BlkMakeMutable(to_bv); from_long_block = BlkValueGetLongBlock(from_bv); to_long_block = BlkValueGetLongBlock(to_bv); flags = from_long_block->BLK_HEADER_FLAGS; if ((flags & (BLK_FLAG_MULTIPLE + BLK_FLAG_TRUNCMULT)) && (BlkValueSetLBCapacity(to_bv, no_entries_to_copy) == false)) BlkValueError("copy resizing failed"); if (flags & BLK_FLAG_MULTIPLE) from_header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else from_header_size_in_bytes = BLK_DATA_OFFSET; flags = to_long_block->BLK_HEADER_FLAGS; if (flags & BLK_FLAG_MULTIPLE) to_header_size_in_bytes = BLK_DATA_MULTI_OFFSET; else to_header_size_in_bytes = BLK_DATA_OFFSET; from_addr = from_long_block + from_header_size_in_bytes; from_bytes_left = FlexSize(from_long_block) - from_header_size_in_bytes; to_addr = to_long_block + to_header_size_in_bytes; to_bytes_left = FlexSize(to_long_block) - to_header_size_in_bytes; bytes_to_copy = no_entries_to_copy; if (flags & BLK_FLAG_WORD) bytes_to_copy = bytes_to_copy*WORDSIZE; while (true) { if (from_bytes_left == 0) { from_long_block = from_long_block-->BLK_NEXT; if (from_long_block == 0) BlkValueError("copy destination exhausted"); from_addr = from_long_block + from_header_size_in_bytes; from_bytes_left = FlexSize(from_long_block) - from_header_size_in_bytes; } else if (to_bytes_left == 0) { to_long_block = to_long_block-->BLK_NEXT; if (to_long_block == 0) BlkValueError("copy source exhausted"); to_addr = to_long_block + to_header_size_in_bytes; to_bytes_left = FlexSize(to_long_block) - to_header_size_in_bytes; } else { min = from_bytes_left; if (to_bytes_left < min) min = to_bytes_left; if (bytes_to_copy <= min) { Memcpy(to_addr, from_addr, bytes_to_copy); return; } Memcpy(to_addr, from_addr, min); bytes_to_copy = bytes_to_copy - min; from_addr = from_addr + min; from_bytes_left = from_bytes_left - min; to_addr = to_addr + min; to_bytes_left = to_bytes_left - min; } } ];
§11. Mass Copy From Array. The following is helpful when reading an array of characters into a text:
[ BlkValueMassCopyFromArray to_bv from_array from_entry_size no_entries_to_copy to_long_block to_addr to_entries_left to_header_size to_entry_size flags; BlkMakeMutable(to_bv); to_long_block = BlkValueGetLongBlock(to_bv); flags = to_long_block->BLK_HEADER_FLAGS; to_entry_size = 1; if (flags & BLK_FLAG_WORD) to_entry_size = WORDSIZE; if ((flags & (BLK_FLAG_MULTIPLE + BLK_FLAG_TRUNCMULT)) && (BlkValueSetLBCapacity(to_bv, no_entries_to_copy) == false)) BlkValueError("copy resizing failed"); if (flags & BLK_FLAG_MULTIPLE) to_header_size = BLK_DATA_MULTI_OFFSET; else to_header_size = BLK_DATA_OFFSET; to_addr = to_long_block + to_header_size; to_entries_left = (FlexSize(to_long_block) - to_header_size)/to_entry_size; while (no_entries_to_copy > to_entries_left) { Arrcpy(to_addr, to_entry_size, from_array, from_entry_size, to_entries_left); no_entries_to_copy = no_entries_to_copy - to_entries_left; from_array = from_array + to_entries_left*from_entry_size; to_long_block = to_long_block-->BLK_NEXT; if (to_long_block == 0) BlkValueError("copy source exhausted"); to_addr = to_long_block + to_header_size; to_entries_left = (FlexSize(to_long_block) - to_header_size)/to_entry_size; } if (no_entries_to_copy > 0) { Arrcpy(to_addr, to_entry_size, from_array, from_entry_size, no_entries_to_copy); } ];
§12. Creation. To create a block value, call:
BlkValueCreate(kind)
where K is its (strong) kind ID. Optionally, call:
BlkValueCreate(K, short_block)
to mandate that the short block needs to be located at the given address outside the heap: but don't do this unless you can guarantee that space of the necessary length will be available there for as long as the lifetime of the value; and please note, it really does matter that this address lies outside the heap, for reasons to be seen below.
These work by delegating to the kind's creator function, which returns the address of the short block for the new value.
[ BlkValueCreate strong_kind short_block creator; creator = ReadKindMetadata(strong_kind, CREATE_FN_KMF); short_block = creator(strong_kind, short_block); #ifdef LKTRACE_HEAP; print "Created: ", (BlkValueDebug) short_block, "^"; #endif; The new value is represented in I6 as the pointer to its short block: return short_block; ];
§13. Errors. No I7 source text should ever result in a call to this, unless it does unpleasant things at the I6 level.
[ BlkValueError reason; IssueRTP("MemoryAllocationFailed", "Memory allocation proved impossible.", BasicInformKitRTPs); print "*** Value handling failed: ", (string) reason, " ***^"; @quit; ];
§14. Short Block Allocation. As can be seen, if the sb_address is zero then we need to conjure up memory from somewhere: we do this using Flex. That incurs a fair amount of overhead in time and memory, though. The SB data is stored in the data portion of the Flex block, which is why we get its address from by adding the data offset to the block address.
[ BlkValueCreateSB sb_address size; if (sb_address == 0) sb_address = FlexAllocate(size*WORDSIZE, 0, BLK_FLAG_WORD) + BLK_DATA_OFFSET; return sb_address; ];
[ BlkValueCreateLB extent weak_id; return FlexAllocate(extent*WORDSIZE, weak_id, BLK_FLAG_WORD); ]; [ BlkValueCreateMultipleLB extent weak_id; return FlexAllocate(extent*WORDSIZE, weak_id, BLK_FLAG_MULTIPLE + BLK_FLAG_WORD); ];
§16. Block Values On Stack. As noted above, it's wasteful to keep allocating short blocks using Flex. For the short blocks of block values in local variables, we store them on a stack instead. This is a top-down stack, so the current stack frame starts out just after the end of the stack area in memory (and therefore points to an empty stack frame); it drops down as new frames are created.
BlkValueCreateOnStack acts exactly like BlkValueCreate, but stores the short block at the given word offset in the current stack frame. (I7 compiles calls to these routines when compiling code to manage local variables.)
[ StackFramingInitialise; I7SFRAME = blockv_stack + WORDSIZE*BLOCKV_STACK_SIZE; ]; [ StackFrameCreate size new; new = I7SFRAME - WORDSIZE*size; if (new < blockv_stack) { IssueRTP("MemoryAllocationFailed", "Memory allocation proved impossible.", BasicInformKitRTPs); print "*** Stack frame of ", size, " could not be created ***^"; @quit; } I7SFRAME = new; ]; [ BlkValueCreateOnStack offset strong_kind; BlkValueCreate(strong_kind, I7SFRAME + WORDSIZE*offset); ]; [ BlkValueFreeOnStack offset; BlkValueFree(I7SFRAME + WORDSIZE*offset); ];
§17. Freeing. As noted above, every value returned by BlkValueCreate must later be freed by calling the following routine exactly once:
BlkValueFree(value)
In particular, if a block value is stored in any I6 location which is about to be overwritten with a new value, it's essential to call this in order properly to dispose of the old value.
As noted above, short blocks are sometimes created within Flex blocks on the heap, using FlexAllocate; and if this is one of those, we need to free the relevant Flex block.
[ BlkValueFree bv d; if (bv == 0) return; BlkValueDestroyPrimitive(bv); Free any heap memory occupied by the short block d = bv - Flex_Heap; if ((d >= 0) && (d < MEMORY_HEAP_SIZE + 16)) FlexFree(bv - BLK_DATA_OFFSET); ];
§18. Quick Copy. The basic method of copying block value B into block value A is to destroy the old contents of A, which are about to be overwritten; then copy the short block of A into the short block of B, a quick process; and increment the reference count of B.
[ BlkValueQuickCopyPrimitive to_bv from_bv to_kind; BlkValueDestroyPrimitive(to_bv); BlkValueCopyShortBlocks(to_bv, from_bv, to_kind); BlkValueIncRefCountPrimitive(from_bv); ];
§19. Short blocks can mostly be copied automatically, but we provide a hook for kinds to intervene.
[ BlkValueCopyShortBlocks to_bv from_bv to_kind sb_size sbc_function; sbc_function = ReadKindMetadata(to_kind, COPY_SHORT_BLOCK_FN_KMF); if (sbc_function) { sbc_function(to_bv, from_bv); } else { sb_size = ReadKindMetadata(to_kind, SHORT_BLOCK_SIZE_KMF); BlkValueCopySB(to_bv, from_bv, sb_size); } ];
§20. The surprising line in this function is the last one, to deal with the convention that a pointer value of 0 means the LB immediately follows the SB: if that's true in from_bv, it won't be true in to_bv, so we must correct it.
[ BlkValueCopySB to_bv from_bv size i; switch (size) { 1: to_bv-->0 = from_bv-->0; if (to_bv-->0 == 0) to_bv-->0 = from_bv + WORDSIZE; return; 2: to_bv-->0 = from_bv-->0; to_bv-->1 = from_bv-->1; if (to_bv-->1 == 0) to_bv-->1 = from_bv + 2*WORDSIZE; return; default: for (i=0: i<size: i++) to_bv-->i = from_bv-->i; i = size-1; if (to_bv-->i == 0) to_bv-->i = from_bv + size*WORDSIZE; return; } ];
§21. Slow Copy. Why don't we always do this? Consider the case where B is a list of rooms, and A is a list of objects. If we give A's short block a pointer to the long block of B, A will suddenly change its kind as well as its contents, because the strong kind of a list is stored inside the long block. So there are a few cases where it's not safe to make a quick copy. In any case, sooner or later you have to duplicate actual data, not just rearrange pointers to it, and here's where.
[ BlkValueSlowCopyPrimitive to_bv from_bv kind recycling copy_fn; copy_fn = ReadKindMetadata(kind, COPY_FN_KMF); if (copy_fn) copy_fn(to_bv, from_bv, kind, recycling); ]; [ BlkValueCopyRawLongBlock to_bv from_bv kind recycling from_long_block no_entries_to_copy extent_fn; from_long_block = BlkValueGetLongBlock(from_bv); if (from_long_block) { if (recycling) BlkValueRecyclePrimitive(to_bv, kind); extent_fn = ReadKindMetadata(kind, LONG_BLOCK_SIZE_KMF); if (extent_fn ofclass Routine) no_entries_to_copy = extent_fn(from_bv); else extent_fn = no_entries_to_copy; if (no_entries_to_copy <= 0) no_entries_to_copy = BlkValueLBCapacity(from_bv); BlkValueMassCopyEntries(to_bv, from_bv, no_entries_to_copy); } ];
§22. Copy. As noted above, some copies are quick, and some are slow. If the kind provides a quick-copy function, we call to ask its permission to make a quick copy: otherwise we go ahead and make one.
[ BlkValueCopy to_bv from_bv to_kind from_kind quick_copy_fn; if (to_bv == 0) BlkValueError("copy to null value"); if (from_bv == 0) BlkValueError("copy from null value"); if (to_bv == from_bv) return; #ifdef LKTRACE_HEAP; print "Copy: ", (BlkValueDebug) to_bv, " to equal ", (BlkValueDebug) from_bv, "^"; #endif; to_kind = BlkValueWeakKind(to_bv); from_kind = BlkValueWeakKind(from_bv); if (to_kind ~= from_kind) BlkValueError("copy incompatible kinds"); quick_copy_fn = ReadKindMetadata(to_kind, QUICK_COPY_FN_KMF); if ((quick_copy_fn) && (quick_copy_fn(to_bv, from_bv) == false)) BlkValueSlowCopyPrimitive(to_bv, from_bv, to_kind, true); else if (to_bv-->0 & BLK_BVBITMAP_SBONLY) BlkValueSlowCopyPrimitive(to_bv, from_bv, to_kind, true); else BlkValueQuickCopyPrimitive(to_bv, from_bv, to_kind); return to_bv; ];
§23. Destruction. We will also need primitives for two different forms of destruction. This is something which should happen whenever a block value is thrown away, not to be used again: either because it's being freed, or because new contents are being copied into it.
The idea of destruction is that any data stored in the long block should safely be disposed of. If the reference count of the long block is 2 or more, there's no problem, because we can simply decrement the count and let other people worry about the data from now on. But if it's only 1, then destroying the data is on us. Since we don't know what's in the long block, we have to ask the kind's destroy function to do it for us.
Note that all of this frequently causes recursion: destruction leads to freeing of some of the data, which in turn means that that data must be destroyed, and so on. So it's essential that block values be well-founded: a list must not, for example, contain itself.
[ BlkValueDestroyPrimitive bv destructor long_block; #ifdef LKTRACE_HEAP; print "Destroying ", (BlkValueDebug) bv, "^"; #endif; if (BlkValueDecRefCountPrimitive(bv) == 0) { destructor = ReadKindMetadata(BlkValueWeakKind(bv), DESTROY_FN_KMF); if (destructor) destructor(bv); long_block = BlkValueGetLongBlock(bv); if (long_block) FlexFree(long_block); } ];
§24. Recycling. This is like destruction in that it disposes of the value safely, but it tries to keep the long block for reuse, rather than deallocating it. This won't work if other people are still using it, so in the case where its reference count is 2 or more, we simply reduce the count by 1 and then replace the small block with a new one (at the same address).
[ BlkValueRecyclePrimitive bv kind destructor; #ifdef LKTRACE_HEAP; print "Recycling ", (BlkValueDebug) bv, "^"; #endif; if (BlkValueDecRefCountPrimitive(bv) == 0) { destructor = ReadKindMetadata(kind, DESTROY_FN_KMF); if (destructor) destructor(bv); BlkValueIncRefCountPrimitive(bv); } else { BlkValueCreate(BlkValueWeakKind(bv), bv); } ];
§25. Mutability. A block value is by definition mutable if it has a long block with reference count 1, because then the data in the long block can freely be changed without corrupting other block values.
If provided, a make-mutable function should either act on its own behalf and return false, or ask us to proceed by returning true.
The way we do this is to create a temporary value to make a safe copy into; it would be unnecessarily slow to allocate the short block for this safe copy on the heap and then free it again moments later, so instead we put the short block on the stack, making a temporary one-value stack frame instead to hold it.
[ BlkMakeMutable bv block bv_kind make_mutable_function sb_size; if (bv == 0) BlkValueError("tried to make null block mutable"); if (BlkValueGetRefCountPrimitive(bv) > 1) { #ifdef LKTRACE_HEAP; print "Make mutable: ", (BlkValueDebug) bv, "^"; #endif; BlkValueDecRefCountPrimitive(bv); bv_kind = BlkValueWeakKind(bv); make_mutable_function = ReadKindMetadata(bv_kind, MAKE_MUTABLE_FN_KMF); if ((make_mutable_function) && (make_mutable_function(bv) == false)) return; sb_size = ReadKindMetadata(bv_kind, SHORT_BLOCK_SIZE_KMF); if (sb_size > 0) { @push I7SFRAME; StackFrameCreate(sb_size); BlkValueCreateOnStack(0, bv_kind); BlkValueSlowCopyPrimitive(I7SFRAME, bv, bv_kind, false); BlkValueCopyShortBlocks(bv, I7SFRAME, bv_kind); @pull I7SFRAME; } } ];
§26. Casting. We can also perform an assignment to an already-created block value in the form of a cast, that is, a conversion of data from one kind to another: or at least, for some kinds of value we can.
The cast function casts from the given value, with the given kind, into the existing block value to_bv. Note that the source value doesn't need to be a BV itself. This mechanism is used, for example, to cast snippets to text.
[ BlkValueCast to_bv original_kind original_value cast_function; cast_function = ReadKindMetadata(BlkValueWeakKind(to_bv), CAST_FN_KMF); if (cast_function) cast_function(to_bv, original_kind, original_value); return to_bv; ];
§27. Comparison. This looks at the data in the two BVs and returns 0 if they are equal, a positive number if bv_right is "greater than" bv_left, and a negative number if not. The interpretation of "greater than" depends on the kind, but should be something which the user would find natural.
[ BlkValueCompare bv_left bv_right kind_left kind_right cmp_fn; if (bv_left == bv_right) return 0; if (bv_left == 0) return 1; if (bv_right == 0) return -1; kind_left = BlkValueWeakKind(bv_left); kind_right = BlkValueWeakKind(bv_right); if (kind_left ~= kind_right) return kind_left - kind_right; cmp_fn = KindComparisonFunction(kind_left); if (cmp_fn == 0) return BlkValueError("impossible comparison"); return cmp_fn(bv_left, bv_right); ];
§28. Debugging. Surprisingly, the above system of reference-counted double indirection didn't work first time, so it turned out to be useful to have these routines on hand.
[ BlkValueDebug bv flag refc long_block; print "(BV"; if (bv) { BlkDebugAddress(bv, flag); long_block = BlkValueGetLongBlock(bv); if (long_block) { if (bv-->0 == 0) print "..."; else print "-->"; print "L"; BlkDebugAddress(long_block, flag); print " 2**", long_block->BLK_HEADER_N; refc = BlkValueGetRefCountPrimitive(bv); if (refc == RC_INFINITY) print " resident"; else { print " ", refc, " ref"; if (refc ~= 1) print "s"; } } else if ((bv-->0) & BLK_BVBITMAP_SBONLY) print "SBO"; print " = "; SayKindValuePair(BlkValueWeakKind(bv), bv); if (BlkValueWeakKind(bv) == TEXT_TY) TEXT_TY_Debug(bv); } print ")"; ];
§29. Printing Memory Addresses. The point of the anonymity flag is that, with this set, the output can be used as the required output in an Inform test case without tiny movements in memory between builds invalidating this required output.
[ BlkDebugAddress addr flag d; if (flag) { print "###"; return; } d = addr - blockv_stack; if ((d >= 0) && (d <= WORDSIZE*BLOCKV_STACK_SIZE)) { print "s+", (BlkPrintHexadecimal) d; d = addr - I7SFRAME; print "=f"; if (d >= 0) print "+"; print d; return; } d = addr - Flex_Heap; if ((d >= 0) && (d < MEMORY_HEAP_SIZE + 16)) { print "h+", (BlkPrintHexadecimal) d; return; } print (BlkPrintHexadecimal) addr; ];
[ BlkPrintHexadecimal v; #iftrue WORDSIZE == 4; if (v & $ffff0000) { if (v & $ff000000) { BlkPrintHexDigit(v / $10000000); BlkPrintHexDigit(v / $1000000); } BlkPrintHexDigit(v / $100000); BlkPrintHexDigit(v / $10000); } #endif; BlkPrintHexDigit(v / $1000); BlkPrintHexDigit(v / $100); BlkPrintHexDigit(v / $10); BlkPrintHexDigit(v); ]; [ BlkPrintHexDigit v; v = v & $F; if (v < 10) print v; else print (char) 'A' + v - 10; ];