Version 1 of Block Value Management via Malloc (for Glulx only) by Brady Garvin begins here.

"Part of a discussion on IntFiction, not meant for use in an actual story."

Use authorial modesty.

[Just to be clear, this code is embarrassingly ugly and hacky.  Hopefully I'll find some time to clean it up.]

Book "Nonresident Allocation"

Include (-
	Global nonresidentAllocation=0;
-) after "Definitions.i6t".
The nonresident allocation flag is a truth state that varies.
The nonresident allocation flag variable translates into I6 as "nonresidentAllocation".
This is the switch to nonresident allocation rule:
	now the nonresident allocation flag is true.
The switch to nonresident allocation rule is listed before the virtual machine startup rule in the startup rulebook.

Book "Flex.i6t"

Include (-

! Layout of a nonresident multiblock block (which is in fact not multiblock, but a stub with a pointer to data):
! 	1 byte for the binary logarithm of the block size
! 	1 byte for flags (BLK_FLAG_MULTIPLE, BLK_FLAG_16_BIT, BLK_FLAG_WORD, and/or BLK_FLAG_RESIDENT)
! 	2 bytes padding
! 	4 bytes for the base kind
! 	<--BLK_DATA_OFFSET is the byte offset to here; 8 bytes
! 	<--BLK_DATA_WORD_OFFSET is the word offset to here; 2 words = 8 bytes
! 	4 bytes for the data pointer

! Layout of all other blocks:
! 	<--BLK_HEADER_N is the byte offset to here; 0 bytes
! 	1 byte for the binary logarithm of the block size
! 	<--BLK_HEADER_FLAGS is the byte offset to here; 1 byte
! 	1 byte for flags (BLK_FLAG_MULTIPLE, BLK_FLAG_16_BIT, BLK_FLAG_WORD, and/or BLK_FLAG_RESIDENT)
! 	2 bytes padding
! 	<--BLK_HEADER_KOV is the word offset to here; 1 word = 4 bytes
! 	4 bytes for the base kind
! 	<--BLK_DATA_OFFSET is the byte offset to here; 8 bytes
! 	<--BLK_DATA_WORD_OFFSET is the word offset to here; 2 words = 8 bytes
! 	<--BLK_NEXT is the word offset to here; 2 words = 8 bytes
! 	4 (optional) bytes for the next pointer of a multiblock header
! 	<--BLK_PREV is the word offset to here; 3 words = 12 bytes
! 	4 (optional) bytes for the previous pointer of a multiblock header

! Copied from Flex.i6t
Constant BLK_HEADER_N = 0;
Constant BLK_HEADER_FLAGS = 1;
Constant BLK_FLAG_MULTIPLE = $$00000001;
Constant BLK_FLAG_16_BIT = $$00000010;
Constant BLK_FLAG_WORD = $$00000100;
Constant BLK_FLAG_RESIDENT = $$00001000;
Constant BLK_HEADER_KOV = 1;

! A resident multiblock block will have these flags set
Constant BLK_MASK_RESIDENT_MULTI = $$00001001;

! Copied from Flex.i6t
Constant BLK_DATA_OFFSET = 2*WORDSIZE;
! A version of BLK_DATA_OFFSET in terms of words
Constant BLK_DATA_WORD_OFFSET = 2;

! Copied from Flex.i6t
Constant BLK_DATA_MULTI_OFFSET = 4*WORDSIZE;
Constant BLK_NEXT 2;
Constant BLK_PREV 3;

! The size of a nonresident multiblock block
Constant BLK_MULTIBLOCK_STUB_SIZE = 12;
! The minimum size of a nonresident multiblock block's data
Constant BLK_MIN_MULTI_SIZE = 16;

! These routines no longer need to do anything, but do need to appear for the I6 to compile.
[ HeapInitialise a b c; ];
[ DebugHeap; "This story file asks the interpreter to manage the heap."; ];

! Copied from Flex.i6t
[ BlkType block;
	return block-->BLK_HEADER_KOV;
];

! Adapted from Flex.i6t, changed to @shiftl
[ BlkSize block
	logarithmOfTotalSize totalSize;
	if(~~block){
		return 0;
	}
	logarithmOfTotalSize=block->BLK_HEADER_N;
	@shiftl 1 logarithmOfTotalSize totalSize;
	return totalSize;
];

! Adapted from Flex.i6t
[ BlkTotalSize block
	totalSize;
	if(~~block){
		return 0;
	}
	if(((block->BLK_HEADER_FLAGS)&BLK_MASK_RESIDENT_MULTI)==BLK_MASK_RESIDENT_MULTI){
		for(:block~=NULL:block=block-->BLK_NEXT){
			totalSize=totalSize+BlkSize(block);
		}
		return totalSize;
	}
	return BlkSize(block);
];


! Adapted from Flex.i6t
[ BlkAllocate dataSize baseKind flags
	neededSize logarithmOfTotalSize totalSize result dataAddress zeroedBytes;
	if(flags&BLK_FLAG_MULTIPLE){
		if(nonresidentAllocation){
			! anticipate growth
			if(dataSize<BLK_MIN_MULTI_SIZE){
				dataSize=BLK_MIN_MULTI_SIZE;
				logarithmOfTotalSize=8;
				totalSize=BLK_MIN_MULTI_SIZE;
			}else{
				logarithmOfTotalSize=0;
				for(totalSize=1:totalSize<dataSize:totalSize=totalSize*2){
					++logarithmOfTotalSize;
				}
			}
			@malloc BLK_MULTIBLOCK_STUB_SIZE result;
			@malloc totalSize dataAddress;
			if((~~result)||(~~dataAddress)){
				return BlkAllocationError("ran out");
			}
			result-->BLK_DATA_WORD_OFFSET=dataAddress;
			zeroedBytes=totalSize;
		}else{
			flags=flags|BLK_FLAG_RESIDENT;
			neededSize=dataSize+BLK_DATA_MULTI_OFFSET;
			logarithmOfTotalSize=9;
			for(totalSize=512:totalSize<neededSize:totalSize=totalSize*2){
				++logarithmOfTotalSize;
			}
			@malloc totalSize result;
			if(~~result){
				return BlkAllocationError("ran out");
			}
			result-->BLK_PREV=NULL;
			result-->BLK_NEXT=NULL;
			dataAddress=result+BLK_DATA_MULTI_OFFSET;
			zeroedBytes=totalSize-BLK_DATA_MULTI_OFFSET;
		}
	}else{
		neededSize=dataSize+BLK_DATA_OFFSET;
		logarithmOfTotalSize=0;
		for(totalSize=1:totalSize<neededSize:totalSize=totalSize*2){
			++logarithmOfTotalSize;
		}
		@malloc totalSize result;
		if(~~result){
			return BlkAllocationError("ran out");
		}
		dataAddress=result+BLK_DATA_OFFSET;
		zeroedBytes=totalSize-BLK_DATA_OFFSET;
	}
	result->BLK_HEADER_N=logarithmOfTotalSize;
	result->BLK_HEADER_FLAGS=flags;
	result-->BLK_HEADER_KOV=KindAtomic(baseKind);
	@mzero zeroedBytes dataAddress;
	return result;
];

! Copied from Flex.i6t
[ BlkAllocationError reason;
	print "*** Memory ", (string) reason, " ***^";
	RunTimeProblem(RTP_HEAPERROR);
	rfalse;
];

! Adapted from Flex.i6t
[ BlkFree block
	nextBlock;
	if((~~block)||(block->BLK_HEADER_FLAGS)&BLK_FLAG_RESIDENT){
		return;
	}
	BlkValueDestroy(block);
	if((block->BLK_HEADER_FLAGS)&BLK_FLAG_MULTIPLE){
		nextBlock=block-->BLK_DATA_WORD_OFFSET;
		@mfree nextBlock;
	}
	@mfree block;
];

! Adapted from Flex.i6t
[ BlkResize block neededSize
	flags oldSize oldDataAddress logarithmOfTotalSize totalSize result zeroedAddress zeroedBytes;
	if(~~block){
		"*** Cannot resize null block ***";
	}
	flags=block->BLK_HEADER_FLAGS;
	if(~~(flags&BLK_FLAG_MULTIPLE)){
		"*** Cannot resize inextensible block ***";
	}
	if(flags&BLK_FLAG_RESIDENT){
		block->BLK_HEADER_FLAGS=flags&~BLK_FLAG_RESIDENT;
		oldSize=BlkSize(block)-BLK_DATA_MULTI_OFFSET;
		logarithmOfTotalSize=0;
		for(totalSize=1:totalSize<neededSize:totalSize=totalSize*2){
			++logarithmOfTotalSize;
		}
		if(totalSize<oldSize){
			oldSize=totalSize;
		}
		@malloc totalSize result;
		if(~~result){
			return BlkAllocationError("ran out");
		}
		oldDataAddress=block+BLK_DATA_MULTI_OFFSET;
		@mcopy oldSize oldDataAddress result;
		zeroedAddress=result+oldSize;
		zeroedBytes=totalSize-oldSize;
		@mzero zeroedBytes zeroedAddress;
	}else{
		oldSize=BlkSize(block);
		if(oldSize>=neededSize){
			return;
		}
		logarithmOfTotalSize=0;
		for(totalSize=1:totalSize<neededSize:totalSize=totalSize*2){
			++logarithmOfTotalSize;
		}
		@malloc totalSize result;
		if(~~result){
			return BlkAllocationError("ran out");
		}
		oldDataAddress=block-->BLK_DATA_WORD_OFFSET;
		@mcopy oldSize oldDataAddress result;
		zeroedAddress=result+oldSize;
		zeroedBytes=totalSize-oldSize;
		@mzero zeroedBytes zeroedAddress;
		@mfree oldDataAddress;
	}
	block->BLK_HEADER_N=logarithmOfTotalSize;
	block-->BLK_DATA_WORD_OFFSET=result;
];

-) instead of "Flex.i6t".

Book "BlockValues.i6t"

Include (-

! Adapted from BlockValues.i6t
[ BlkValueExtent block
	flags totalSize;
	if(~~block){
		return 0;
	}
	flags=block->BLK_HEADER_FLAGS;
	if((flags&BLK_MASK_RESIDENT_MULTI)==BLK_MASK_RESIDENT_MULTI){
		for(:block~=NULL:block=block-->BLK_NEXT){
			totalSize=totalSize+BlkSize(block)-BLK_DATA_MULTI_OFFSET;
		}
	}else if(flags&BLK_FLAG_MULTIPLE){
		totalSize=BlkSize(block);
	}else{
		totalSize=BlkSize(block)-BLK_DATA_OFFSET;
	}
	if(flags&BLK_FLAG_16_BIT){
		return totalSize/2;
	}
	if(flags&BLK_FLAG_WORD){
		return totalSize/WORDSIZE;
	}
	return totalSize;
];

! Adapted from BlockValues.i6t
[ BlkValueSetExtent block totalSize
	flags;
	if(~~block){
		rfalse;
	}
	flags=block->BLK_HEADER_FLAGS;
	if(flags&BLK_FLAG_16_BIT){
		return BlkResize(block,totalSize*2);
	}
	if(flags&BLK_FLAG_WORD){
		return BlkResize(block,totalSize*WORDSIZE);
	}
	return BlkResize(block,totalSize);
];

! Adapted from BlockValues.i6t
[ BlkValueRead block position
	flags currentBlock remainingPosition dataAddress dataSize;
	if(~~block){
		return 0;
	}
	flags=block->BLK_HEADER_FLAGS;
	if(flags&BLK_FLAG_16_BIT){
		remainingPosition=position*2;
	}else if(flags&BLK_FLAG_WORD){
		remainingPosition=position*WORDSIZE;
	}else{
		remainingPosition=position;
	}
	if(remainingPosition<0){
		"*** BlkValueRead: reading from index out of range: ",position," in ",block," ***";
	}
	if((flags&BLK_MASK_RESIDENT_MULTI)==BLK_MASK_RESIDENT_MULTI){
		for(currentBlock=block:currentBlock~=NULL:currentBlock=currentBlock-->BLK_NEXT,remainingPosition=remainingPosition-dataSize){
			dataSize=BlkSize(currentBlock)-BLK_DATA_MULTI_OFFSET;
			if(remainingPosition<dataSize){
				dataAddress=currentBlock+BLK_DATA_MULTI_OFFSET+remainingPosition;
				if(flags&BLK_FLAG_16_BIT){
					@aloads dataAddress 0 sp;
					@return sp;
				}
				if(flags&BLK_FLAG_WORD){
					@aload dataAddress 0 sp;
					@return sp;
				}
				@aloadb dataAddress 0 sp;
				@return sp;
			}
		}
		"*** BlkValueRead: reading from index out of range: ",position," in ",block," ***";
	}
	if(flags&BLK_FLAG_MULTIPLE){
		dataSize=BlkSize(block);
		dataAddress=block-->BLK_DATA_WORD_OFFSET;
	}else{
		dataSize=BlkSize(block)-BLK_DATA_OFFSET;		
		dataAddress=block+BLK_DATA_OFFSET;
	}
	if(remainingPosition>=dataSize){
		"*** BlkValueRead: reading from index out of range: ",position," in ",block," ***";
	}
	if(flags&BLK_FLAG_16_BIT){
		@aloads dataAddress position sp;
		@return sp;
	}
	if(flags&BLK_FLAG_WORD){
		@aload dataAddress position sp;
		@return sp;
	}
	@aloadb dataAddress position sp;
	@return sp;
];

! Adapted from BlockValues.i6t
[ BlkValueWrite block position value
	flags currentBlock remainingPosition dataAddress dataSize;
	if(~~block){
		return 0;
	}
	flags=block->BLK_HEADER_FLAGS;
	if(flags&BLK_FLAG_16_BIT){
		remainingPosition=position*2;
	}else if(flags&BLK_FLAG_WORD){
		remainingPosition=position*WORDSIZE;
	}else{
		remainingPosition=position;
	}
	if(remainingPosition<0){
		"*** BlkValueWrite: writing to index out of range: ",position," in ",block," ***";
	}
	if((flags&BLK_MASK_RESIDENT_MULTI)==BLK_MASK_RESIDENT_MULTI){
		for(currentBlock=block:currentBlock~=NULL:currentBlock=currentBlock-->BLK_NEXT,remainingPosition=remainingPosition-dataSize){
			dataSize=BlkSize(currentBlock)-BLK_DATA_MULTI_OFFSET;
			if(remainingPosition<dataSize){
				dataAddress=currentBlock+BLK_DATA_MULTI_OFFSET+remainingPosition;
				if(flags&BLK_FLAG_16_BIT){
					@astores dataAddress 0 value;
					return;
				}
				if(flags&BLK_FLAG_WORD){
					@astore dataAddress 0 value;
					return;
				}
				@astoreb dataAddress 0 value;
				return;
			}
		}
		"*** BlkValueWrite: writing to index out of range: ",position," in ",block," ***";
	}
	if(flags&BLK_FLAG_MULTIPLE){
		dataSize=BlkSize(block);
		dataAddress=block-->BLK_DATA_WORD_OFFSET;
	}else{
		dataSize=BlkSize(block)-BLK_DATA_OFFSET;		
		dataAddress=block+BLK_DATA_OFFSET;
	}
	if(remainingPosition>=dataSize){
		"*** BlkValueWrite: writing to index out of range: ",position," in ",block," ***";
	}
	if(flags&BLK_FLAG_16_BIT){
		@astores dataAddress position value;
		return;
	}
	if(flags&BLK_FLAG_WORD){
		@astore dataAddress position value;
		return;
	}
	@astoreb dataAddress position value;
	return;
];

! Copied from BlockValues.i6t
Constant CREATE_KOVS     = 1;
Constant CAST_KOVS       = 2;
Constant DESTROY_KOVS    = 3;
Constant PRECOPY_KOVS    = 4;
Constant COPY_KOVS       = 5;
Constant COMPARE_KOVS    = 6;
Constant READ_FILE_KOVS  = 7;
Constant WRITE_FILE_KOVS = 8;
Constant HASH_KOVS       = 9;

! Copied from BlockValues.i6t
Global block_value_tally;
[ BlkValueCreate kov cast_from skov  block sf;
	if (skov == 0 && (kov < 0 || kov >= BASE_KIND_HWM)) skov = kov;
	sf = KOVSupportFunction(kov);
	if (sf) block = sf(CREATE_KOVS, cast_from, skov);
	else { print "*** Impossible runtime creation ***^"; rfalse; }
#ifdef SHOW_ALLOCATIONS;
	print "[created ", kov, " at ", block, ": ", block_value_tally++, "]^";
#endif;
	return block;
];

! Copied from BlockValues.i6t
[ BlkValueCast block tokov fromkov fromval  sf;
	sf = KOVSupportFunction(tokov);
	if (sf) return sf(CAST_KOVS, fromval, fromkov, block);
	else { print "*** Impossible runtime cast ***^"; rfalse; }
];

! Copied from BlockValues.i6t
[ BlkValueDestroy block  k rv sf;
	if (block == 0) return;
	k = block-->BLK_HEADER_KOV;
	sf = KOVSupportFunction(k);
	if (sf) return sf(DESTROY_KOVS, block);
	else { print "*** Impossible runtime deallocation ***^"; rfalse; }
];

! Copied from BlockValues.i6t
[ BlkValueCopy blockto blockfrom dsize i sf;
	if (blockto == 0) { print "*** Deep copy failed: destination empty ***^"; rfalse; }
	if (blockfrom == 0) { print "*** Deep copy failed: source empty ***^"; rfalse; }
	if (blockfrom->BLK_HEADER_N == 0) {
		! A hack to handle precompiled array constants: N=0 blocks otherwise don't exist
		LIST_OF_TY_CopyRawArray(blockto, blockfrom, 1, 0);
		return blockto;
	}
	if (blockfrom-->BLK_HEADER_KOV ~= blockto-->BLK_HEADER_KOV) {
		print "*** Deep copy failed: types mismatch ***^"; rfalse;
	}
	BlkValueDestroy(blockto);
	dsize = BlkValueExtent(blockfrom);
	if (((blockfrom->BLK_HEADER_FLAGS) & BLK_FLAG_MULTIPLE) &&
		(BlkValueSetExtent(blockto, dsize, -1) == false)) {
		print "*** Deep copy failed: resizing failed ***^"; rfalse;
	}
	sf = KOVSupportFunction(blockfrom-->BLK_HEADER_KOV);
	if (sf) sf(PRECOPY_KOVS, blockto, blockfrom);
	for (i=0:i<dsize:i++) BlkValueWrite(blockto, i, BlkValueRead(blockfrom, i));
	if (sf) sf(COPY_KOVS, blockto, blockfrom);
	else { print "*** Impossible runtime copy ***^"; rfalse; }
	return blockto;
];

! Copied from BlockValues.i6t
[ BlkValueCompare blockleft blockright  kov sf;
	if ((blockleft == 0) && (blockright == 0)) return 0;
	if (blockleft == 0) return 1;
	if (blockright == 0) return -1;
	if (blockleft-->BLK_HEADER_KOV ~= blockright-->BLK_HEADER_KOV)
		return blockleft-->BLK_HEADER_KOV - blockright-->BLK_HEADER_KOV;
	kov = blockleft-->BLK_HEADER_KOV;

	sf = KOVSupportFunction(kov);
	if (sf) return sf(COMPARE_KOVS, blockleft, blockright);
	else { print "*** Impossible runtime comparison ***^"; rfalse; }
];

! Copied from BlockValues.i6t
[ BlkValueHash block  kov sf;
	if (block == 0) return 0;
	kov = block-->BLK_HEADER_KOV;
	sf = KOVSupportFunction(kov);
	if (sf) return sf(HASH_KOVS, block);
	else { print "*** Impossible runtime hashing ***^"; rfalse; }
];

! Copied from BlockValues.i6t
[ KOVHashValue kov value;
	if (KOVIsBlockValue(kov)) return BlkValueHash(value);
	return value;
];

! Copied from BlockValues.i6t
[ BlkValueReadFromFile block auxf ch kov  sf;
	sf = KOVSupportFunction(kov);
	if (sf) return sf(READ_FILE_KOVS, block, auxf, ch);
	rfalse;
];

! Copied from BlockValues.i6t
[ BlkValueWriteToFile block kov  sf;
	sf = KOVSupportFunction(kov);
	if (sf) return sf(WRITE_FILE_KOVS, block);
	rfalse;
];

-) instead of "BlockValues.i6t".

Block Value Management via Malloc ends here.

---- DOCUMENTATION ----

Chapter: Disclaimer

This extension is part of a discussion on IntFiction.  It's ugly, and hacky, and
not meant for use in an actual story.  For one thing, it assumes interpreter
capabilities without checking for them; for another, it contains an evil hack
with the flag BLK_FLAG_RESIDENT (the hack works around heap management
assumptions that Inform compiles into CreateDynamicRelations); for yet another,
many of the functions contain duplicate code.  Beyond that, it was resurrected
from an old project that was interrupted.  I have no idea if I left it in a
buggy state, and I haven't done any testing except to run the sample code below.

Example: * Sample - Some code to exercise the block value management routines

	*: "Sample" by Brady Garvin
	
	Use no deprecated features.
	Include Block Value Management via Malloc by Brady Garvin.
	
	There is a room.

	Instead of singing:
		let W be some indexed text;
		repeat with X running from one to 80:
			now W is "[W][X][W]";
		say "[the number of characters in W]."

	Foo relates numbers to numbers.

	Instead of waving hands:
		repeat with the counter running from zero to 8000:
			now the foo relation relates the counter to the counter;
		showme the number that relates to 1592 by the foo relation.

	Instead of jumping:
		let Y be a list of indexed text;
		repeat with X running from one to 8000:
			add "[X]" to Y.