Apple-2-SW/antoine-source
1
0
Fork 0
mirror of https://github.com/antoinevignau/source.git synced 2025-02-01 02:33:39 +00:00
Code Issues Projects Releases Wiki Activity
antoine-source/appleworksgs/Heap/Src/Heap.aii
Antoine Vignau 5fef614692 First release
2023-03-04 03:45:20 +01:00

1 line
30 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;
; 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
Reference in New Issue View Git Blame Copy Permalink