1 line
54 KiB
Plaintext
Executable File
1 line
54 KiB
Plaintext
Executable File
;
|
||
; 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
|