;
; Block.aii
;
; Heap block allocation and deallocation routines
;
; Copyright © 1989 Claris Corporation
;
; 1/25/89 Begun by Kevin A. Watts
;

;--------------------------------------------------------------
; Routines:	all operate on the current heap
;
; H_NewBlock(Size:xy): Index:ax		; allocate a new block and index
; H_DisposeBlock(Index:xy)			; dispose of a block
; H_ResizeBlock(Index:l,DataSize:xy): Ptr:ax	; resize a block
; H_CopyBlock(OldIndex:xy): Index:ax, Ptr:l	; copy a block
; H_GetBlockPtr(Index:xy): Ptr:ax		; get pointer to block
; H_GetBlockSize(Index:xy): Size:ax		; get size of block
; H_TruncHeap()			; shrink the heap to its minimum size
;
; NewIndex()		; allocate a new index
; DisposeIndex()		; dispose of an index
; NewBlock()		; allocate a new block
; DisposeBlock()		; dispose of a block
; CompactMoveBlock()	; move a block in SqueezeHeap or CompactSegment
; SqueezeHeap(DisposeFlag:x)	; squeeze the heap into as few segments as possible
; CompactSegment()		; compact a data segment
; NewDataSegment()		; create and initialize a new data segment
; VerifyIndex()		; verify the index in Index

;--------------------------------------------------------------

	PRINT	PUSH
	PRINT	OFF

	LOAD	'Macros.Dump'

	gblc	&__FILE__
&__FILE__	setc	'Block'

	include	'Heap.mac'
	include	'HeapPrivate.equ'
	include	'm16.profile'
	include	'Driver.equ'

	ENTRY	H_NewBlock
	ENTRY	H_DisposeBlock
	ENTRY	H_ResizeBlock
	ENTRY	H_CopyBlock
	ENTRY	H_GetBlockPtr
	ENTRY	H_GetBlockSize
	ENTRY	H_TruncHeap

	ENTRY	NewIndex
	ENTRY	DisposeIndex
	ENTRY	NewBlock
	ENTRY	DisposeBlock
  IF Squeezing THEN
	ENTRY	SqueezeHeap
  ENDIF
	ENTRY	CompactSegment
	ENTRY	NewDataSegment
  IF ErrorCheck THEN
	ENTRY	VerifyIndex
  ENDIF

	PRINT	POP

;¦;--------------------------------------------------------------
; H_NewBlock(DataSize:xy): Index:ax, NewBlockPtr:l
;	error status returned in y, with x used to indicate
;	error in index (-1) or block (0) allocation
;
; Allocate a new block of the specified size in the current heap.
; NewBlockPtr and Index are invalid if any error occurs.

; Zpage variables modified:
;	DataSize
;	NewIndex()
;	NewBlock()
;	DisposeIndex()

H_NewBlock	PROC	EXPORT

	BeginZ

NewBlockPtr	equ	6
		; stack frame w/offsets:
		;	1: return address (3 bytes)
		;	4: saved direct page (2 bytes)
		;	6: space for returned pointer (4 bytes)

	MoveLong	xy,DataSize	; save the requested block size

	jsr	NewIndex
	bcs	noIndex

  IF UseLastResort THEN
	stz	SkipLastResort
  ENDIF
	jsr	NewBlock
	bcs	noBlock

	sta	NewBlockPtr,s
	txa
	sta	NewBlockPtr+2,s
	MoveLong	Index,ax
	;ldy	#0		- y = 0 after NewBlock without error
	ReturnZ

