;
; Heap.aii
;
; Heap memory managment module
;
; Copyright © 1989 Claris Corporation
;
; 1-13-89 Begun by Kevin A. Watts

;
; Heap routines:
;
; H_Init()		; Initialize heap code when loaded.
; H_SegLoaded()		; Called when the heap code is loaded.
; H_SegUnloaded()		; Called when the heap code is unloaded.
; H_CurrentHeap(): HeapID:ax	; Return the ID of the current heap.
; H_SetHeap(HeapID:xy)	; Set the current heap.
; H_UnsetHeap()		; Unset the current heap.
; H_ResetHeap()		; Reset (relock) the current heap.
; H_NewHeap(): HeapID:ax	; Create a new heap, make it current & return its ID.
; H_DisposeHeap()		; Dispose of the current heap.
; H_WriteHeap(FileID:x)	; Write the current heap to disk.
; H_ReadHeap(FileID:x): HeapID:ax	; Read the current heap from disk.
; CalcHeaderPtrs		; Calculate pointers to arrays within the header.

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

	PRINT	PUSH
	PRINT	OFF

	LOAD	'Macros.Dump'

	gblc	&__FILE__
&__FILE__	setc	'Heap'

	include	'Heap.mac'
	include	'HeapPrivate.equ'
	include	'Heap.aii.i'
	include	'm16.profile'		; must be after H.equ
	include	'Driver.equ'

	IMPORT	D_Deref

	ENTRY	H_Init
  IF DriverSupport = 0 THEN
	ENTRY	H_SegLoaded
	ENTRY	H_SegUnloaded
  ENDIF
  IF ErrorCheck THEN
	ENTRY	H_CurrentHeap
  ENDIF
	ENTRY	H_SetHeap
	ENTRY	H_UnsetHeap
	ENTRY	H_ResetHeap
	ENTRY	H_NewHeap
	ENTRY	H_DisposeHeap
	ENTRY	H_ReadHeap
	ENTRY	H_WriteHeap
	ENTRY	CalcHeaderPtrs
	
	PRINT	POP

	ProfileData 16,_H
	ProfileCode _H

;¦;--------------------------------------------------------------
; H_Init()
;	no error status returned
;
; Store the address of the heap zero page into the other heap routines
; prologue.
; THIS ROUTINE MUST BE CALLED BEFORE ANY OTHER HEAP ROUTINE IS CALLED!!
; i.e. immediately after the code segment is loaded.

; Zpage variables modified:
;	H_ZPptr

H_Init	PROC	EXPORT

	ProfileInit _H

; get the Zpage address from the driver global
	IMPORT	D_HeapZPage
	lda	>D_HeapZPage

	phd

; store the Zpage address in the Zpage
	tcd			; set up the Zpage
	sta	H_ZPptr
	stz	H_ZPptr+2		; redundant, but so what?
	
; determine the maximum possible number of data or index segments and thus header size.
; we allow the same # of each type of segment, equal to
;	_TotalMem / H_DSEG_SIZE
; H_MaxSegments will be 3 times this (3/4, *4 bytes/segment handle).
; The 3/4 is based upon H_ISEG_SIZE = 1/4 H_DSEG_SIZE, and will allow the heap
; to use 15/16 of _TotalMem.  This should be sufficient.
	SpaceLong
	_TotalMem
	pla			; discard low word
	pla			; # of banks
	sta	H_MaxSegments	; multiply by 3
	asl	a
	asl	a
	sec
	sbc	H_MaxSegments
	MulByPwr2	a,($10000/H_DSEG_SIZE)	; # of banks * (64K/H_DSEG_SIZE)
	cmp	#$1000			; ensure high nibble unused
	blt	@1
	lda	#$1000-4
@1	sta	H_MaxSegments

	lda	#HANDLE_ARRAY	; offset to **index_seg[]

	clc
	adc	H_MaxSegments
	sta	H_DSegHOffsetLo	; offset to **data_seg[]
	tax
	inx
	inx
	stx	H_DSegHOffsetHi

	clc
	adc	H_MaxSegments
	sta	H_ISegPOffsetLo	; offset to *index_seg[]
	tax
	inx
	inx
	stx	H_ISegPOffsetHi

	clc
	adc	H_MaxSegments
	sta	H_DSegPOffsetLo	; offset to *data_seg[]
	tax
	inx
	inx
	stx	H_DSegPOffsetHi

	clc
	adc	H_MaxSegments
	sta	H_HeaderSize	; total size of heap header

	tdc			; load accumulator with Heap Zpage
	pld

; embed the ZP address in the other routines
; DefineZ will correctly modify any routine using BeginZ as a prologue.

	; set data bank to code bank
	phb
	phk
	plb

  IF ErrorCheck THEN
	DefineZ	H_CurrentHeap
  ENDIF
	DefineZ	H_SetHeap
	DefineZ	H_UnsetHeap
	DefineZ	H_ResetHeap
	DefineZ	H_NewHeap
	DefineZ	H_DisposeHeap

  IF HeapIO AND 1 THEN
	DefineZ	H_WriteHeap
  ENDIF
  IF HeapIO AND 2 THEN
	DefineZ	H_ReadHeap
  ENDIF
	DefineZ	H_TruncHeap

	DefineZ	H_NewBlock
	DefineZ	H_DisposeBlock
	DefineZ	H_ResizeBlock
	DefineZ	H_CopyBlock

	DefineZ	H_GetBlockPtr
	DefineZ	H_GetBlockSize

	plb	; restore data bank
	rtl
	
	ENDP

