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

1 line
54 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.

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