noIndex
  IF VerboseErrors THEN
	phy
 	Call	D_AlertBox,in=(#OkBox:w,#NoIndexMesg:l),out=(a:w)
	ply
	sec
	DEBRK3
  ENDIF
	ldx	#-1
	ReturnZ

noBlock
	phy
	jsr	DisposeIndex
  IF VerboseErrors THEN
 	Call	D_AlertBox,in=(#OkBox:w,#NoBlockMesg:l),out=(a:w)
	DEBRK3
  ENDIF
	ply
	ldx	#0
	sec
	ReturnZ

  IF VerboseErrors THEN
NoIndexMesg	str	'H_NewBlock: Unable to allocate index'
NoBlockMesg	str	'H_NewBlock: Unable to allocate block'
  ENDIF
	ENDP

;¦;--------------------------------------------------------------
; H_DisposeBlock(Index:xy)
;	no error status is returned
;
; Dispose of the specified block in the current heap.

; Zpage variables modified: 
;	Index
;	ISegPtr
;	DisposeBlock()
;	DisposeIndex()

H_DisposeBlock	PROC	EXPORT

	BeginZ

	MoveLong	xy,Index		; save the index

	tya
	beq	disposeZeroError

  IF Profile THEN
	ProfileIn 9,_H
	ldx	Index
  ENDIF
	; get ptr to index segment
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr

	jsr	DisposeBlock
	jsr	DisposeIndex

	ProfileOut 9,_H
	
  IF (ErrorCheck = 0) THEN
disposeZeroError
  ENDIF
	ReturnZ

  IF ErrorCheck THEN
disposeZeroError
	SpaceWord
	PushWord	#OkBox
	PushLong	#dzMesg
	jsl	D_AlertBox
	pla
	DEBRK2
	ReturnZ

dzMesg	str	'H_DisposeBlock: Attempt to dispose of index $00xx!'
  ENDIF	; ErrorCheck

	ENDP

;¦;--------------------------------------------------------------
; H_ResizeBlock(Index:l,DataSize:xy): Ptr:ax
;	error status returned in y
;
; Resize the specified block in the current heap.
; Ptr is valid even if an error occurs
; This routine is a mess.

; Zpage variables modified: 
;	BlockSize
;	DataSize
;	DP		(also aliased to NextOffset)
;	ErrorFlag
;	Index
;	ISegPtr
;	Offset
;	OldIndex
;	Ptr
;	SegPtr
;	DisposeBlock()
;	NewBlock()
;	H_GetBlockPtr()

H_ResizeBlock	PROC	EXPORT

NextOffset	equ	DP

	BeginZ

	MoveLong	xy,DataSize

	ProfileIn 10,_H

; remove the input parameter from the stack and restore the return address
	PullWord	DP	; pull the old direct page value
	php		; push an extra byte onto the stack
	plx		; pull the return address & extra byte in xy
	ply

	PullLong	Index

	phy		; push the return address & extra byte back
	phx
	plp		; pull the extra byte off again
	PushWord	DP	; push the old direct page value again


  IF ErrorCheck THEN
	MoveLong	Index,xy
	jsr	VerifyIndex
	bcc	@1
	ReturnZ
@1
  ENDIF
	ldy	Index+2		; index segment 0 => zero size (virtual) block
	bne	indexOk		; can't resize block - not a real index
  IF ErrorCheck THEN
	Call	D_AlertBox,in=(#OkBox:w,#ziMesg:l),out=(a:w)
  ENDIF
	lda	#0
	tax
	ldy	#-1
	sec
	ReturnZ
indexOk

	; get ptr to index segment
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2

	; get data segment:offset from index
	ldy	Index		; offset within I seg to index
	lda	[ISegPtr],y	; offset within D seg to block
	sta	Offset
	iny			; adjust to high word
	iny
	lda	[ISegPtr],y	; data segment

; two cases: Sign bit clear => small block (index contains segment:offset)
;	   Sign bit set => large block (index contains flag:handle)
;		         or free index (index contains flag:next_index)
	JMI	resizeHandle
	; we now know that BlockSize < H_LARGE_BLOCK_SIZE < 64K

  IF UseLastResort THEN
	stz	SkipLastResort
  ENDIF

; get the data segment pointer
	tay
	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2

; get current size of block
	ldy	Offset
	beq	zeroBlock		; zero offset => zero size (virtual) block
	lda	[SegPtr],y	; size
	sta	BlockSize

; are we growing or shrinking the block?
	lda	DataSize+2
	JNE	newAndDispose	; must be growing - the old block is < 64K
	lda	DataSize
	cmp	#H_LARGE_BLOCK_SIZE	; are we growing to a handle?
	JGE	newAndDispose	; yes - old block is < H_LARGE_BLOCK_SIZE
	cmp	BlockSize
	beq	returnPtr		; same size
	JGE	grow

; shrinking the block
	; round up the DataSize to multiple of H_BLOCK_GRAN
	;lda	DataSize
  IF H_BLOCK_GRAN = 2 THEN
 	ina
  ELSE
	clc
	adc	#H_BLOCK_GRAN-1
  ENDIF
	and	#-H_BLOCK_GRAN
	sta	DataSize
	beq	shrinkToZero

	SubWord	BlockSize,DataSize,BlockSize	; how much are we shrinking by?
	beq	returnPtr			; - nothing (same size)
	; BlockSize is now the difference between the old and new sizes

	; shrink the block by storing the new data size
	;ldy	Offset	; offset to block	- already in y
	lda	DataSize
	sta	[SegPtr],y

	; create a new free block out of the freed space at the end of the block
	tya			; offset to block
	clc
	adc	#H_BLOCK_OVERHEAD	; won't set carry
	adc	DataSize
	tay			; offset to new free block

	lda	BlockSize		; block size of new free block
  IF H_BLOCK_OVERHEAD = 2 THEN
	dea
	dea
  ELSE
	sec
	sbc	#H_BLOCK_OVERHEAD
  ENDIF
	sta	[SegPtr],y	; data size of new free block

disposeNewFreeBlock
	; put the new free block onto the appropriate free list
	; we fake an index for the block by modifying the old one
	; temporarily, and use DisposeBlock
	MoveWord	Offset,OldIndex
	tya			; offset to new free block
	ldy	Index
	sta	[ISegPtr],y
	jsr	DisposeBlock
	lda	OldIndex
	ldy	Index
	sta	[ISegPtr],y
	sta	Offset

returnPtr			; return a pointer to the block
	ProfileOut 10,_H
	lda	Offset
	clc
	adc	#H_BLOCK_OVERHEAD
	adc	SegPtr
	ldx	SegPtr+2
	bcc	@1
	inx
@1
	ldy	#0
	clc
	ReturnZ

shrinkToZero		; create a zero size (virtual) block
	jsr	DisposeBlock
	lda	#0
	ldy	Index
	sta	[ISegPtr],y
	iny
	iny
	sta	[ISegPtr],y
	; DataSize = 0, so we'll fall through hereÉ
zeroBlock
	lda	DataSize		; are we growing the block?
	ora	DataSize+2
	JNE	newAndDispose

  IF Profile THEN	
	ProfileOut 10,_H
	lda	#0
  ENDIF
	; return 0 pointer to zero size (virtual) block
	;lda	#0	- a = 0 already
	tax
	tay		; no error
	clc
	ReturnZ


resizeHandle
  IF ErrorCheck THEN
	cmp	#H_LARGE_BLOCK_FLAG	; H_LARGE_BLOCK_FLAG > H_FREE_INDEX_FLAG
	blt	freeIndex
  ENDIF	; ErrorCheck

	lda	DataSize
	ora	DataSize+2
	beq	shrinkToZero

	; if the new block will definitely be a handle we'll just resize the
	; one we've got, otherwise we'll allocate a new block, copy the data
	; and dispose of the handle.  We could just shrink the handle, but
	; then handles would never go away.
  IF UseLastResort THEN
	MoveWord	#1,SkipLastResort
  ENDIF
	lda	DataSize+2
	bne	resizeH
	CmpWord	DataSize,#H_LARGE_BLOCK_SIZE
	JLT	newAndDispose

resizeH
	PushLong	DataSize
	ldy	Index
	lda	[ISegPtr],y
	sta	Ptr
	iny
	iny
	lda	[ISegPtr],y
	and	#$00FF
	sta	Ptr+2
	pha
	pei	Ptr
	jsl	D_GrowHandle
	bcc	growOk
	pha			; save error code
  IF VerboseErrors THEN
 	Call	D_AlertBox,in=(#OkBox:w,#NoGrowHandleMesg:l),out=(a:w)
	DEBRK3
  ENDIF
  	; we failed, but return a pointer to the block anyway
	MoveLong	[Ptr],ax
	ply			; error code
	sec
	ReturnZ

growOk
	ProfileOut 10,_H

; return the data pointer
	MoveLong	[Ptr],ax
	ldy	#0		; no error
	clc
	ReturnZ


  IF ErrorCheck THEN
freeIndex
	Call	D_AlertBox,in=(#OkBox:w,#fiMesg:l),out=(a:w)
	lda	#0
	tax
	ldy	#-1
	sec
	DEBRK2
	ReturnZ

fiMesg	str	'H_ResizeBlock: Attempt to resize a free index!'
  ENDIF	; ErrorCheck


grow			; new size > old size
  IF GrowBlocks THEN
	; try to extend the block in place
	; a = DataSize
	; y = Offset to block

	; is this block at the end of the used portion of the segment?
	tya			; adjust offset to end of block
	clc
	adc	#H_BLOCK_OVERHEAD
	adc	BlockSize
	ldy	#H_SegEnd
	cmp	[SegPtr],y
	blt	checkNextBlock	; not at end of used portion

	AddWord	Offset,DataSize,a	; offset to new end of block - won't set carry
	adc	#H_BLOCK_OVERHEAD
    IF VariableDSegSize THEN
	dea
	ldy	#H_SegSize
	cmp	[SegPtr],y
    ELSE
	cmp	#H_DSEG_SIZE+1
    ENDIF
	JGE	newAndDispose	; block would extend past end of segment

	; adjust SegEnd and SegFreeSpace
	SubWord	DataSize,BlockSize,BlockSize
    IF VariableDSegSize THEN
	ldy	#H_SegEnd
    ENDIF
	AddWord	a,[SegPtr]:y,[SegPtr]:y
	ldy	#H_SegFreeSpace
	SubWord	[SegPtr]:y,BlockSize,[SegPtr]:y

	; extend the block into the unused portion of the segment
	ldy	Offset
	lda	DataSize
	sta	[SegPtr],y

	brl	ReturnPtr
	
checkNextBlock		; just checking 1 block - could check more
	tay				; a = offset to next block
	lda	[SegPtr],y		; size field
	bpl	newAndDispose		; next block is in use

	and	#$7FFF			; clear sign bit
	clc
	adc	#H_BLOCK_OVERHEAD
	adc	BlockSize
	cmp	DataSize
	blt	newAndDispose

	; extend block into next block
	sty	NextOffset
	ldy	Offset
	lda	DataSize
	sta	[SegPtr],y

	; adjust SegFreeSpace
	ldy	NextOffset		; get next block size
	lda	[SegPtr],y
	and	#$7FFF
  IF H_BLOCK_OVERHEAD = 2 THEN			; add H_BLOCK_OVERHEAD
	ina
	ina
  ELSE
	clc
	adc	#H_BLOCK_OVERHEAD
  ENDIF
	pha
	ldy	#H_SegFreeSpace
	SubWord	[SegPtr]:y,1:s,[SegPtr]:y
	pla

	; remove next block from its free list (if any)
	ldy	NextOffset
	lda	[SegPtr],y
	and	#$7FFF
	cmp	#H_MAX_FREE_LIST+1		; is this block too large too
	bge	leftover2			; large to be on a free list?

	DivByPwr2	a,(H_BLOCK_GRAN/2)	; calculate free list offset
	bra	removeLoopEntry

removeLoop			; find this block on its free list
  IF H_BLOCK_OVERHEAD = 2 THEN
	ina
	ina
  ELSE
	clc
	adc	#H_BLOCK_OVERHEAD
  ENDIF
removeLoopEntry
	tay
	lda	[SegPtr],y
	beq	leftover		; reached end of free list
	cmp	NextOffset
	bne	removeLoop
				; at block preceding used block in free list
	tyx
  IF H_BLOCK_OVERHEAD = 2 THEN
	ina
	ina
  ELSE
	clc
	adc	#H_BLOCK_OVERHEAD
  ENDIF
	tay
	lda	[SegPtr],y	; get link to block following used block
	txy
	sta	[SegPtr],y	; replace link to used block

leftover		; create a new block out of the leftover space
	ldy	NextOffset
	lda	[SegPtr],y		; get amount of leftover space
	and	#$7FFF			; (minus H_BLOCK_OVERHEAD)
leftover2
	AddWord	a,BlockSize,a
	SubWord	a,DataSize,a
	JMI	returnPtr			; no leftover space
	tax
	lda	Offset			; get offset to new block
	clc
	adc	#H_BLOCK_OVERHEAD
	adc	DataSize
	tay
	MoveWord	x,[SegPtr]:y		; store size of new block

	brl	disposeNewFreeBlock		; backwards branch
  ENDIF


newAndDispose	; allocate a new block, copy, and dispose of the old block
	; need a new index (temporarily) - first remember the current one
	MoveLong	Index,OldIndex
	jsr	NewIndex
	bcs	errorI

	jsr	NewBlock
	bcc	okNewBlock

	jsr	DisposeIndex	; dispose of the temporary index

	ldx	#0
	bra	errorB
errorI
	ldx	#-1
errorB
	sty	ErrorFlag
	ldy	OldIndex
	sty	Index
	ldy	OldIndex+2
	sty	Index+2
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr

	ldy	Index
	iny
	iny
	lda	[ISegPtr],y
	JMI	resizeH		; handle - try D_GrowHandle

  IF VerboseErrors THEN
	phx
	SpaceWord
	PushWord	#OkBox
	txa
	beq	@1
	PushLong	#NoIndexMesg
	bra	@2
@1	PushLong	#NoBlockMesg
@2	jsl	D_AlertBox
	pla
	plx
	DEBRK3
  ENDIF
  	; we failed, but return a pointer to the block anyway
	MoveLong	Index,xy
	jsl	H_GetBlockPtr
	ldy	ErrorFlag
	sec
	ReturnZ

okNewBlock
	MoveLong	ax,Ptr		; save ptr to new block

; here Index => new block, OldIndex => old block
; copy the data
	ldy	OldIndex+2
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	ldy	OldIndex
	lda	[ISegPtr],y
	sta	Offset
	iny
	iny
	lda	[ISegPtr],y		; segment # or flag
	bpl	notHandle

	and	#$00FF		; store handle into OldIndex
	sta	OldIndex+2
	lda	Offset
	sta	OldIndex
	ldy	#2		; deref handle
	lda	[OldIndex],y
	pha
	lda	[OldIndex]
	pha
	bra	doMove

notHandle
	tay
	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	tax

	lda	Offset
	clc
	adc	#H_BLOCK_OVERHEAD
	adc	SegPtr
	bcc	@1
	inx
@1
	phx
	pha
doMove
	PushLong	Ptr
	PushLong	DataSize
	_BlockMove

; dispose of the old block
	PushLong	Index		; save the new Index

	MoveLong	OldIndex,Index
	jsr	DisposeBlock

	PullLong	Index		; restore the new Index

; set the old index to refer to the new block
; ISegPtr refers to the old index segment, SegPtr will refer to the temporary
	ldy	Index+2
	lda	[H_ISegPtrHi],y
	sta	SegPtr+2
	lda	[H_ISegPtrLo],y
	sta	SegPtr

	ldy	Index
	lda	[SegPtr],y
	ldy	OldIndex
	sta	[ISegPtr],y

	ldy	Index
	iny
	iny
	lda	[SegPtr],y
	ldy	OldIndex
	iny
	iny
	sta	[ISegPtr],y

; dispose of the temporary index
	MoveLong	SegPtr,ISegPtr
	jsr	DisposeIndex

; return a pointer to the new block in ax
	ProfileOut 10,_H

	MoveLong	Ptr,ax
	ldy	#0		; no error
	ReturnZ

  IF VerboseErrors THEN
NoGrowHandleMesg	str	'H_ResizeBlock: Unable to grow block handle'
NoIndexMesg	str	'H_ResizeBlock: Unable to get temporary index'
NoBlockMesg	str	'H_ResizeBlock: Unable to get new block'
  ENDIF
  IF ErrorCheck THEN
ziMesg	str	'H_ResizeBlock: Attempt to resize index $00xx!'
  ENDIF
	ENDP

;¦;--------------------------------------------------------------
; H_CopyBlock(OldIndex:xy): Index:ax, Ptr:l
;	error status returned in y, with x used to indicate
;	error in index (FF) or block (0) allocation
;
; Copy a block in the current heap.
; Index and Ptr are invalid if any error occurs.

; Zpage variables modified: 
;	DataSize
;	OldIndex
;	Ptr
;	H_GetBlockPtr()
;	H_GetBlockSize()
;	NewIndex()
;	NewBlock()

H_CopyBlock	PROC	EXPORT

NewBlockPtr	equ	6
		; stack frame w/offsets:
		;	1: return address (3 bytes)
		;	4: saved direct page (2 bytes)
		;	6: space for returned pointer (4 bytes)

	BeginZ

	MoveLong	xy,OldIndex

  IF ErrorCheck THEN
	jsr	VerifyIndex
	bcc	@1
	ReturnZ
@1
  ENDIF

  IF Profile THEN
 	ProfileIn 11,_H
	ldx	OldIndex
  ENDIF

	jsl	H_GetBlockSize

	MoveLong	ax,DataSize

	jsr	NewIndex
	bcs	noIndex

  IF UseLastResort THEN
	stz	SkipLastResort
  ENDIF
	jsr	NewBlock
	bcs	noBlock

	MoveLong	ax,Ptr		; ptr to new block
	;MoveLong	ax,NewBlockPtr:s
	sta	NewBlockPtr,s
	txa
	sta	NewBlockPtr+2,s

	MoveLong	OldIndex,xy
	jsl	H_GetBlockPtr

	PushLong	ax
	PushLong	Ptr
	PushLong	DataSize
	_BlockMove

	ProfileOut 11,_H

	MoveLong	Index,ax
	ldy	#0		; no error
	clc
	ReturnZ

noIndex
  IF VerboseErrors = 0 THEN
	ldx	#-1
	ReturnZ
  ELSE
	phy
	PushWord	#-1
	SpaceWord
	PushWord	#OkBox
	PushLong	#NoIndexMesg
	bra	error
  ENDIF

noBlock
	phy
	jsr	DisposeIndex

  IF VerboseErrors = 0 THEN
	ply
	ldx	#0
	ReturnZ
  ELSE
	PushWord	#0
	SpaceWord
	PushWord	#OkBox
	PushLong	#NoBlockMesg
error	jsl	D_AlertBox
	pla
	plx			; 0 or -1
	ply			; error code
	ReturnZ
  ENDIF

  IF VerboseErrors THEN
NoIndexMesg	str	'H_CopyBlock: Unable to allocate index'
NoBlockMesg	str	'H_CopyBlock: Unable to allocate block'
  ENDIF
	ENDP

;¦;--------------------------------------------------------------
; H_GetBlockPtr(Index:xy): Ptr:ax
;	nil pointer returned in case of error
;
; Return a pointer to the specified block in the current heap.
; In case of error or a zero size block, Ptr will be nil.

; Zpage variables modified: 
;	Offset
;	ISegPtr
;	SegHandle

H_GetBlockPtr	PROC	EXPORT

	BeginZ

  IF ErrorCheck THEN
	jsr	VerifyIndex
	bcc	@9
	ReturnZ
@9
  ENDIF
  IF Profile THEN
	phx
	ProfileIn 12,_H
	plx
  ENDIF

	; index: y = index segment #, x = offset within index segment

	tya			; index segment 0 => zero size (virtual) block
	beq	zeroBlock

	; get ptr to index segment
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2

	; get data segment:offset from index
	txy			; offset within I seg to index
	lda	[ISegPtr],y	; offset within D seg to block
	sta	Offset
	iny			; adjust to high word
	iny
	lda	[ISegPtr],y	; data segment
	
; two cases: Sign bit clear => small block (index contains segment:offset)
;	   Sign bit set => large block (index contains flag:handle)
;		         or free index (index contains flag:next_index)
	bmi	handleOrFree
	beq	zeroBlock		; data segment 0 => zero size (virtual block)

; case 1: small block
; accumulator contains segment #
	tay

; add offset to the segment pointer (at [H_DSegPtrLo/Hi],y).
; add H_BLOCK_OVERHEAD yielding ptr to data in block (returned in ax)
	lda	[H_DSegPtrHi],y
	tax			; x = hi word
	lda	Offset		; really the block offset
	clc
	adc	#H_BLOCK_OVERHEAD	; this will NOT set carry on a valid heap
	adc	[H_DSegPtrLo],y
	bcc	@1
	inx			; inc high word
@1
  IF Profile THEN
	PushLong	ax
	ProfileOut 12,_H
	PullLong	ax
  ENDIF
	ReturnZ

zeroBlock				; a = 0
	tax
	ReturnZ


; case 2: handle or free index
handleOrFree
  IF ErrorCheck THEN
	cmp	#H_LARGE_BLOCK_FLAG	; H_LARGE_BLOCK_FLAG > H_FREE_INDEX_FLAG
	blt	freeIndex
  ENDIF	; ErrorCheck

	; extract the handle from the index and store into SegHandle
	and	#$00FF
	sta	SegHandle+2
	lda	Offset
	sta	SegHandle

	; now dereference to get the data pointer in ax
	ldy	#2
	lda	[SegHandle],y
	tax
	lda	[SegHandle]

  IF Profile THEN
	PushLong	ax
	ProfileOut 12,_H
	PullLong	ax
  ENDIF
	ReturnZ

  IF ErrorCheck THEN
freeIndex
	SpaceWord
	PushWord	#OkBox
	PushLong	#fiMesg
	jsl	D_AlertBox
	pla
	lda	#0
	tax
	DEBRK2
	ReturnZ

fiMesg	str	'H_GetBlockPtr: Attempt to dereference a free index!'
  ENDIF	; ErrorCheck

	ENDP

;¦;--------------------------------------------------------------
; H_GetBlockSize(Index:xy): Size:ax
;	zero size returned in case of error
;
; Return the size of the specified block in the current heap.

; Zpage variables modified: 
;	Offset
;	ISegPtr
;	SegPtr

H_GetBlockSize	PROC	EXPORT

	BeginZ

  IF ErrorCheck THEN
	jsr	VerifyIndex
	bcc	@1
	ReturnZ
@1
  ENDIF
  IF Profile THEN
	phx
	ProfileIn 13,_H
	plx
  ENDIF

	; index: y = index segment #, x = offset within index segment

	tya			; index segment 0 => zero size (virtual) block
	beq	zeroBlock

	; get ptr to index segment
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2

	; get data segment:offset from index
	txy			; offset within I seg to index
	lda	[ISegPtr],y	; offset within D seg to block
	sta	Offset
	iny			; adjust to high word
	iny
	lda	[ISegPtr],y	; data segment
	
; two cases: Sign bit clear => small block (index contains segment:offset)
;	   Sign bit set => large block (index contains flag:handle)
;		         or free index (index contains flag:next_index)
	bmi	handleOrFree
	beq	zeroBlock		; data segment 0 => zero size (virtual block)

; case 1: small block
; accumulator contains segment #
	tay

; use offset and the segment pointer (at [H_DSegPtrLo/Hi],y)
; to get the size from the first word of the block.
	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2

	ldy	Offset
	lda	[SegPtr],y	; size
zeroBlock
	ldx	#0
  IF Profile THEN
	PushLong	ax
	ProfileIn 13,_H
	PullLong	ax
  ENDIF
	ReturnZ


; case 2: handle or free index
handleOrFree

  IF ErrorCheck THEN
	cmp	#H_LARGE_BLOCK_FLAG	; H_LARGE_BLOCK_FLAG > H_FREE_INDEX_FLAG
	blt	freeIndex
  ENDIF	; ErrorCheck

	SpaceLong
	and	#$00FF
	pha
	PushWord	Offset
	_GetHandleSize

	ProfileOut 13,_H

	PullLong	ax
	ReturnZ

  IF ErrorCheck THEN
freeIndex
	SpaceWord
	PushWord	#OkBox
	PushLong	#fiMesg
	jsl	D_AlertBox
	pla
	lda	#0
	tax
	DEBRK2
	ReturnZ

fiMesg	str	'H_GetBlockSize: Attempt to dereference a free index!'
  ENDIF	; ErrorCheck

	ENDP

;¦;--------------------------------------------------------------
; H_TruncHeap()
;
; shrink the heap to its minimum size

; Zpage variables modified:
;	SqueezeHeap()

H_TruncHeap	PROC	EXPORT

	BeginZ

  IF Squeezing THEN
	ldx	#1
	jsr	SqueezeHeap
  ENDIF
	ReturnZ
	ENDP

;¦
;=====================================================================;
;			LOCAL ROUTINES			;
;=====================================================================;

;--------------------------------------------------------------
; NewIndex()
;
; Allocate a new index.
;
; post:	Index will contain the index (segment:offset)
;	ISegPtr will point to the index segment used
;	return errors in y with carry set

; Zpage variables modified: 
;	H_EndIndex
;	H_FreeIndex
;	H_NumISegments
;	Index
;	ISegPtr

NewIndex	PROC	ENTRY

	ProfileIn 7,_H

; first, try the free list
	ldy	H_FreeIndex+2	; segment of free index
	beq	emptyFreeIndexList

	; found a free index

	sty	Index+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2

	ldy	H_FreeIndex	; offset of free index
	sty	Index

	; update the free list (the index contains the next free index)
	lda	[ISegPtr],y	; offset to next free index
	sta	H_FreeIndex
  IF ErrorCheck THEN
	cmp	#H_ISEG_SIZE
	bge	indexFreeListCorrupted
	and	#%11
	bne	indexFreeListCorrupted
  ENDIF
	iny
	iny
	lda	[ISegPtr],y	; segment to next free index + flag

  IF ErrorCheck THEN
	cmp	#H_FREE_INDEX_FLAG+$1000
	bge	indexFreeListCorrupted
	cmp	#H_FREE_INDEX_FLAG
	bge	iflOk
indexFreeListCorrupted
	Call	D_AlertBox,in=(#OkBox:w,#iflcMesg:l),out=(a:w)
	ldy	#-1		; error value in y
	sec
	DEBRK2
	rts
iflOk
  ENDIF	; ErrorCheck

	and	#$FF		; mask out the free index flag
	sta	H_FreeIndex+2
  IF ErrorCheck THEN
	cmp	H_NumISegments
	bgt	indexFreeListCorrupted
	and	#%11
	bne	indexFreeListCorrupted
  ENDIF

	ProfileOut 7,_H
	ldy	#0
	clc
	rts


emptyFreeIndexList		; nothing in free list - try end of last index segment
	ldy	H_NumISegments
	beq	newSeg			; no index segments
	lda	H_EndIndex
	cmp	#H_ISEG_SIZE
	bge	newSeg			; no space left in last segment

	sty	Index+2		; = H_NumISegments
	sta	Index		; = H_EndIndex
	clc
	adc	#4
	sta	H_EndIndex

	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2

	ldy	#0		; no error
	clc
	rts

newSeg
  IF ErrorCheck THEN
 	beq	@endIndexOk
	Call	D_AlertBox,in=(#OkBox:w,#beiMesg:l),out=(a:w)
	ldy	#-1			; error value in y
	sec
	DEBRK2
	rts
@endIndexOk
  ENDIF	; ErrorCheck

  IF Verbose THEN
    IF Verbose > 1 THEN
	Call	D_AlertBox,in=(#OkBox:w,#growIndexMesg:l),out=(a:w)
    ELSE
	Call	D_WordBox,in=(#growIndexMesg:l)
    ENDIF
	DEBRK
	ldy	H_NumISegments
  ENDIF
	cpy	H_MaxSegments	; verify there are < H_MaxSegments
	blt	@1
	ldy	#memErr		; fake error code
	rts			; carry set
@1
	; allocate the handle for the segment (locked)
	SpaceLong
	PushLong	#H_ISEG_SIZE
	PushWord	#attrLocked
	ProfileIn 15,_H
	jsl	D_NeedHandle
	tay			; error code
	PullLong	SegHandle
	bcc	@2

	ProfileOut 7,_H
  IF Verbose = 1 THEN
	phy
	Call	D_CloseWordBox
	ply
  ENDIF
	rts			; carry set, error in y

@2	; increment the # of index segments and store the handle in the header
	AddWord	H_NumISegments,#4,H_NumISegments	; result left in a
	ldy	#H_NumISegments
	sta	[H_HeaderPtr],y
	tay
	lda	SegHandle
	sta	[H_ISegHandleLo],y
	lda	SegHandle+2
	sta	[H_ISegHandleHi],y

	; deref the handle and store the pointer in the header
	lda	[SegHandle]
	sta	ISegPtr
	sta	[H_ISegPtrLo],y
  IF ZeroInit THEN
	tax
  ENDIF
	ldy	#2
	lda	[SegHandle],y
	ldy	H_NumISegments
	sta	ISegPtr+2
	sta	[H_ISegPtrHi],y

	; initialize the index segment
  IF ZeroInit THEN
	pha
	phx
	PushWord	#H_ISEG_SIZE
	jsl	D_ZeroBlock
  ENDIF
	; return the first index in the new segment
	ldy	H_NumISegments
	sty	Index+2
	stz	Index
	MoveWord	#4,H_EndIndex

  IF Verbose = 1 THEN
	Call	D_CloseWordBox
  ENDIF
	ProfileOut 7,_H
	ldy	#0		; no error
	clc
	rts

  IF ErrorCheck THEN
iflcMesg	str	'NewIndex: Index Free List Corrupted!'
beiMesg	str	'NewIndex: H_EndIndex > H_ISEG_SIZE!'
  ENDIF
  IF Verbose THEN
growIndexMesg	str	'NewIndex: allocating new index segment'
  ENDIF
	ENDP

;¦;--------------------------------------------------------------
; DisposeIndex()
;
; Dispose of an index by placing it at the head of the free list
;
; pre:	Index = segment & offset of index to dispose
;	ISegPtr = ptr to index segment

; Zpage variables modified: 
;	H_FreeIndex

DisposeIndex	PROC	ENTRY

	ldy	Index+2
	beq	disposeZeroError

  IF ErrorCheck THEN
	ldx	Index
	jsr	VerifyIndex
	bcc	@1
	rts
@1
  ENDIF
	
; copy old free list head into index, and flag index as free
	lda	H_FreeIndex
	ldy	Index
	sta	[ISegPtr],y
	lda	H_FreeIndex+2
	ora	#H_FREE_INDEX_FLAG
	iny
	iny
	sta	[ISegPtr],y

; free list head = index
	MoveLong	Index,H_FreeIndex

  IF (ErrorCheck = 0) THEN
disposeZeroError
  ENDIF
	rts

  IF ErrorCheck THEN
disposeZeroError
	SpaceWord
	PushWord	#OkBox
	PushLong	#dzMesg
	jsl	D_AlertBox
	pla
	DEBRK2
	rts

dzMesg	str	'DisposeIndex: Attempt to dispose of index $00xx!'
  ENDIF	; ErrorCheck
	ENDP

;¦;--------------------------------------------------------------
; NewBlock()
;
; Allocate a new block.
;
; pre:	DataSize = data size of block
;	Index = segment & offset of index to use
;	ISegPtr = ptr to index segment
;
; post:	return ptr to block in ax.
;	return errors in y with carry set.
;
; Zpage variables modified: 
;	BlockSize
;	DataSize
;	FreeListOffset
;	ISegPtr (recalc only)
;	MaxFreeSeg
;	MaxFreeSpace
;	Offset
;	Ptr
;	SegPtr
;	Segment
;	CompactSegment()
;	NewDataSegment()
;	SqueezeHeap()

NewBlock	PROC	ENTRY

; if the block size is > H_LARGE_BLOCK_SIZE, allocate a handle for the block
; if the block size is 0, return a 'virtual' block
; otherwise, add H_BLOCK_OVERHEAD to the requested size to obtain the actual block size

	ProfileIn 8,_H

  IF ErrorCheck THEN
	MoveLong	Index,xy
	jsr	VerifyIndex
	bcc	@1
	rts
@1
  ENDIF
	lda	DataSize+2
	JNE	largeBlock

	lda	DataSize
	bne	nonZero

	; zero size block - return virtual block at Dseg #0, offset 0
	; a = 0
	ldy	Index
	sta	[ISegPtr],y
	iny
	iny
	sta	[ISegPtr],y

	;lda	#0
	tax
	tay		; no error
	clc
	rts

nonZero
	cmp	#H_LARGE_BLOCK_SIZE	; check if too large
	JGE	largeBlock

	; round size up to multiple of H_BLOCK_GRAN
  IF H_BLOCK_GRAN = 2 THEN
 	ina
  ELSE
	;clc		already clear since we fell through a bge
	adc	#H_BLOCK_GRAN-1
  ENDIF
	and	#-H_BLOCK_GRAN
	sta	DataSize

	;clc		already clear
	adc	#H_BLOCK_OVERHEAD
	sta	BlockSize
	
	cmp	#H_MAX_FREE_LIST+H_BLOCK_OVERHEAD+1	; too big to be on
	JGE	mediumBlock			; a free list?

	; calculate the offset into the free list:
	; free list offset = data_size / (H_BLOCK_GRAN/2)
	; we assume that H_BLOCK_GRAN is a power of 2
  IF (H_BLOCK_GRAN ² 2) THEN
	ldy	DataSize
  ELSE
	lda	DataSize		; the block size
	DivByPwr2	a,(H_BLOCK_GRAN/2)	; divide a by H_BLOCK_GRAN/2
	tay
  ENDIF
	; get segment # from free list
	lda	[H_FreeListArray],y
	JEQ	mediumBlock	; 0 => this free list is empty
	sta	Segment
checkNextSegLoop
	sty	FreeListOffset	; save the free list offset
	; get pointer to data segment
	tay
	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2

	; get offset from data segment free list
	ldy	FreeListOffset
	lda	[SegPtr],y
	bne	gotFreeBlock

	; check next segment
	;ldy	FreeListOffset
	AddWord	Segment,#4,Segment
	sta	[H_FreeListArray],y
	cmp	H_NumDSegments
	BLE	checkNextSegLoop

	; free lists empty in all segments - clear head
	lda	#0
	sta	[H_FreeListArray],y
	bra	mediumBlock
	

gotFreeBlock			; update free list
  IF ErrorCheck THEN
	; check that the offset is valid
	cmp	#DSEG_HDR_SIZE
	blt	corrupt
    IF VariableDSegSize THEN
	ldy	#H_SegSize
	cmp	[SegPtr],y
    ELSE
	cmp	#H_DSEG_SIZE
    ENDIF
	bge	corrupt
  ENDIF
	; a = Offset (to this block)
	; save offset to this block in index
	ldy	Index
	sta	[ISegPtr],y
	sta	Offset

	; get offset to next free block out of this block
  IF H_BLOCK_OVERHEAD = 2 THEN
	ina
	ina
  ELSE
	clc
	adc	#H_BLOCK_OVERHEAD
  ENDIF
	tay
	lda	[SegPtr],y

	; and store in the free list head
	ldy	FreeListOffset
	sta	[SegPtr],y

	; save segment of this block in Index
	lda	Segment
	ldy	Index
	iny
	iny
	sta	[ISegPtr],y

  IF ErrorCheck THEN
	; verify that the size in the block is correct for the free list
	; it was on
	ldy	Offset
	lda	[SegPtr],y
    IF GrowBlocks THEN
	bpl	corrupt		; not a free block!
	and	#$7FFF  		; clear high bit of size field
    ENDIF
	cmp	DataSize
	beq	sizeOK

corrupt	Call	D_AlertBox,in=(#OkBox:w,#bbsMesg:l),out=(a:w)
	ldx	#0		; error in block allocation
	ldy	#-1		; error value in y
	sec
	DEBRK2
	rts

sizeOK
  ENDIF
	bra	returnBlock


mediumBlock		; allocate a block from the end of a segment

	stz	MaxFreeSpace
	stz	MaxFreeSeg

; search segments in order, beginning with the last segment,
; looking for space at the end of segment
	ldx	H_NumDSegments
	JEQ	newSeg			; no data segments
allocLoop
	txy
	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2

	ldy	#H_SegEnd
	lda	[SegPtr],y
	sta	Offset
	clc
	adc	BlockSize
	bcs	nextSeg		; data segments are ² 64K long
  IF VariableDSegSize THEN
	ldy	#H_SegSize
	cmp	[SegPtr],y
  ELSE
	cmp	#H_DSEG_SIZE
  ENDIF
	blt	foundSpace
	beq	foundSpace
nextSeg
 	; need to check free space and keep track of segment with
	; the most, and also the total (for later use in compact)
	ldy	#H_SegFreeSpace
	lda	[SegPtr],y
	cmp	MaxFreeSpace
	blt	@1
	sta	MaxFreeSpace
	stx	MaxFreeSeg
@1
	dex			; decrement to previous segment
	dex
	dex
	dex
	bne	allocLoop		; no segment #0

	bra	compactSeg

foundSpace		;found the space we need - allocate the block
  IF VariableDSegSize THEN
	ldy	#H_SegEnd
  ENDIF
	sta	[SegPtr],y	; update EndSeg
	lda	Offset		; store offset in low word of index
	ldy	Index
	sta	[ISegPtr],y
	txa			; x = segment #
	iny
	iny
	sta	[ISegPtr],y	; store segment # in high word of index

returnBlock
	; store data size in block
	ldy	Offset
	lda	DataSize
	sta	[SegPtr],y

	; decrement segment free space by block size
	tyx			; save offset to block in x
	ldy	#H_SegFreeSpace
	lda	[SegPtr],y
	SubWord	a,BlockSize,a
	sta	[SegPtr],y

  IF (&Type('H_SegNumBlocks') ­ 'UNDEFINED ') AND (ErrorCheck > 1) THEN
	; increment # of blocks in segment
	ldy	#H_SegNumBlocks
	lda	[SegPtr],y
	ina
	sta	[SegPtr],y
  ENDIF
	
  IF Profile THEN
  	phx
	ProfileOut 8,_H
	plx
  ENDIF
	; return a pointer to the data pointer of the block
	; x = Offset (to this block)
	txa
	clc
	adc	#H_BLOCK_OVERHEAD	; won't set carry
	adc	SegPtr
	ldx	SegPtr+2
	bcc	@1
	inx
@1
	ldy	#0	; no error
	clc
	rts


compactSeg		; compact the segment with the most free space
	lda	#0		; make sure the index doesn't reference
	ldy	Index		; any data segment
	iny
	iny
	sta	[ISegPtr],y

  	lda	MaxFreeSpace
  IF H_LARGE_BLOCK_SIZE > H_MIN_COMPACT THEN
	cmp	BlockSize		; is there enough free space for the
	blt	newSeg		; block?
  ENDIF
	cmp	#H_MIN_COMPACT	; is there enough free space to be worth
	blt	newSeg		; compacting?

	PushLong	ISegPtr		; CompactSegment modifies ISegPtr
  	jsr	CompactSegment
	PullLong	ISegPtr
	bcs	newSeg		; couldn't compact the segment
	
	; now jump into allocLoop at the iteration for the compacted
	; segment to allocate the block - allocLoop WILL succeed, since
	; we checked above that BlockSize ² MaxFreeSpace
	ldx	MaxFreeSeg
	brl	allocLoop	; backwards branch


newSeg			; allocate a new segment
	jsr	NewDataSegment

	; recalculate ISegPtr in case the index table was moved during the
	; call to NewDataSegment (which can happen even if NewDataSegment fails)
	ldy	Index+2
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
					; carry from NewDataSegment still good
	bcs	squeeze			; couldn't get a new segment
					; error is in ErrorFlag

	; now jump into allocLoop at the last iteration to allocate the block
	; allocLoop WILL succeed, since BlockSize < H_LARGE_BLOCK_SIZE < SegSize
	ldx	H_NumDSegments
	brl	allocLoop		; backwards branch


squeeze		; call SqueezeHeap to try and find more space
  IF Squeezing THEN
	PushLong	ISegPtr		; SqueezeHeap modifies ISegPtr
	ldx	#0		; don't dispose of segments
	jsr	SqueezeHeap
	PullLong	ISegPtr

	lda	MaxFreeSpace	; did we find enough space?
	cmp	BlockSize
    IF UseLastResort THEN
	blt	tryLargeBlock	; no - try finding a handle for the block
				; as a last resort
    ELSE
	blt	noBlock
    ENDIF

	; now jump into allocLoop at the iteration for the compacted
	; segment to allocate the block - allocLoop WILL succeed, since
	; we checked above that BlockSize ² MaxFreeSpace
	ldx	MaxFreeSeg
	brl	allocLoop	; backwards branch
  ELSE
	; if we didn't compact but could have, do it now
	lda	H_NumDSegments
    IF UseLastResort THEN
	beq	tryLargeBlock	; nothing to compact - try largeBlock
    ELSE
	beq	noBlock		; nothing to compact - failed
    ENDIF
	
	CmpWord	MaxFreeSpace,BlockSize
    IF UseLastResort THEN
	blt	tryLargeBlock	; not enough space even if we compact
    ELSE
	blt	noBlock		; not enough space even if we compact
    ENDIF
	
  	jsr	CompactSegment
    IF UseLastResort THEN
	bcs	tryLargeBlock	; couldn't compact the segment
    ELSE
	bcs	noBlock		; couldn't compact the segment
    ENDIF
	
	; now jump into allocLoop at the iteration for the compacted
	; segment to allocate the block - allocLoop WILL succeed, since
	; we checked above that BlockSize ² MaxFreeSpace
	ldx	MaxFreeSeg
	brl	allocLoop	; backwards branch
  ENDIF

  IF UseLastResort THEN
tryLargeBlock
	lda	SkipLastResort
	bne	noBlock	; don't bother if SkipLastResort flag set
			; i.e. we came from resizing a handle
  ENDIF

largeBlock		; allocate a handle for a large block
  IF Verbose THEN
    IF Verbose > 1 THEN
	Call	D_AlertBox,in=(#OkBox:w,#largeBlockMesg:l),out=(a:w)
    ELSE
	Call	D_WordBox,in=(#largeBlockMesg:l)
    ENDIF
	DEBRK
  ENDIF
	SpaceLong
	PushLong	DataSize
	ProfileIn 15,_H
	jsl	D_NeedHand
	sta	ErrorFlag			; save error
  IF Profile THEN
	php
	ProfileOut 15,_H
	plp
  ENDIF
	; recalculate ISegPtr in case the index table was moved during the
	; call to D_NeedHand (which can happen even if D_NeedHand fails)
	ldy	Index+2
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr

	pla
	sta	Ptr
	ldy	Index
	sta	[ISegPtr],y
	pla
	sta	Ptr+2
	ora	#H_LARGE_BLOCK_FLAG
	iny
	iny
	sta	[ISegPtr],y
	bcs	noLBlock		; carry has been preserved from D_NeedHand

  	ProfileOut 8,_H
  IF Verbose = 1 THEN
	Call	D_CloseWordBox
  ENDIF
  	; return pointer to block
	ldy	#2
	lda	[Ptr],y
	tax
	lda	[Ptr]
	ldy	#0	; no error
	clc
	rts

noLBlock
  IF Verbose = 1 THEN
	Call	D_CloseWordBox
  ENDIF
noBlock
	lda	#0
	tax
	ldy	ErrorFlag		; return error in y
	sec
	rts

  IF ErrorCheck THEN
bbsMesg	str	'NewBlock: corrupt data free list!'
  ENDIF

  IF Verbose THEN
largeBlockMesg	str	'NewBlock: allocating large block'
  ENDIF
	ENDP

;¦;--------------------------------------------------------------
; DisposeBlock()
;
; Dispose of a block.
;
; pre:	Index = segment & offset of index to block to be disposed
;	ISegPtr = ptr to index segment
;
; Zpage variables modified: 
;	DataSize
;	FreeListOffset
;	Offset
;	SegPtr
;	Segment

DisposeBlock	PROC	ENTRY

  IF ErrorCheck THEN
	MoveLong	Index,xy
	jsr	VerifyIndex
	bcc	@1
	rts
@1
  ENDIF
	; get data segment:offset from index
	ldy	Index		; index offset
	lda	[ISegPtr],y	; data offset
	sta	Offset
	iny
	iny
	lda	[ISegPtr],y	; data segment

; two cases: Sign bit clear => small block (index contains segment:offset)
;	   Sign bit set => large block (index contains flag:handle)
;		         or free index (index contains flag:next_index)
	bmi	handleOrFree
	beq	done		; zero segment => zero size (virtual) block

; case 1: small block
; accumulator contains segment #
	sta	Segment
	tay

; use offset and the segment pointer (at [H_DSegPtrLo/Hi],y)
; to get the size from the first word of the block.
	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2

	ldy	Offset
	beq	done		; zero offset => zero size (virtual) block
	lda	[SegPtr],y	; data size

  IF GrowBlocks THEN
	ora	#$8000		; set high bit of size to flag block as deleted
	sta	[SegPtr],y
	and	#$7FFF
  ENDIF
	beq	adjustSegment	; zero size real block (created by resizing)
	cmp	#H_MAX_FREE_LIST+1	; is this block too large
	bge	adjustSegment	; to be on a free list?
	sta	DataSize

	; calculate the offset into the free list:
	; free list offset = data_size / (H_BLOCK_GRAN/2)
	; = (block_size / (H_BLOCK_GRAN/2)) - 2*H_BLOCK_OVERHEAD/H_BLOCK_GRAN
	; we assume that H_BLOCK_GRAN is a power of 2
	;lda	DataSize		; the data size (already in a)
	DivByPwr2	a,(H_BLOCK_GRAN/2)	; divide a by H_BLOCK_GRAN/2
	sta	FreeListOffset	; save the free list offset

	; insert block at head of data segment free list
  IF H_BLOCK_OVERHEAD = 2 THEN
	iny			; adjust block offset to past overhead
	iny
	tyx			; and save in x
  ELSE
	tya			; adjust block offset to past overhead
	clc
	adc	#H_BLOCK_OVERHEAD
	tax			; and save in x
  ENDIF
	ldy	FreeListOffset
	lda	[SegPtr],y	; get free list head
	txy			; restore adjusted offset to block
	sta	[SegPtr],y	; store free list head in disposed block

	lda	Offset		; save block offset in free list head
	ldy	FreeListOffset
	sta	[SegPtr],y

	; if seg of block < seg in header block free list,
	; or if header block free list is empty, then update
	;ldy	FreeListOffset	; get free list head
	lda	[H_FreeListArray],y
	beq	updateFreeListHead	; update if empty

	cmp	Segment		; update if > block segment
	BLE	noUpdateFreeListHead

updateFreeListHead
	lda	Segment
	sta	[H_FreeListArray],y
noUpdateFreeListHead
	lda	DataSize

adjustSegment
	; a = data size
	; increment segment free space by block size
	ldy	#H_SegFreeSpace
	clc
	adc	#H_BLOCK_OVERHEAD	; won't set carry
	adc	[SegPtr],y
	sta	[SegPtr],y
	
  IF (&Type('H_SegNumBlocks') ­ 'UNDEFINED ') AND (ErrorCheck > 1) THEN
	; decrement # of blocks in segment
	ldy	#H_SegNumBlocks
	lda	[SegPtr],y
	dea
	sta	[SegPtr],y
  ENDIF
done
	rts


; case 2: handle or free index
handleOrFree
	; a = high word of index = flag + high word of handle
  IF ErrorCheck THEN
	cmp	#H_LARGE_BLOCK_FLAG	; H_LARGE_BLOCK_FLAG > H_FREE_INDEX_FLAG
	blt	freeIndex
  ENDIF
	and	#$FF		; mask out flag
	pha
	lda	Offset		; low word of handle
	pha
	_DisposeHandle
	rts

  IF ErrorCheck THEN
freeIndex
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	DEBRK2
	rts

ErrorMesg	str	'H_DisposeBlock: Attempt to dispose of a free index!'
  ENDIF	; ErrorCheck

	ENDP

;¦;--------------------------------------------------------------
; CompactMoveBlock
;
; Move a block from one data segment to another
;
; pre:	x should contain the offset in the destination data segment.
;	[ISegPtr],y should reference the high word of the index of the block
;	to be moved.
;	The source data segment address should be punched into the code
;	wherever !0000 appears, and the data bank should be set accordingly.
;	The destination data segment address should be punched into the code
;	wherever >000000 appears.
;	If the source segment begins within 16 bytes of the end of a bank,
;	moveLoop should be puched at address whichLoop+1, otherwise
;	check16 should be puched there.
;
; post:	x will contain the offset in the destination segment just past the
;	end of the block.
;	y will contain the offset in the source segment just past the
;	end of the block.

CompactMoveBlock	PROC	ENTRY

	ENTRY	loadSize, whichLoop, check16, moveLoop
	ENTRY	l0, s0, l2, s2, l4, s4, l8, s8, l10, s10, l12, s12, l14, s14
	ENTRY	load, store

	; y = offset (from ISegPtr) to high word of index to block to be moved.
	dey
	dey
	lda	[ISegPtr],y		; old (src) offset
	sta	Offset

	; store the new block offset in the index,
	; and store the offset to the end of the block
	; in the code to check loop termination
	txa			; x = new (destination) offset
	sta	[ISegPtr],y
	ldy	Offset
	clc			; add overhead and block size
	adc	#H_BLOCK_OVERHEAD
loadSize	adc	!0000,y		; - MODIFIED
	sta	>checkEnd+1	; store in code
	sec
	sbc	#16
	sta	>check16+1	; store 16 less in code

	; "jmp moveLoop" if the segment is too close to the end of a bank
whichLoop	jmp	check16		; - MODIFIED
	
	; now copy the block (16 bytes at a time)
moveLoop16
l0	lda	!0000,y		; - MODIFIED
s0	sta	>000000,x
l2	lda	!0000,y
s2	sta	>000000,x
l4	lda	!0000,y
s4	sta	>000000,x
l6	lda	!0000,y
s6	sta	>000000,x
l8	lda	!0000,y
s8	sta	>000000,x
l10	lda	!0000,y
s10	sta	>000000,x
l12	lda	!0000,y
s12	sta	>000000,x
l14	lda	!0000,y
s14	sta	>000000,x
	tya
	clc
	adc	#16	; will not set carry
	tay
	txa
	adc	#16
	tax
check16	cpx	#0000	; (new offset to end of block)-16 - MODIFIED
	blt	moveLoop16

	; copy the rest, a word at a time
moveLoop
load	lda	!0000,y		; - MODIFIED
store	sta	>000000,x		; - MODIFIED
	iny
	iny
	inx
	inx
checkEnd	cpx	#0000		; new offset to end of block - MODIFIED
	blt	moveLoop

	rts

	ENDP
	
;¦;--------------------------------------------------------------
  IF Squeezing THEN
; SqueezeHeap(DisposeSegs:x)
;
; Compact the heap, squeezing blocks into segments
; Returns with the size of largest free block in MaxFreeSpace
; and the corresponding segment in MaxFreeSeg
; Algorithm:
;     for each segment from 4 to H_NSegments
;         compact segment
;	fill segment (until H_SegFreeSpace < H_MIN_SQUEEZE) from higher segments
;     if DisposeSegs then dispose of any empty segments

; Zpage variables modified:
;	H_NSegments
;	DP	(aliased to Size)
;	EndPtr
;	MaxFreeSeg
;	MaxFreeSpace
;	Offset
;	OldPtr
;	Ptr
;	SegHandle
;	SegPtr

SqueezeHeap	PROC	ENTRY

Size	equ	DP

	txa
	sta	>DisposeSegs	; this space is below, in the code

	ProfileIn 6,_H

	stz	MaxFreeSpace

	jsl	D_CheckPurge	; verify System Handle is available
	bcc	@9
	rts			; oops - it's not available
@9

  IF Verbose > 1 THEN
	Call	D_AlertBox,in=(#OkBox:w,#SqueezeMesg:l),out=(a:w)
	DEBRK
  ENDIF

	phb			; save data bank

	lda	#4		; first segment
fillSegsLoop
	cmp	H_NumDSegments
	bge	filledSegs

	sta	MaxFreeSeg
	jsr	CompactSegment	; compact this segment.  sets up SegPtr
	jsr	FillSeg		; fill leftover space.   uses SegPtr
	AddWord	MaxFreeSeg,#4,a
	bra	fillSegsLoop

filledSegs
	bne	@1		; a > H_NSegments (only happens if H_NSegments = 0)
	sta	MaxFreeSeg	; compact last segment
	jsr	CompactSegment
@1

; find segment with most free space - dispose of empty segments (if DisposeSegs)
	stz	MaxFreeSpace

	MoveWord	H_NumDSegments,Segment
	beq	foundMax

findMaxLoop
	tay

	lda	[H_DSegPtrLo],y
	sta	SegPtr
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2

	ldy	#H_SegFreeSpace
	lda	[SegPtr],y
	ldy	Segment

	cmp	MaxFreeSpace
	blt	@1
	sta	MaxFreeSpace
	sty	MaxFreeSeg
@1
  IF VariableDSegSize THEN
	clc
	adc	#DSEG_HDR_SIZE
	ldy	#H_SegSize
	cmp	[SegPtr],y
  ELSE
	cmp	#H_DSEG_SIZE-DSEG_HDR_SIZE
  ENDIF
	blt	nextSeg
	
	lda	>DisposeSegs
	beq	nextSeg

	; dispose of the segment
  IF VariableDSegSize THEN
	ldy	Segment
  ENDIF
	lda	[H_DSegHandleHi],y
	pha
	lda	[H_DSegHandleLo],y
	pha
	_DisposeHandle
	SubWord	H_NumDSegments,#4,H_NumDSegments
	MoveWord	a,[H_HeaderPtr]:#H_NumDSegments
	
nextSeg
	SubWord	Segment,#4,Segment
	bne	findMaxLoop
foundMax

; zero out the data free lists in the header
	ldy	#2*(H_N_FREE_LISTS-1)
	;lda	#0		- a already 0 at foundMax
zeroHdrFreeListLoop
	sta	[H_FreeListArray],y
	dey
	dey
	bpl	zeroHdrFreeListLoop

	plb			; restore data bank

	ProfileOut 6,_H

	clc
	rts

DisposeSegs	DS.W	1

  IF Verbose THEN
SqueezeMesg	str	'Squeezing HeapÉ'
  ENDIF

;-------------------------------------------
FillSeg	; fill the segment whose number is in MaxFreeSeg.
	; segment must already be compacted.
	; while H_SegFreeSpace ³ H_MIN_SQUEEZE
	;   for each segment from H_NumDSegments down to MaxFreeSeg+4
	;     for each block
	;       if size ² H_SegFreeSpace
	;         transfer block

	ldy	#H_SegFreeSpace
	lda	[SegPtr],y
	cmp	#H_MIN_SQUEEZE
	bge	@1
	rts

@1	sta	MaxFreeSpace

	; set data bank = code bank to modify CompactMoveBlock code
	phk
	plb

	; copy SegPtr
	lda	SegPtr+2
	sta	Ptr+2
	lda	SegPtr
	sta	Ptr

	sta	store+1		; store the destination address in
	lda	SegPtr+1		; the code
	sta	store+2

	; setup the store addresses in moveLoop16 (in CompactMoveBlock)
	ldx	#0
	ldy	#8
storeLoop
	lda	Ptr+1
	sta	s0+2,x
	lda	Ptr
	sta	s0+1,x

	clc
	adc	#2
	sta	Ptr
	bcc	@1
	inc	Ptr+2
@1
	AddWord	x,#s2-s0,x
	dey
	bne	storeLoop

	MoveWord	[SegPtr]:#H_SegEnd,x	; offset to the end of data

	ldy	H_NumDSegments		; segment to fetch blocks from
	jsr	SetFetchSegment		; sets Segment, data bank

	ldy	H_NumISegments
	beq	filled
fillLoop
	phy			; save index segment #
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	cpy	H_NumISegments
	bne	@1
	ldy	H_EndIndex
	bra	fillSegLoop
@1	ldy	#H_ISEG_SIZE

fillSegLoop			; loop through index segment backwards
	dey			; offset to high word of (previous) index
	dey
	lda	[ISegPtr],y
	cmp	Segment
	bne	nextBlock

	; found a block in the fetch segment
	phy

	; is the block small enough to fit in the fill segment?
	dey
	dey
	lda	[ISegPtr],y	; offset to block
	tay
	lda	(OldPtr),y	; data size of block
  IF H_BLOCK_OVERHEAD = 2 THEN
	ina
	ina
  ELSE
	clc
	adc	#H_BLOCK_OVERHEAD
  ENDIF
	; a = block size
	cmp	MaxFreeSpace
	BGT	@1		; too big
	sta	Size		; block size

	lda	1,s		; restore saved y, leave on stack
	tay
	lda	MaxFreeSeg	; set the new segment #
	sta	[ISegPtr],y

	jsr	CompactMoveBlock	; move the block

	; no attempt is made to put the space freed up by moving the block
	; onto a free list, because the segment will be compacted later

	ldy	#H_SegFreeSpace
	lda	[OldPtr],y	; adjust source segment free space
	clc
	adc	Size
	sta	[OldPtr],y

	lda	MaxFreeSpace	; adjust destination segment free space
	sec
	sbc	Size
	sta	MaxFreeSpace

	cmp	#H_MIN_SQUEEZE	; is the segment full enough yet?
	bge	@1		; no - keep going

	; yes - done with segment - clean up stack
	ply
	ply			; index segment #
	bra	doneFillSeg

@1	ply

nextBlock
	dey			; offset to low word of index
	dey
	bne	fillSegLoop

	pla			; index segment #
	SubWord	a,#4,y
	bne	fillLoop
filled


; try next segment until segment ² MaxFreeSeg

	SubWord	Segment,#4,a
	cmp	MaxFreeSeg
	beq	doneFillSeg	; done - no more segments to use

	tay			; segment to fetch from
	jsr	SetFetchSegment	; sets Segment, data bank

	ldy	H_NumISegments
	bne	fillLoop

doneFillSeg
	MoveWord	x,[SegPtr]:#H_SegEnd	; save new offset to end of data
	MoveWord	MaxFreeSpace,[SegPtr]:#H_SegFreeSpace	; new free space
	rts

;------------------------------------------------------
SetFetchSegment

	phx			; save x

	sty	Segment
	lda	[H_DSegPtrHi],y
	sta	OldPtr+2
	lda	[H_DSegPtrLo],y
	sta	OldPtr

	; set data bank = code bank to modify CompactMoveBlock code
	phk
	plb

	; store the source address in the code
	sta	loadSize+1
	sta	load+1

	; make sure we're not too close to the end of a bank
	; if we are, we can't use the loop to move 16 bytes at a time
	cmp	#-16
	blt	@1
	lda	#moveLoop
	bra	@2
@1	lda	#check16
@2	sta	whichLoop+1	; modify the jmp accordingly

	; setup the load addresses in moveLoop16 (in CompactMoveBlock)
	lda	OldPtr
	ldx	#0
	ldy	#8
loadLoop
	sta	l0+1,x
	ina
	ina
	pha
	AddWord	x,#l2-l0,x
	pla
	dey
	bne	loadLoop

	; set data bank = segment
	pei	OldPtr+1	; 2nd & 3rd bytes of address
	plb		; 2nd byte
	plb		; 3rd byte (bank)

	plx		; restore x
	rts

	ENDP
  ENDIF

;¦;--------------------------------------------------------------
; CompactSegment()
;
; Compact the data segment whose number * 4 is in MaxFreeSeg
; by copying each block into a temporary area (D_SystemHandle)
; and then copying it back again

; Zpage variables modified: 
;	ISegPtr
;	Offset
;	OldPtr
;	Ptr
;	SegPtr

CompactSegment	PROC	ENTRY

	ProfileIn 14,_H

	jsl	D_CheckPurge	; verify System Handle is available
	bcc	@9
	rts			; oops - it's not available
@9
  IF Verbose THEN
    IF Verbose > 1 THEN
	Call	D_AlertBox,in=(#OkBox:w,#CompactMesg:l),out=(a:w)
    ELSE
	Call	D_WordBox,in=(#CompactMesg:l)
    ENDIF
  ENDIF
  
	; get SegPtr
	ldy	MaxFreeSeg
	lda	[H_DSegPtrHi],y
	sta	SegPtr+2
	lda	[H_DSegPtrLo],y
	sta	SegPtr

	; check to see if the segment is already compacted
	; i.e. if SegSize - SegEnd - SegFreeSpace = 0
  IF VariableDSegSize THEN
	MoveWord	[SegPtr]:#H_SegSize,a
  ELSE
	lda	#H_DSEG_SIZE
  ENDIF
	SubWord	a,[SegPtr]:#H_SegEnd,a
	SubWord	a,[SegPtr]:#H_SegFreeSpace,a
	bne	@8
	clc
	rts
@8
	phb		; save data bank

	; set the data bank to the code bank to modify code
	phk
	plb

	lda	SegPtr
	sta	loadSize+1	; store the source address in the code
	sta	load+1		; store the source address in the code
	
	; make sure we're not too close to the end of a bank
	; if we are, we can't use the loop to move 16 bytes at a time
	cmp	#-16
	blt	@1
	lda	#moveLoop
	bra	@2
@1	lda	#check16
@2	sta	whichLoop+1	; modify the jmp accordingly

	; setup the load addresses in moveLoop16 (in CompactMoveBlock)
	lda	SegPtr
	ldx	#0
	ldy	#8
loadLoop
	sta	l0+1,x
	ina
	ina
	sta	Ptr
	AddWord	x,#l2-l0,x
	lda	Ptr
	dey
	bne	loadLoop

	lda	>D_SystemHandle
	sta	OldPtr
	lda	>D_SystemHandle+2
	sta	OldPtr+2
	Deref	OldPtr		; leaves result in ax
	sta	Ptr
	stx	Ptr+2
	sta	store+1		; store the destination address in
	lda	OldPtr+1		; the code
	sta	store+2

	; setup the store addresses in moveLoop16 (in CompactMoveBlock)
	ldx	#0
	ldy	#8
storeLoop
	lda	Ptr+1
	sta	s0+2,x
	lda	Ptr
	sta	s0+1,x

	clc
	adc	#2
	sta	Ptr
	bcc	@1
	inc	Ptr+2
@1
	AddWord	x,#s2-s0,x
	dey
	bne	storeLoop

	
	; set the data bank to the segment
	pei	SegPtr+1	; 2nd & 3rd bytes of address
	plb		; 2nd byte
	plb		; 3rd byte (bank)


; traverse the index table (in reverse order) to find all blocks in the segment
; and move each in turn

	ldx	#DSEG_HDR_SIZE	; initialize new data block offset

	ldy	H_NumISegments
	beq	compacted
compactLoop
	sty	Segment
	lda	[H_ISegPtrHi],y
	sta	ISegPtr+2
	lda	[H_ISegPtrLo],y
	sta	ISegPtr
	cpy	H_NumISegments
	bne	@1
	ldy	H_EndIndex
	bra	compactSegLoop
@1	ldy	#H_ISEG_SIZE

compactSegLoop			; loop through index segment backwards
	dey			; offset to high word of (previous) index
	dey
	lda	[ISegPtr],y
	cmp	MaxFreeSeg
	bne	nextBlock

	phy
	jsr	CompactMoveBlock
	ply

nextBlock
	dey			; offset to low word of index
	dey
	bne	compactSegLoop

	SubWord	Segment,#4,y
	bne	compactLoop
compacted


; fix up the segment header
	txa			; x = offset to next block
	ldy	#H_SegEnd		; = end of used portion of segment
	sta	[SegPtr],y
	
	; SegFreeSpace has not changed
	
	; zero the free list
  IF (H_SegFreeList = 0) THEN
 	ldy	#2*(H_N_FREE_LISTS-1)
	lda	#0
zeroFreeListLoop
	sta	[SegPtr],y
	dey
	dey
	bpl	zeroFreeListLoop
  ELSE 
	ldy	#H_SegFreeList
	ldx	#H_N_FREE_LISTS
	lda	#0
zeroFreeListLoop
	sta	[SegPtr],y
	iny
	iny
	dex
	bne	zeroFreeListLoop
  ENDIF

; now copy the compacted data back to the data segment
; _BlockMove(Ptr+DSEG_HDR_SIZE,SegPtr+DSEG_HDR_SIZE,SegSize-#DSEG_HDR_SIZE)
	MoveLong	OldPtr,ax		; OldPtr = [D_SystemHandle]
	clc
	adc	#DSEG_HDR_SIZE
	bcc	@1
	inx
@1	phx
	pha

	MoveLong	SegPtr,ax
	clc
	adc	#DSEG_HDR_SIZE
	bcc	@2
	inx
@2	phx
	pha
  IF VariableDSegSize THEN
	PushWord	#0
	SubWord	[SegPtr]:#H_SegSize,#DSEG_HDR_SIZE,s
  ELSE
	PushLong	#H_DSEG_SIZE-DSEG_HDR_SIZE
  ENDIF
	_BlockMove
	
	plb		; restore data bank

  IF Verbose = 1 THEN
	Call	D_CloseWordBox
  ENDIF
	ProfileOut 14,_H

	clc
	rts

  IF Verbose THEN
CompactMesg	str	'Compacting Heap SegmentÉ'
  ENDIF
  
	ENDP

;¦;--------------------------------------------------------------
; NewDataSegment()
;
; Create a new data segment and initialize its header
; Returns ErrorFlag and sets carry appropriately

; Zpage variables modified:
;	ErrorFlag
;	H_NumDSegments
;	SegHandle
;	SegPtr

NewDataSegment	PROC	ENTRY

  IF Verbose THEN
    IF Verbose > 1 THEN
	Call	D_AlertBox,in=(#OkBox:w,#newSegMesg:l),out=(a:w)
    ELSE
	Call	D_WordBox,in=(#newSegMesg:l)
    ENDIF
	DEBRK
  ENDIF
	lda	H_NumDSegments	; verify there are < H_MaxSegments
	cmp	H_MaxSegments
	blt	@1
	rts			; carry set
@1
	MoveWord	#H_DSEG_SIZE,SegSize
	MoveWord	#0,>SecondTry	; in the code, below
allocSeg
	; allocate the handle for the segment (locked)
	SpaceLong
	PushWord	#0
	PushWord	SegSize
	PushWord	#attrLocked
	ProfileIn 15,_H
	jsl	D_NeedHandle
	sta	ErrorFlag
  IF Profile THEN
	php
	ProfileOut 15,_H
	plp
  ENDIF
	PullLong	SegHandle
  IF ÂVariableDSegSize THEN
	bcs	exit
  ELSE
	bcc	gotSeg

	lda	>SecondTry		; was this the second try?
	bne	retryFailed		; yes - sec and return
	ina
	sta	>SecondTry

	; try _MaxBlock for a smaller segment
	SpaceLong
	_MaxBlock
	PullLong	ax		; x must be 0, else first allocation
	cmp	#H_MIN_DSEG_SIZE	;	would have worked
	bge	smallSeg
retryFailed
	sec
	rts
smallSeg
	sta	SegSize
	bra	allocSeg
gotSeg
  ENDIF
	; increment the # of segments and store the handle in the header
	AddWord	H_NumDSegments,#4,H_NumDSegments	; result left in a
	ldy	#H_NumDSegments
	sta	[H_HeaderPtr],y
	tay
	lda	SegHandle
	sta	[H_DSegHandleLo],y
	lda	SegHandle+2
	sta	[H_DSegHandleHi],y

	; deref the handle and store the pointer in the header
	lda	[SegHandle]
	sta	SegPtr
	sta	[H_DSegPtrLo],y
  IF ZeroInit THEN
	tax
  ENDIF
	ldy	#2
	lda	[SegHandle],y
	ldy	H_NumDSegments
	sta	SegPtr+2
	sta	[H_DSegPtrHi],y

	; initialize the data segment header
  IF ZeroInit THEN
	pha
	phx
	PushWord	SegSize
	jsl	D_ZeroBlock
  ELSE
    IF (H_SegFreeList = 0) THEN
 	ldy	#2*(H_N_FREE_LISTS-1)
	lda	#0
zeroFreeListLoop
	sta	[SegPtr],y
	dey
	dey
	bpl	zeroFreeListLoop
    ELSE 
	ldy	#H_SegFreeList
	ldx	#H_N_FREE_LISTS
	lda	#0
zeroFreeListLoop
	sta	[SegPtr],y
	iny
	iny
	dex
	bne	zeroFreeListLoop
    ENDIF
  ENDIF

	MoveWord	#DSEG_HDR_SIZE,[SegPtr]:#H_SegEnd
	SubWord	SegSize,#DSEG_HDR_SIZE,[SegPtr]:#H_SegFreeSpace

  IF &Type('H_SegSize') ­ 'UNDEFINED ' THEN
	MoveWord	SegSize,[SegPtr]:#H_SegSize
  ENDIF
  IF &Type('H_SegNumBlocks') ­ 'UNDEFINED ' THEN
	MoveWord	#0,[SegPtr]:#H_SegNumBlocks
  ENDIF

  IF Verbose = 1 THEN
	Call	D_CloseWordBox
  ENDIF
	clc
exit
	rts

SecondTry	DC.W	0

  IF Verbose THEN
newSegMesg	str	'NewBlock: allocating new segment'
  ENDIF

	ENDP

;¦;--------------------------------------------------------------
; VerifyIndex()
;
; Verify that the index in xy is valid.  Put up an alert if it's not.
;

  IF ErrorCheck THEN

VerifyIndex	PROC	ENTRY

	cpy	H_NumISegments
	beq	@1
	bge	badindexError
	cpx	#H_ISEG_SIZE
	bra	@2
@1	cpx	H_EndIndex
@2	bge	badIndexError
	txa
	and	#%11
	bne	oddIndexError
	tya
	beq	@3
	and	#%11
	bne	oddIndexError

@ok	clc
	rts

@3	txa
	beq	@ok
zeroIndexError
	SpaceWord
	PushWord	#OkBox
	PushLong	#ziMesg
	bra	error

badIndexError
	SpaceWord
	PushWord	#OkBox
	PushLong	#biMesg
	bra	error

oddIndexError
	SpaceWord
	PushWord	#OkBox
	PushLong	#oiMesg
error
	txa
	sta	>theIndex
	tya
	sta	>theIndex+2

	jsl	D_AlertBox
	pla
	DEBRK2
	sec
	rts

theIndex	DS.L	1
ziMesg	str	'H_VerifyIndex: Index 00xx'
biMesg	str	'H_VerifyIndex: Index out of range!'
oiMesg	str	'H_VerifyIndex: Misaligned Index!'

	ENDP
  ENDIF


	END