;¦;--------------------------------------------------------------
  IF DriverSupport = 0 THEN
; H_SegLoaded()
;	errors returned in accumulator (via ErrFlag)
;
; Allocate a zero page block for later use and store its address
; in the other routines so they can use it.
; THIS ROUTINE MUST BE CALLED BEFORE ANY OTHER HEAP ROUTINE IS CALLED!!
;
; Eventually, the driver should allocate the zpage for me and store the
; address in a global.  Only the code modification portion of this routine
; need remain then.  The driver will have to zero the block for me.

; Zpage variables modified: all (zero page cleared)

H_SegLoaded	PROC	EXPORT

	local	Zpage:l		; handle/pointer to Zero page
	error	ErrFlag
	BEGIN	+b

	Call	D_NeedHandle,in=(#H_ZPSIZE:l,#H_ZPATTR:w),out=(Zpage:l),err=ErrFlag
	bcc	@ok
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit
@ok

; Zero the zero page block
	Call	D_ZeroBlock,in=([Zpage]:l,#H_ZPSIZE:w)

; Embed the ZP handle in H_SegUnload so we can dispose of it later
	MoveWord	Zpage+2,H_SegUnloaded+1
	MoveWord	Zpage,H_SegUnloaded+4

; Now embed the ZP address in the other routines
	Deref	Zpage		; Zpage = [Zpage]

;	lda	Zpage		; already there after Deref
	sta	D_HeapZPage

	jsl	H_Init

exit	return

	EXPORT	D_HeapZPage
D_HeapZPage	DS.W	1

ErrorMesg	str	'H_SegLoaded: Unable to allocate heap Z page'

	ENDP

;¦;--------------------------------------------------------------
; H_SegUnloaded()
;	no error status returned
;
; Deallocate the zero page block.
; NO OTHER HEAP ROUTINE (except H_SegLoaded) MAY BE CALLED AFTER THIS ROUTINE!!
; It is assumed that there is no current heap when this routine is called.

; Zpage variables modified: all (Zpage disposed)

H_SegUnloaded	PROC	EXPORT

	pea	0000	; Replace with the ZP handle (high word)
	pea	0000	; Replace with the ZP handle (low word)
	_DisposeHandle
	rtl

	ENDP
  ENDIF		; DriverSupport = 0

;¦;--------------------------------------------------------------
  IF ErrorCheck THEN
; H_CurrentHeap(): HeapID:ax
;
; return the ID of the current heap

; Zpage variables modified: none

H_CurrentHeap	PROC	EXPORT

	BeginZ
	
	MoveLong	H_Header,ax
	
	ReturnZ

  ENDIF		; ErrorCheck

;¦;--------------------------------------------------------------
; H_SetHeap(HeapID:xy)
;	no error status returned
;
; Set the current heap: lock all its handles and copy its header information to the heap ZP.

; Zpage variables modified:
;	NewHeap
;	H_*
;	CopyHdr
;	HasMoved
;	Offset
;	SegHandle

H_SetHeap	PROC	EXPORT

	BeginZ

	MoveLong	xy,NewHeap	; save heap id (handle)

  IF Profile THEN
	ProfileIn	1,_H
	ldx	NewHeap
  ENDIF

	;CmpLong	xy,H_Header	; is this already the current heap?
	cpy	H_Header+2
	bne	@1
	cpx	H_Header
	beq	@reSet
@1
	MoveWord	#1,CopyHdr
	lda	H_Header		; is there a current heap?
	ora	H_Header+2
	beq	setHeap

	jsl	H_UnsetHeap	; first unset the current heap
	bra	setHeap

@reSet				; trying to reSet the current heap
	lda	H_IsLocked	; if it's already locked, we're done.
	beq	@2
	ReturnZ
@2	stz	CopyHdr

setHeap
	lda	NewHeap
	ora	NewHeap+2
	bne	@notZero
	StzL	H_Header
	ReturnZ
@notZero
  IF ErrorCheck THEN
	PushLong	NewHeap
	_CheckHandle
	bcc	handleOk

	Call	D_AlertBox,in=(#OkBox:w,#badHandleMesg:l),out=(a:w)
	DEBRK2
badHandleMesg	str	'H_SetHeap: Bad Heap ID!'
handleOk
  ENDIF
	;MoveLong	NewHeap,H_Header	; lock the heap header
	;PushLong	H_Header		- combined for optimization
	lda	NewHeap+2
	sta	H_Header+2
	pha
	lda	NewHeap
	sta	H_Header
	pha
	_HLock

	;MoveLong	[H_Header],H_HeaderPtr	- deref; leave result in ax
	ldy	#2
	lda	[H_Header],y
	sta	H_HeaderPtr+2
	tax
	lda	[H_Header]
	sta	H_HeaderPtr

	; find out if the heap header has moved by comparing the new
	; pointer (in ax) to the old one (in the header)
	; if it has not moved, we can avoid resetting pointers
	; if it has moved, we need to copy the new pointer back to the header
	stz	HasMoved

	; ax = H_HeaderPtr
	ldy	#H_HeaderPtr
	cmp	[H_HeaderPtr],y
	beq	@1
	sta	[H_HeaderPtr],y
	inc	HasMoved
@1	txa
	ldy	#H_HeaderPtr+2
	cmp	[H_HeaderPtr],y
	beq	@2
	sta	[H_HeaderPtr],y
	inc	HasMoved
@2
	lda	CopyHdr		; copy the header block if necessary
	beq	doneCopy

	PushLong	H_HeaderPtr
	PushLong	H_ZPptr
	PushWord	#0
	lda	HasMoved
	beq	@3
	PushWord	#ZHEADER_SHORT_SIZE	; moved - don't copy ptrs; will recalc
	bra	@4
@3	PushWord	#ZHEADER_SIZE	; didn't move - copy ptrs
@4	_BlockMove
doneCopy

; if the heap header has moved since it was last set,
; reset pointers to arrays of data segment handles and pointers
; and to array of free lists
	lda	HasMoved
	beq	@noUpdatePointers
	jsr	CalcHeaderPtrs
@noUpdatePointers

; lock and deref the index segments - this loop starts at the end and counts down
	ldy	H_NumISegments	; y = offset to last seg handle
	beq	lockedISegs

lockISegLoop
	; lock the segment
	lda	[H_ISegHandleHi],y
	sta	SegHandle+2
	pha
	lda	[H_ISegHandleLo],y
	sta	SegHandle
	pha
	sty	Offset
	_HLock			; should I do a quick lock here?

	; deref the locked handle and store the pointer into H_ISegPointers array
	ldy	#2
	lda	[SegHandle],y
	ldy	Offset
	sta	[H_ISegPtrHi],y
	lda	[SegHandle]
	sta	[H_ISegPtrLo],y

	SubWord	y,#4,y
	bne	lockISegLoop	; there is no seg #0
lockedISegs

; lock and deref the data segments - this loop starts at the end and counts down
	ldy	H_NumDSegments	; y = offset to last seg handle
	beq	lockedDSegs

lockDSegLoop
	; lock the segment
	lda	[H_DSegHandleHi],y
	sta	SegHandle+2
	pha
	lda	[H_DSegHandleLo],y
	sta	SegHandle
	pha
	sty	Offset
	_HLock			; should I do a quick lock here?

	; deref the locked handle and store the pointer into H_DSegPointers array
	ldy	#2
	lda	[SegHandle],y
	ldy	Offset
	sta	[H_DSegPtrHi],y
	lda	[SegHandle]
	sta	[H_DSegPtrLo],y

	SubWord	y,#4,y
	bne	lockDSegLoop	; there is no seg #0
lockedDSegs

	MoveWord	#1,H_IsLocked		; flag the heap as locked

	ProfileOut 1,_H

	ReturnZ
	ENDP

;¦;--------------------------------------------------------------
; H_UnsetHeap()
;	no error status returned
;
; Unset the current heap: copy its header information back from
; the heap ZP and unlock its handles
;
; Prerequisite: H_IsLocked ­ 0, H_Header ­ 0 (these are checked)

; Zpage variables modified:
;	Offset
;	H_IsLocked

H_UnsetHeap	PROC	EXPORT

	BeginZ

	ProfileIn	2,_H

	; if the current heap is not locked then there's nothing to do.
	lda	H_IsLocked
	JEQ	exit
	
	; make sure there is a current heap
	lda	H_Header
	ora	H_Header+2
	JEQ	exit
	
	; copy selected header information back to real header
	; H_Header - always maintained
	; H_HeaderPtr - always maintained
	; H_Version - always maintained (constant)
	; H_NumISegments - always maintained
	; H_NumDSegments - always maintained
	MoveLong	H_FreeIndex,[H_HeaderPtr]:#H_FreeIndex
	MoveLong	H_EndIndex,[H_HeaderPtr]:#H_EndIndex
	MoveLong	H_ISegHandleLo,[H_HeaderPtr]:#H_ISegHandleLo
	MoveLong	H_ISegHandleHi,[H_HeaderPtr]:#H_ISegHandleHi
	MoveLong	H_DSegHandleLo,[H_HeaderPtr]:#H_DSegHandleLo
	MoveLong	H_DSegHandleHi,[H_HeaderPtr]:#H_DSegHandleHi
	MoveLong	H_ISegPtrLo,[H_HeaderPtr]:#H_ISegPtrLo
	MoveLong	H_ISegPtrHi,[H_HeaderPtr]:#H_ISegPtrHi
	MoveLong	H_DSegPtrLo,[H_HeaderPtr]:#H_DSegPtrLo
	MoveLong	H_DSegPtrHi,[H_HeaderPtr]:#H_DSegPtrHi
	MoveLong	H_FreeListArray,[H_HeaderPtr]:#H_FreeListArray

; unlock the handles
; unlock the index segments - this loop starts at the end and counts down
	ldy	H_NumISegments	; y = offset to last seg handle
	beq	unlockedISegs

unlockISegLoop
	; unlock the segment
	lda	[H_ISegHandleHi],y
	pha
	lda	[H_ISegHandleLo],y
	pha
	sty	Offset
	_HUnlock			; should I do a quick unlock here?

	SubWord	Offset,#4,y
	bne	unlockISegLoop	; there is no seg #0
unlockedISegs

; unlock the data segments - this loop starts at the end and counts down
	ldy	H_NumDSegments	; y = offset to last seg handle
	beq	unlockedDSegs

unlockDSegLoop
	; unlock the segment
	lda	[H_DSegHandleHi],y
	pha
	lda	[H_DSegHandleLo],y
	pha
	sty	Offset
	_HUnlock			; should I do a quick unlock here?

	SubWord	Offset,#4,y
	bne	unlockDSegLoop	; there is no seg #0
unlockedDSegs

	PushLong	H_Header			; unlock the heap header
	_HUnlock

	stz	H_IsLocked		; flag heap as unlocked

exit	
	ProfileOut 2,_H

	ReturnZ
	ENDP

;¦;--------------------------------------------------------------
; H_ResetHeap()
;	no error status returned
;
; Reset (actually only relock) the current heap, if necessary
;
; Prerequisite: H_IsLocked = 0, H_Header ­ 0

; Zpage variables modified: none, H_SetHeap()

H_ResetHeap	PROC	EXPORT

	BeginZ

	lda	H_IsLocked
	bne	exit

	lda	H_Header
	ora	H_Header+2
	beq	exit

	; make sure the top level call was made by a heap client module
	; (SS or DB)
;	lda	D_TopModule
;	cmp	???
;	beq	@1
;	cmp	???
;	bne	exit
;@1
	MoveLong	H_Header,xy
	jsl	H_SetHeap

exit	ReturnZ
	ENDP

;¦;--------------------------------------------------------------
; H_NewHeap(): HeapID:ax
;	error status returned in y
;
; Allocate a new heap and return the handle to the heap header as the ID.
; HeapID is invalid if any error occurs.

; Zpage variables modified:
;	H_*
;	NewHeap
;	ErrorFlag

H_NewHeap	PROC	EXPORT

	BeginZ

	ProfileIn	4,_H

; unset the current heap, if any
	lda	H_Header
	ora	H_Header+2
	beq	noCurHeap
	jsl	H_UnsetHeap

	StzL	H_Header
noCurHeap

; allocate the header handle
; no index or data segments are allocated yet - that's done by H_NewBlock (NewBlock,NewIndex)
	; don't use H_Header for the result until we've successfully allocated the handle
	SpaceLong
	PushWord	#0
	PushWord	H_HeaderSize
	jsl	D_NeedHand
	sta	ErrorFlag
	PullLong	NewHeap
	bcc	lockHeader

	stz	H_IsLocked		; no heap, so not locked
  IF VerboseErrors THEN
 	Call	D_AlertBox,in=(#OkBox:w,#NoHeapMesg:l),out=(a:w)
	DEBRK3
  ENDIF
	lda	#0			; return 0 HeapID
	tax
	ldy	ErrorFlag			; return error in y
	sec
	ReturnZ

lockHeader			; lock the header handle
	;MoveLong	NewHeap,H_Header	- combined
	;PushLong	H_Header		- for efficiency
	lda	NewHeap+2
	sta	H_Header+2
	pha
	lda	NewHeap
	sta	H_Header
	pha
	_HLock

; copy and deref handles and other header info
	MoveLong	[H_Header],H_HeaderPtr

  IF H_THIS_VERSION ² $FFFF THEN	; MoveLong should do this for me
  	stz	H_Version+2
	MoveWord	#H_THIS_VERSION,H_Version
  ELSE
	MoveLong	#H_THIS_VERSION,H_Version
  ENDIF
	StzL	H_FreeIndex	; no free indices yet
	stz	H_EndIndex	; no index segment yet

; set pointers to arrays of data segment handles and pointers
; and to array of free lists
	jsr	CalcHeaderPtrs

  IF ZeroInit THEN		; zero header block
	PushLong	H_HeaderPtr
	PushWord	H_HeaderSize
	jsl	D_ZeroBlock
  ELSE
	; zero out the data free lists in the header
	ldy	#2*(H_N_FREE_LISTS-1)
	lda	#0
zeroFreeListLoop
	sta	[H_FreeListArray],y
	dey
	dey
	bpl	zeroFreeListLoop
  ENDIF
	; no index or data segments yet
	stz	H_NumISegments
	stz	H_NumDSegments

; copy the zero page to the header
	PushLong	H_ZPptr
	PushLong	H_HeaderPtr
	PushLong	#ZHEADER_SIZE
	_BlockMove

	ProfileOut 4,_H

	ldy	#1
	sty	H_IsLocked		; flag the heap as locked
	MoveLong	H_Header,ax		; return the heap id
	dey				; no error (y = 0)
	clc
	ReturnZ

  IF VerboseErrors THEN
NoHeapMesg	str	'H_NewHeap: Unable to allocate new heap'
  ENDIF
	ENDP

;¦;--------------------------------------------------------------
; H_DisposeHeap()
;	no error status returned
;
; Dispose of the current heap
;
; Prerequisite: H_Header, H_HeaderPtr ­ 0

; Zpage variables modified:
;	Offset
;	H_Header
;	H_HeaderPtr
;	H_IsLocked
;	Segment
;	SegHandle
;	SegPtr

H_DisposeHeap	PROC	EXPORT

	BeginZ

	ProfileIn	5,_H

; dispose of all large blocks and index segments 
; - we are traversing the index segments backwards
	ldy	H_NumISegments
	beq	disposedIndices
disposeIndicesLoop
	sty	Segment
	lda	[H_ISegHandleHi],y	; check that the segment is really there
	tax			;   (x for D_Deref below)
	ora	[H_ISegHandleLo],y	; (might not be if recovering from
	beq	nextISeg		; failed H_ReadHeap)

	; don't get ptr from table - won't be there if called from H_ReadHeap
	lda	[H_ISegHandleLo],y	; x was set above
	jsl	D_Deref
	MoveLong	ax,SegPtr

	CmpWord	Segment,H_NumISegments
	bne	@1
	ldy	H_EndIndex
	bra	disposeLargeLoop
@1	ldy	#H_ISEG_SIZE

disposeLargeLoop			; loop through index segment backwards
	dey			; offset to high word of (previous) index
	dey
	lda	[SegPtr],y
	bpl	nextLargeBlock
	cmp	#H_LARGE_BLOCK_FLAG
	blt	nextLargeBlock

	sty	Offset
	and	#$00FF
	pha
	dey			; offset to low word of index
	dey
	lda	[SegPtr],y
	pha
	_DisposeHandle
	ldy	Offset

nextLargeBlock
	dey			; offset to low word of index
	dey
	bne	disposeLargeLoop

	; now dispose of the index segment
	ldy	Segment
	lda	[H_ISegHandleHi],y
	pha
	lda	[H_ISegHandleLo],y
	pha
	_DisposeHandle
nextISeg
	SubWord	Segment,#4,y
	bne	disposeIndicesLoop
disposedIndices

; dispose of the data segments - this loop starts at the end and counts down
	ldy	H_NumDSegments	; y = offset to last seg handle
	beq	disposedDSegs
disposeDSegLoop
	; unlock the segment
	sty	Segment
	lda	[H_DSegHandleHi],y
	sta	SegHandle+2
	lda	[H_DSegHandleLo],y
	sta	SegHandle
	ora	SegHandle+2
	beq	@next			; no handle here
	PushLong	SegHandle
	_DisposeHandle
@next
	SubWord	Segment,#4,y
	bne	disposeDSegLoop		; there is no seg #0
disposedDSegs

disposeHdr
	PushLong	H_Header			; dispose of the heap header
	_DisposeHandle

	StzL	H_Header			; clear the current heap id
	StzL	H_HeaderPtr		; and pointer
	stz	H_IsLocked		; and flag as unlocked

	ProfileOut 5,_H

	ReturnZ
	ENDP

;¦;--------------------------------------------------------------
; H_WriteHeap(FileID:x)
;
; Write the current heap to disk.
; Writes to the (currently open) file indicated by FileID.

; Format of heap as written to disk:
;	Header			- First 4 bytes are 'Heap'
;	Index Segment H_NumISegments
;		:
;		:
;	Index Segment 4
;	Data Segment H_NumDSegments
;		:
;		:
;	Data Segment 4
;	Last large block (last in last index segment)
;		:
;		:
;	First large block (first in first index segment)

; Zpage variables modified:
;	DP
;	Segment
;	SegPtr
;	Offset

H_WriteHeap	PROC	EXPORT
  IF HeapIO AND 1 THEN

	BeginZ

	phx			; save the FileID

	; squeeze heap down to minimum size
	jsl	H_TruncHeap

	plx
	stx	DP		; save the FileID in DP

	; copy selected header information back to real header
	; H_Header - always maintained
	; H_HeaderPtr - always maintained
	; H_Version - always maintained (constant)
	; H_NumISegments - always maintained
	; H_NumDSegments - always maintained
	MoveLong H_FreeIndex,[H_HeaderPtr]:#H_FreeIndex
	MoveWord H_EndIndex,[H_HeaderPtr]:#H_EndIndex
	; H_ISegHandleLo - don't care here
	; H_ISegHandleHi - don't care here
	; H_DSegHandleLo - don't care here
	; H_DSegHandleHi - don't care here
	; H_ISegPtrLo - don't care here
	; H_ISegPtrHi - don't care here
	; H_DSegPtrLo - don't care here
	; H_DSegPtrHi - don't care here
	; H_FreeListArray - don't care here

	; punch a fake value into the header to facilitate
	; human finding of saved heaps
  IF H_Header = 0 THEN
	MoveLong	#'paeH',[H_HeaderPtr]	; that's 'Heap'
  ELSE
	MoveLong	#'paeH',[H_HeaderPtr]:#H_Header
  ENDIF
	; write out header
	PushWord	DP
	PushLong	H_Header
	jsl	D_WriteHandle2
	php
	pha
	; restore proper header value
  IF H_Header = 0 THEN
	MoveLong	H_Header,[H_HeaderPtr]
  ELSE
	MoveLong	H_Header,[H_HeaderPtr]:#H_Header
  ENDIF
	pla
	plp
	jcs	exit

writeDSegs		; write out data segments (first to last)
	lda	H_NumDSegments
	beq	writeISegs
	lda	#0
writeDSegLoop
	AddWord	a,#4,y
	sty	Segment
	PushWord	DP
	lda	[H_DSegHandleHi],y
	pha
	lda	[H_DSegHandleLo],y
	pha
	jsl	D_WriteHandle2
	bcs	exit
	lda	Segment
	cmp	H_NumDSegments
	blt	writeDSegLoop

writeISegs		; write out index segments (last to first)
	lda	H_NumISegments
	beq	writeLarge
	tay
writeISegLoop
	sty	Segment
	PushWord	DP
	lda	[H_ISegHandleHi],y
	pha
	lda	[H_ISegHandleLo],y
	pha
	jsl	D_WriteHandle2
	bcs	exit
	SubWord	Segment,#4,y
	bne	writeISegLoop

; write out all large blocks - we are traversing the index segments backwards
writeLarge
	ldy	H_NumISegments
	beq	writtenLargeBlocks
writeBlockLoop
	sty	Segment
	lda	[H_ISegPtrHi],y
	sta	SegPtr+2
	lda	[H_ISegPtrLo],y
	sta	SegPtr
	cpy	H_NumISegments
	bne	@1
	ldy	H_EndIndex
	bra	writeLargeLoop
@1	ldy	#H_ISEG_SIZE

writeLargeLoop			; loop through index segment backwards
	dey			; offset to high word of (previous) index
	dey
	lda	[SegPtr],y
	bpl	nextLargeBlock
	cmp	#H_LARGE_BLOCK_FLAG
	blt	nextLargeBlock

	pei	DP
	sty	Offset
	and	#$00FF
	pha
	dey			; offset to low word of index
	dey
	lda	[SegPtr],y
	pha
	jsl	D_WriteHandle2
	bcs	exit
	ldy	Offset

nextLargeBlock
	dey			; offset to low word of index
	dey
	bne	writeLargeLoop

	SubWord	Segment,#4,y
	bne	writeBlockLoop
writtenLargeBlocks

	lda	#0		; no error
	clc

exit				; carry already set if we came here on a error
	tay			; return errors in y
	ReturnZ
  ELSE
	ldy	#-1
	sec
	rtl
  ENDIF		; HeapIO
	ENDP

;¦;--------------------------------------------------------------
; H_ReadHeap(FileID:x): HeapID:ax
;
; Read a heap from disk, make it the current heap, and return the heap id.
; Reads from the (currently open) file indicated by FileID.
; The old current heap will be unset, even if an error occurs.

; Zpage variables modified:
;	H_Header
;	H_IsLocked
;	H_HeaderPtr
;	H_FreeIndex
;	H_EndIndex
;	H_NumISegments
;	H_NumDSegments
;	ErrorFlag		; = Version Flag
;	DP		; = FileID
;	NewHeap
;	Ptr
;	DataSize
;	SegHandle
;	SegPtr
;	Segment
;	OldPtr
;	H_SetHeap()
;	H_UnsetHeap()
;	H_DisposeHeap()
;	CalcHeaderPtrs()

H_ReadHeap	PROC	EXPORT
  IF HeapIO AND 2 THEN

	BeginZ

	stx	DP		; save the FileID

	; unset the current heap, if any
	lda	H_Header
	ora	H_Header+2
	beq	noCurHeap
	jsl	H_UnsetHeap

	StzL	H_Header
	stz	H_IsLocked
noCurHeap

; read in the heap header - update header & Z page
	SpaceLong
	PushWord	DP
	jsl	D_ReadHandle2
	PullLong	NewHeap		; don't use H_Header in case H_UnsetHeap is called
	bcc	@headerOk1
	tay			; return errors in y
	sec
	ReturnZ
@headerOk1

	; check header 'signature'
	MoveLong	[NewHeap],Ptr
  IF H_Header = 0 THEN
	CmpLong	#'paeH',[Ptr]
  ELSE
	CmpLong	#'paeH',[Ptr]:#H_Header
  ENDIF
	beq	@headerOk2
	lda	#H_BAD
	brl	errorHeader
@headerOk2

	SpaceLong
	PushLong	NewHeap
	_GetHandleSize
	PullLong	OldSize
	beq	@headerOk3	; size must be < 1 bank
	lda	#H_BAD
	brl	errorHeader
@headerOk3

	PushLong	[NewHeap]		; update the Z page
	PushLong	H_ZPptr
	PushLong	#ZHEADER_SHORT_SIZE
	_BlockMove
	StzL	H_Header

  IF ReadV70 THEN
	stz	ErrorFlag
  ENDIF
	CmpLong	H_Version,#H_THIS_VERSION	; check version
	beq	@headerVersionOk
  IF ReadV70 THEN
	inc	ErrorFlag			; not the latest version
	CmpLong	H_Version,#H_VERSION7
	beq	@headerVersionOk
  ENDIF
	blt	@oldVersion
	lda	#H_TOO_NEW	; the heap is too new to load
	brl	errorHeader
@oldVersion			; the heap is too old to load
	lda	#H_TOO_OLD
	brl	errorHeader
@headerVersionOk
  IF ReadV70 THEN
	lda	ErrorFlag
	beq	@newVersion
	lda	#<H_THIS_VERSION	; update version number
	sta	H_Version
	ldy	#H_Version
	sta	[Ptr],y
	lda	#^H_THIS_VERSION
	sta	H_Version+2
	ldy	#H_Version+2
	sta	[Ptr],y
@newVersion
  ENDIF
	lda	H_MaxSegments
	cmp	H_NumISegments	; check # of index segments
	bge	@headerISegsOk
	lda	#memErr		; the heap has too many index segments to load
	brl	errorHeader
@headerISegsOk
	cmp	H_NumDSegments	; check # of data segments
	bge	@headerDSegsOk
	lda	#memErr		; the heap has too many data segments to load
	brl	errorHeader
@headerDSegsOk

	PushWord	#0			; resize header for current memory size
	PushWord	H_HeaderSize
	PushLong	NewHeap
	jsl	D_GrowHandle
	jcs	errorHeader

	;PushLong	[NewHeap] + #HANDLE_ARRAY	; clear the old handle and pointer arrays
	lda	[NewHeap]
	clc
	adc	#HANDLE_ARRAY
	tax
	ldy	#2
	lda	[NewHeap],y
	bcc	@1
	ina
@1	pha
	phx
	SubWord	H_HeaderSize,#HANDLE_ARRAY,s
	jsl	D_ZeroBlock

  IF ReadV70 THEN
	lda	ErrorFlag		; old version stored ISegs before DSegs
	bne	readISegs
  ENDIF

; read in each data segment (first to last, unless ErrorFlag is set) - store handles in header
readDsegs
	lda	H_NumDSegments
	beq	doneReadD
	lda	#0
readDSegLoop
	AddWord	a,#4,Segment
	SpaceLong
	PushWord	DP
	jsl	D_ReadHandle2
	tay			; save error
	PullLong	SegHandle
	jcs	error

	; recalc ptr to DSegHandle array (Header may have moved, sigh)
	;AddLong	[NewHeap],H_DSegHOffsetLo:w,H_DSegHandleLo
	MoveLong	[NewHeap],ax
	clc
	adc	H_DSegHOffsetLo
	sta	H_DSegHandleLo
	bcc	@1
	inx
@1	stx	H_DSegHandleLo+2

	ldy	Segment
  IF ReadV70 THEN
	lda	ErrorFlag
	beq	@newVersion
	SubWord	H_NumDSegments,Segment,a
	AddWord	a,#4,y
@newVersion
  ENDIF
	lda	SegHandle
	sta	[H_DSegHandleLo],y
	lda	SegHandle+2
	iny			; not using H_DSegHandleHi because I don't want
	iny			; to recalculate it
	sta	[H_DSegHandleLo],y

	lda	Segment
	cmp	H_NumDSegments
	blt	readDSegLoop
doneReadD

  IF ReadV70 THEN
	lda	ErrorFlag		; old version stored ISegs before DSegs
	jne	readLarge
  ENDIF

; read in each index segment (last to first) - store handles in header
readISegs
	StzL	DataSize		; used to count # of large blocks
	lda	H_NumISegments
	beq	doneReadI
readISegLoop
	tay
	sty	Segment
	SpaceLong
	PushWord	DP
	jsl	D_ReadHandle2
	tay			; save error
	PullLong	SegHandle
	jcs	error

	; recalc ptr to ISegHandle array (Header may have moved, sigh)
	;AddLong	[NewHeap],#HANDLE_ARRAY,H_ISegHandleLo
	MoveLong	[NewHeap],ax
	clc
	adc	#HANDLE_ARRAY
	sta	H_ISegHandleLo
	bcc	@2
	inx
@2	stx	H_ISegHandleLo+2

	ldy	Segment
	lda	SegHandle
	sta	[H_ISegHandleLo],y
	lda	SegHandle+2
	iny			; not using H_ISegHandleHi because I don't want
	iny			; to recalculate it
	sta	[H_ISegHandleLo],y

	; adjust large block references (in case of errors)
	MoveLong	[SegHandle],SegPtr
	CmpWord	Segment,H_NumISegments
	bne	@1
	ldy	H_EndIndex
	bra	adjustLargeLoop
@1	ldy	#H_ISEG_SIZE

adjustLargeLoop
	dey			; offset to high word of (previous) index
	dey
	lda	[SegPtr],y
	bpl	adjustNextLargeBlock	; not a large block
	cmp	#H_LARGE_BLOCK_FLAG
	blt	adjustNextLargeBlock	; not a large block

	and	#$00FF			; change H_LARGE_BLOCK_FLAG
	ora	#H_LARGE_BLOCK_FLAG2	; to H_LARGE_BLOCK_FLAG2
	sta	[SegPtr],y
	IncL	DataSize			; count total # of large blocks

adjustNextLargeBlock
	dey			; offset to low word of index
	dey
	bne	adjustLargeLoop
	
	SubWord	Segment,#4,a
	bne	readISegLoop
doneReadI

  IF ReadV70 THEN
	lda	ErrorFlag		; old version stored ISegs before DSegs
	jne	readDSegs
  ENDIF

; read in each large block - update index segments
readLarge
	lda	DataSize		; are there any large blocks?
	ora	DataSize+2
	jeq	lockHandles

	ldy	H_NumISegments	; > 0 since DataSize > 0
readBlockLoop
	sty	Segment

	; recalculate H_ISegHandleLo (Header may have moved, sigh)
	;AddLong	[NewHeap],#HANDLE_ARRAY,H_ISegHandleLo
	MoveLong	[NewHeap],ax
	clc
	adc	#HANDLE_ARRAY
	sta	H_ISegHandleLo
	txa
	bcc	@2
	ina
@2	sta	H_ISegHandleLo+2

	ldy	Segment
	lda	[H_ISegHandleLo],y
	sta	SegHandle
	iny			; not using H_ISegHandleLo because I don't want
	iny			; to recalculate it
	lda	[H_ISegHandleLo],y
	sta	SegHandle+2

	MoveLong	[SegHandle],SegPtr

	ldy	Segment
	cpy	H_NumISegments
	bne	@1
	ldy	H_EndIndex
	bra	readLargeLoop
@1	ldy	#H_ISEG_SIZE

readLargeLoop
	dey			; offset to high word of (previous) index
	dey
	lda	[SegPtr],y
	bpl	nextLargeBlock	; not a large block
	cmp	#H_LARGE_BLOCK_FLAG2
	blt	nextLargeBlock	; not a large block

	sty	Offset
	SpaceLong
	PushWord	DP
	jsl	D_ReadHandle2	; could move H_IndexTable - recalc ptr
	tay			; save error
	PullLong	OldPtr		; handle to large block
	bcs	error

	; Index segment may have moved - recalculate SegPtr
	MoveLong	[SegHandle],SegPtr

	; store large block handle in index table
	lda	OldPtr+2		; handle to large block
	ora	#H_LARGE_BLOCK_FLAG	; set flag to H_LARGE_BLOCK_FLAG
	ldy	Offset
	sta	[SegPtr],y
	dey
	dey
	lda	OldPtr		; handle to large block
	sta	[SegPtr],y
	
	DecL	DataSize
	lda	DataSize
	ora	DataSize+2
	beq	lockHandles	; no more large blocks

	ldy	Offset

nextLargeBlock
	dey			; offset to low word of index
	dey
	bne	readLargeLoop

	SubWord	Segment,#4,y
	jne	readBlockLoop


lockHandles		; lock handles down and fix up pointers
	MoveLong	[NewHeap],H_HeaderPtr
  IF H_Header = 0 THEN
	MoveLong	NewHeap,[H_HeaderPtr]	; store the heap id (handle)
  ELSE
	MoveLong	NewHeap,[H_HeaderPtr]:#H_Header	; store the heap id (handle)
  ENDIF
	;StzL	[H_HeaderPtr]:#H_HeaderPtr	; force recalc of pointers
	lda	#0			; within header
	ldy	#H_HeaderPtr
	sta	[H_HeaderPtr],y
	ldy	#H_HeaderPtr+2
	sta	[H_HeaderPtr],y

	MoveLong	NewHeap,xy
	jsl	H_SetHeap

	MoveLong	H_Header,ax	; return HeapID
	ldy	#0		; no error
	clc
	ReturnZ


errorHeader			; error after header loaded
	pha			; save error code from D_ReadHandle2
	PushLong	NewHeap
	_DisposeHandle
	bra	errExit

error
	phy			; save error code from D_ReadHandle2
	MoveLong	NewHeap,H_Header
	MoveLong	[NewHeap],H_HeaderPtr
	jsr	CalcHeaderPtrs	; make sure ptrs are good for H_DisposeHeap
	jsl	H_DisposeHeap	; dispose of what portions we did read

errExit
	lda	#0		; return 0 HeapID
	tax
	ply			; restore error code
	sec
	ReturnZ

  ELSE
	ldy	#-1
	sec
	rtl
  ENDIF		; HeapIO
	ENDP

;¦;--------------------------------------------------------------
; CalcHeaderPtrs()
;
; Calculate pointers to arrays within the header.

; Zpage variables modified:
;	H_ISegHandleLo
;	H_ISegHandleHi
;	H_DSegHandleLo
;	H_DSegHandleHi
;	H_ISegPtreLo
;	H_ISegPtrHi
;	H_DSegPtreLo
;	H_DSegPtrHi
;	H_FreeListArray

CalcHeaderPtrs	PROC	ENTRY

	;MoveLong	H_HeaderPtr,xy
	ldx	H_HeaderPtr
	ldy	H_HeaderPtr+2

; Array of free list heads
	;AddLong	H_HeaderPtr,#H_FreeLists:w,H_FreeListArray
	txa
	clc
	adc	#H_FreeLists
	sta	H_FreeListArray
	tya
	bcc	@fl
	ina
@fl	sta	H_FreeListArray+2

; Array of handles to index segments
	;AddLong	H_HeaderPtr,#HANDLE_ARRAY:w,H_ISegHandleLo
	txa
	clc
	adc	#HANDLE_ARRAY
	sta	H_ISegHandleLo
	tya
	bcc	@iHlo
	ina
@iHlo	sta	H_ISegHandleLo+2

	;AddLong	H_HeaderPtr,#HANDLE_ARRAY+2:w,H_ISegHandleHi
	txa
	clc
	adc	#HANDLE_ARRAY+2
	sta	H_ISegHandleHi
	tya
	bcc	@iHhi
	ina
@iHhi	sta	H_ISegHandleHi+2

; Array of handles to data segments
	;AddLong	H_HeaderPtr,H_DSegHOffsetLo:w,H_DSegHandleLo
	txa
	clc
	adc	H_DSegHOffsetLo
	sta	H_DSegHandleLo
	tya
	bcc	@dHlo
	ina
@dHlo	sta	H_DSegHandleLo+2

	;AddLong	H_HeaderPtr,H_DSegHOffsetHi:w,H_DSegHandleHi
	txa
	clc
	adc	H_DSegHOffsetHi
	sta	H_DSegHandleHi
	tya
	bcc	@dHhi
	ina
@dHhi	sta	H_DSegHandleHi+2

; Array of pointers to index segments
	;AddLong	H_HeaderPtr,H_ISegPOffsetLo:w,H_ISegPtrLo
	txa
	clc
	adc	H_ISegPOffsetLo
	sta	H_ISegPtrLo
	tya
	bcc	@iPlo
	ina
@iPlo	sta	H_ISegPtrLo+2

	;AddLong	H_HeaderPtr,H_ISegPOffsetHi:w,H_ISegPtrHi
	txa
	clc
	adc	H_ISegPOffsetHi
	sta	H_ISegPtrHi
	tya
	bcc	@iPhi
	ina
@iPhi	sta	H_ISegPtrHi+2

; Array of pointers to data segments
	;AddLong	H_HeaderPtr,H_DSegPOffsetLo:w,H_DSegPtrLo
	txa
	clc
	adc	H_DSegPOffsetLo
	sta	H_DSegPtrLo
	tya
	bcc	@dPlo
	ina
@dPlo	sta	H_DSegPtrLo+2

	;AddLong	H_HeaderPtr,H_DSegPOffsetHi:w,H_DSegPtrHi
	txa
	clc
	adc	H_DSegPOffsetHi
	sta	H_DSegPtrHi
	tya
	bcc	@dPhi
	ina
@dPhi	sta	H_DSegPtrHi+2

	rts

	ENDP


	END