HeapMan 59.2 KB
Newer Older
Neil Turton's avatar
Neil Turton committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
; Copyright 1996 Acorn Computers Ltd
;
; Licensed under the Apache License, Version 2.0 (the "License");
; you may not use this file except in compliance with the License.
; You may obtain a copy of the License at
;
;     http://www.apache.org/licenses/LICENSE-2.0
;
; Unless required by applicable law or agreed to in writing, software
; distributed under the License is distributed on an "AS IS" BASIS,
; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
; See the License for the specific language governing permissions and
; limitations under the License.
;
        TTL     => HeapMan : Heap Allocation SWI

; Interruptible heap SWI.

; Look down the IRQ stack to see if anybody was in a heap operation.
; If they were, then (with IRQs off) the foreground call is done first, by
; picking up info from a fixed block. Patch the IRQ stack so that the heap SWI
; is returned to at a "it happened in the background" fixup routine. Current
; request can then be dealt with! Ta Nick.

Neil Turton's avatar
Neil Turton committed
25

Neil Turton's avatar
Neil Turton committed
26 27 28 29 30 31 32
; Also has an interlock on the register restore area; otherwise anybody
; with an IRQ process doing heap ops with interrupts enabled will cause
; trouble.

        GBLL    debheap
debheap SETL    1=0

33 34 35 36 37
    [ :LNOT: :DEF: HeapTestbed
              GBLL HeapTestbed
HeapTestbed   SETL {FALSE}
    ]

Neil Turton's avatar
Neil Turton committed
38 39 40 41 42 43 44
 [ DebugHeaps
FreeSpaceDebugMask * &04000000
UsedSpaceDebugMask * &08000000
 ]

Nil     *       0

45 46 47 48 49
hpd      RN     r1      ; The punter sees these
addr     RN     r2
size     RN     r3
work     RN     r4
alignrel RN     r5
Neil Turton's avatar
Neil Turton committed
50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87

HpTemp  RN      r10     ; But not these
tp      RN      r11
bp      RN      r12

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; +                     H E A P   O R G A N I S A T I O N                     +
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; A heap block descriptor (hpd) has the form

; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+ -+ -+ -+ -+
; |   magic   |    free   |    base   |    end    |   debug   |
; +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+- +- +- +- +
;  0  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15 16 17 18 19 20

         ^      0, hpd
hpdmagic #      4
hpdfree  #      4
hpdbase  #      4
hpdend   #      4       ; Needed for debugging heap, and top end validation
 [ debheap
hpddebug #      4       ; 0 -> No debug, ~0 -> Debug
 ]

hpdsize  *      @-hpdmagic

magic_heap_descriptor * (((((("p":SHL:8)+"a"):SHL:8)+"e"):SHL:8)+"H")

; hpdmagic is a unique identification field
; hpdfree  is the offset of the first block in the free space list
; hpdbase  is the offset of the byte above the last one used
; hpdend   is the offset of the byte above the last one usable

;                               | hpdbase
;                              \|/
;      +---+--------------------+--------+
;  low |hpd|     heap blocks    | unused | high
;      +---+--------------------+---------+
88
;              /|\                       /|\ 
Neil Turton's avatar
Neil Turton committed
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
;               | hpdfree                 | hpdend
;               | in here somewhere.

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Blocks in the free space list have the form :

; +--+--+--+--+--+--+--+--+--+ ~ -+--+
; | long link | long size |          |
; +--+--+--+--+--+--+--+--+--+ ~ -+--+
;  0  1  2  3  4  5  6  7  8      (size-1)
;
; where the link field is an offset to the next free block

           ^    0 ; Can't use register relative unfortunately as many regs used
frelink    #    4
fresize    #    4
freblksize #    0

; The link field is Nil (0) for the last block in the list

109
; Block sizes must be forced to a minimum of 8 bytes for subsequent link and
Neil Turton's avatar
Neil Turton committed
110 111 112 113 114
; size information to be stored in them if they are disposed of by the user.

; They must also be capable of storing a 4 byte size field while allocated.
; This field is used to size the block to free when FreeArea is called.

115 116 117 118 119 120 121 122 123 124
; This is the threshold for minimum heap block fragmentation size.  Splitting a
; free block won't leave a free block which is <= than the size declared here.
; If by choosing to use a particular free block, allocating a new block would
; leave a free block of this size or less, add it on to the original size request
; to avoid generating lots of silly little blocks that slow things down so much.
; This value must not be too large because non-C callers may extend the block
; piecemeal based on their (now wrong) knowledge of the block size.  The C library
; reads the block size straight out of the heap block data, and will thus not
; be fooled.
minheapfragsize # 8
Neil Turton's avatar
Neil Turton committed
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139

        ALIGN

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; The Macros
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Check hpd valid

        MACRO
$label  ValidateHpd $faildest
$label  BL      ValidateHpdSubr
        BNE     $faildest._badhpd
        MEND


140 141 142 143 144 145 146 147 148 149 150
; Call XOS_Heap SWI

        MACRO
        CallXOSHeap
      [ HeapTestbed
        BL      DoCallXOSHeap
      |
        SWI     XOS_Heap
      ]
        MEND

Neil Turton's avatar
Neil Turton committed
151 152 153 154 155 156 157 158
;****************************************************************************

; These bits of ExtendBlock are outside the IRQ HeapOp range because they
; don't update the heap structure, so we can safely restore old IRQ status

CopyBackwardsInSafeZone
        LDR     work, [stack, #3*4]     ; get user link
        ANDS    work, work, #I_bit      ; look at I_bit
Kevin Bracey's avatar
Kevin Bracey committed
159 160

        WritePSRc SVC_mode, work, EQ    ; if was clear then clear it now
Neil Turton's avatar
Neil Turton committed
161 162 163 164 165 166 167 168 169 170 171

        ADD     bp, bp, #4              ; new block pointer
        STR     bp, [stack]             ; return to user

; copy wackbords: HpTemp-4 bytes from addr+4 to bp, in appropriate order!
cpe_prev
        SUBS    HpTemp, HpTemp, #4
        LDRGT   work, [addr, #4]!
        STRGT   work, [bp], #4
        BGT     cpe_prev

Kevin Bracey's avatar
Kevin Bracey committed
172
        WritePSRc SVC_mode + I_bit, work; disable IRQs before we venture back
Neil Turton's avatar
Neil Turton committed
173 174 175 176 177 178 179 180 181 182 183
        B       GoodExtension           ; into danger zone

ReallocateInSafeZone
        LDR     work, [addr, hpd]!      ; get block size, set block addr
        ADD     size, size, work
        SUB     size, size, #4          ; block size to claim
        ADD     addr, addr, #4
        MOV     bp, addr                ; address to copy from
        Push    addr                    ; save for later freeing

        MOV     R0, #HeapReason_Get
184
        CallXOSHeap
Neil Turton's avatar
Neil Turton committed
185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218
        Pull    addr, VS
        BVS     SafeNaffExtension

 [ debheap
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT06
 DREG work, "got new block : copying "
06
 ]

        STR     addr, [stack, #4]

; claimed : copy work-4 bytes from bp to addr
CopyForExtension
        SUBS    work, work, #4
        LDRGT   HpTemp, [bp],#4
        STRGT   HpTemp, [addr],#4
        BGT     CopyForExtension

; free the old block!

 [ debheap
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT08
 WRLN "freeing old block"
08
 ]

; recursive SWI to free old block; we have invalidated any held information

        MOV     R0, #HeapReason_Free
        Pull    addr                    ; heap block addr
219
        CallXOSHeap
Neil Turton's avatar
Neil Turton committed
220

221
        MOVVC   R0, #HeapReason_ExtendBlock
Kevin Bracey's avatar
Kevin Bracey committed
222
        WritePSRc SVC_mode + I_bit,work ; disable IRQs before we venture back
223
        BVC     GoodExtension           ; into danger zone
Neil Turton's avatar
Neil Turton committed
224 225

SafeNaffExtension
Kevin Bracey's avatar
Kevin Bracey committed
226
        WritePSRc SVC_mode + I_bit,work  ; disable IRQs before we venture back
Neil Turton's avatar
Neil Turton committed
227 228 229 230 231
        B       NaffExtension           ; into danger zone


;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Here's the bit that gets returned to if the heap op was done in the
Stewart Brodie's avatar
Stewart Brodie committed
232
; background. Pick up the registers, look at the saved PSR to see if error
Neil Turton's avatar
Neil Turton committed
233 234 235 236 237
; return or OK.
; This bit musn't be in range of the IRQ Heap Op checking!!!
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

heapopdoneinbackground ROUT
238
        LDR        R12, =ZeroPage+HeapReturnedReg_R0
Neil Turton's avatar
Neil Turton committed
239

240
        LDMIA     R12, {R0-R5, R10, R11}
Neil Turton's avatar
Neil Turton committed
241 242
        MOV       stack, R10
        MOV       R10, #0
Kevin Bracey's avatar
Kevin Bracey committed
243
        STR       R10, [R12, #HeapReturnedReg_PSR-HeapReturnedReg_R0]
Neil Turton's avatar
Neil Turton committed
244 245 246
                                      ; clear the interlock
        TST       R11, #V_bit         ; look at returned error
        BEQ       GoodHeapExit
247 248 249 250 251 252 253 254
        ; Recover the error from our buffer
        LDR       R0,=HeapBackgroundError
        LDR       R10,[R0]
        SWI       XMessageTrans_CopyError
        ; Check that it worked - MessageTrans may be dead
        LDR       R11,[R0]
        TEQ       R10,R11
        LDRNE     R0,=HeapBackgroundError ; Just return our internal buffer if MessageTrans couldn't provide one
Neil Turton's avatar
Neil Turton committed
255 256 257 258 259 260 261 262 263 264 265
        B         NaffHeapExit

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; HeapEntry. SWI level entry
; =========
;
; Perform actions on the heap block described by r1(hpd)

; In    r0       =  heap action requested
;       r1(hpd)  -> heap block
266
;       r2(addr) -> start of block, or required alignment
Neil Turton's avatar
Neil Turton committed
267
;       r3(size) =  size of block
268
;       r4(work) =  boundary limitation
Neil Turton's avatar
Neil Turton committed
269 270 271 272 273 274

; Out   VClear -> Action performed
;       VSet   -> Something terrible has happened, error set
;       Rest of universe ok

HeapEntry ROUT
Stewart Brodie's avatar
Stewart Brodie committed
275 276
        Push    lr
        SavePSR lr                      ; hang on to interrupt state
Neil Turton's avatar
Neil Turton committed
277 278

 ; First check that we aren't in an interrupted Heap Op
Kevin Bracey's avatar
Kevin Bracey committed
279
        WritePSRc SVC_mode+I_bit, R11
280
        LDR     R11, =ZeroPage+IRQsema
Neil Turton's avatar
Neil Turton committed
281 282 283 284
inspect_IRQ_stack
        LDR     R11, [R11]
        CMP     R11, #0
        BEQ     iis_end
285
        LDR     R10, [R11, #4*8]        ; Get LR from IRQ stack
Neil Turton's avatar
Neil Turton committed
286 287 288 289 290 291 292 293 294 295
        ADR     R12, first_heap_address_to_trap
        CMP     R10, R12
        ADRGEL  R12, HeapCode_end
        CMPGE   R12, R10
        BLT     inspect_IRQ_stack

    ; somebody's in the heap code! Time for perversion.
    ; Pick up registers, do foreground op, poke IRQstack return address

         ADRL   R10, heapopdoneinbackground
296 297 298
         STR    R10, [R11, #4*8]               ; return address zapped
         LDR    R10, [R11, #4*6]               ; get stored SPSR
         BIC    R10, R10, #&FF
Kevin Bracey's avatar
Kevin Bracey committed
299 300
         ORR    R10, R10, #I32_bit:OR:SVC2632
         STR    R10, [R11, #4*6]               ; return into SVC26/32 mode with IRQs disabled
Neil Turton's avatar
Neil Turton committed
301

302
         Push  "R0-R5, lr"
Neil Turton's avatar
Neil Turton committed
303

304
         LDR    R10, =ZeroPage+HeapSavedReg_R0
Neil Turton's avatar
Neil Turton committed
305 306 307

; This can't happen: heap ops are non-interruptible while foreground ops
; are waiting to complete
Kevin Bracey's avatar
Kevin Bracey committed
308
;         LDR    R12, [R10, #HeapReturnedReg_PSR-HeapSavedReg_R0]
Neil Turton's avatar
Neil Turton committed
309 310 311
;         CMP    R12, #0
;         BNE    HeapInUse

312
         LDMIA  R10, {R0-R5, R11}
Kevin Bracey's avatar
Kevin Bracey committed
313
         SWI    XOS_Heap                ; with interrupts off!
314
         LDR    R12, =ZeroPage+HeapReturnedReg_R0
Neil Turton's avatar
Neil Turton committed
315

Neil Turton's avatar
Neil Turton committed
316 317
   ; Could we poke these into the IRQ stack too...?
   ; would allow interruptible IRQ processes to do heap ops!!!
318
         MRS    lr, CPSR
319
         STMIA  R12, {R0-R5, R11, lr}
320 321 322 323 324 325 326 327 328 329 330 331 332 333 334
; Any errors that were generated by the foreground operation may have ended up
; using one of MessageTrans' IRQ buffers. Trouble is, any number of IRQ errors
; could occur between now and when the foreground task gets the error. Avoid
; the error getting clobbered by copying it into a special kernel buffer, and
; then copy it back to a MessageTrans buffer once we're back in the foreground.
         BVC    noheapbackgrounderror
         LDR    R1,=HeapBackgroundError
         MOV    LR,#256
heapbackgrounderrorloop
         LDMIA  R0!,{R2-R4,R12}
         SUBS   LR,LR,#16
         STMIA  R1!,{R2-R4,R12}
         BNE    heapbackgrounderrorloop

noheapbackgrounderror
335
         Pull  "R0-R5, lr"
Neil Turton's avatar
Neil Turton committed
336 337

iis_end                                 ; store the registers in the info block
338
        LDR     R12, =ZeroPage+HeapSavedReg_R0
339 340
        STMIA   R12, {R0-R5}
        STR     stack, [R12, #HeapSavedReg_R13-HeapSavedReg_R0]
Neil Turton's avatar
Neil Turton committed
341 342

first_heap_address_to_trap              ; because register saveblock now set.
Kevin Bracey's avatar
Kevin Bracey committed
343
        LDR     R12, [R12, #HeapReturnedReg_PSR-HeapSavedReg_R0]
Neil Turton's avatar
Neil Turton committed
344
        CMP     R12, #0
Kevin Bracey's avatar
Kevin Bracey committed
345
        RestPSR lr, EQ                  ; restore callers interrupt state
Neil Turton's avatar
Neil Turton committed
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368
                                        ; only if no foreground waiting to
                                        ; complete

        CMP     r0, #MaxHeapCode        ; now despatch it.
        ADDLS   pc, pc, r0, LSL #2      ; Tutu : faster & shorter
        B       NaffHeapReason          ; Return if unknown call reason

HeapJumpTable ; Check reason codes against Hdr:Heap defs

 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_Init
        B       InitHeap
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_Desc
        B       DescribeHeap
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_Get
        B       GetArea
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_Free
        B       FreeArea
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_ExtendBlock
        B       ExtendBlock
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_ExtendHeap
        B       ExtendHeap
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_ReadBlockSize
        B       ReadBlockSize
369 370
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_GetAligned
        B       GetAreaAligned
371 372
 assert ((.-HeapJumpTable) :SHR: 2) = HeapReason_GetSkewAligned
        B       GetAreaAligned
Neil Turton's avatar
Neil Turton committed
373 374 375 376 377 378 379 380 381 382 383 384 385 386
 [ debheap
        B       ShowHeap
 ]
MaxHeapCode * (.-HeapJumpTable-4) :SHR: 2 ; Largest valid reason code


NaffHeapReason
        ADR     R0, ErrorBlock_HeapBadReason
      [ International
        BL      TranslateError
      ]
NaffHeapExit                            ; get here with R0 = error ptr
        SETV
GoodHeapExit                            ; V cleared on entry to SWI dispatch
Kevin Bracey's avatar
Kevin Bracey committed
387
        SETPSR  I_bit, R12              ; IRQs off
Neil Turton's avatar
Neil Turton committed
388 389 390
        Pull    lr
        ORRVS   lr, lr, #V_bit          ; VSet Exit

391 392 393 394
      [ HeapTestbed
        MSR     CPSR_cxsf, lr           ; Fake exit for testbed
        Pull    "r10-r12,pc"
      |
Neil Turton's avatar
Neil Turton committed
395
        ExitSWIHandler                  ; Like all good SWI handlers
396
      ]
Neil Turton's avatar
Neil Turton committed
397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414

; Errors
       MakeErrorBlock  HeapBadReason
       MakeErrorBlock  HeapFail_Init
       MakeErrorBlock  HeapFail_BadDesc
       MakeErrorBlock  HeapFail_BadLink
       MakeErrorBlock  HeapFail_Alloc
       MakeErrorBlock  HeapFail_NotABlock
       MakeErrorBlock  HeapFail_BadExtend
       MakeErrorBlock  HeapFail_ExcessiveShrink
;       MakeErrorBlock  HeapFail_HeapLocked

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; Subroutine to validate heap pointer
; checks hpd points at existing LogRam
; and also that internal offsets fall into the same block of RAM

ValidateHpdSubr
Kevin Bracey's avatar
Kevin Bracey committed
415
        Push   "R0-R3, lr"
Neil Turton's avatar
Neil Turton committed
416

Kevin Bracey's avatar
Kevin Bracey committed
417 418
        SavePSR R3
        WritePSRc SVC_mode+I_bit, R0 ; interrupts off for validation
Neil Turton's avatar
Neil Turton committed
419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434
        MOV     R0, hpd
        ADD     R1, hpd, #hpdsize+freblksize
        SWI     XOS_ValidateAddress
        BCS     vhpds_fail

        TST     R0, #3              ; check alignment
        LDREQ   HpTemp, =magic_heap_descriptor
        LDREQ   tp, [R0, #:INDEX: hpdmagic]
        CMPEQ   tp, HpTemp
        BNE     vhpds_fail           ; failure

        LDR     R1, [R0, #:INDEX: hpdend]
        ADD     R1, R1, R0
        SWI     XOS_ValidateAddress
        BCS     vhpds_fail           ; failure

Kevin Bracey's avatar
Kevin Bracey committed
435 436 437
        ORR     R3, R3, #Z_bit       ; success
        RestPSR R3
        Pull   "R0-R3, PC"
Neil Turton's avatar
Neil Turton committed
438 439

vhpds_fail
Kevin Bracey's avatar
Kevin Bracey committed
440 441 442
        BIC     R3, R3, #Z_bit       ; NE returned ; fails
        RestPSR R3
        Pull   "R0-R3, PC"
Neil Turton's avatar
Neil Turton committed
443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; InitHeap. Top level HeapEntry
; ========
;
; Initialise a heap descriptor block

; In : hpd -> block to initialise, size = size of block

; Out : VClear -> Block initialised
;       VSet   -> Something terrible has happened
;       Rest of universe ok

; To initialise (or even reinitialise) a heap descriptor:
; $(
;   hpd!magic := magic_heap_descriptor
;   hpd!free  := Nil
;   hpd!base  := hpdsize
;   hpd!end   := size
; $)

InitHeap ROUT
        CMP     size,#hpdsize+freblksize
        BLT     NaffHeapInitialise        ; can't get hpd and 1 block in

        Push   "R0, R1"
        MOV     R0, hpd
        ADD     R1, hpd, size
        SWI     XOS_ValidateAddress
        Pull   "R0, R1"
        BCS     NaffHeapInitialise

 [ DebugHeaps
        ORR     lr, hpd, #FreeSpaceDebugMask    ; form word to store throughout heap
        ADD     HpTemp, hpd, size               ; HpTemp -> end of heap
10
        STR     lr, [HpTemp, #-4]!              ; store word, pre-decrementing
        TEQ     HpTemp, hpd                     ; until we get to start
        BNE     %BT10
 ]

        LDR     HpTemp, =magic_heap_descriptor
        STR     HpTemp, hpdmagic          ; hpd!magic := magic_heap_desc
        MOV     HpTemp, #Nil
        STR     HpTemp, hpdfree           ; hpd!free  := Nil
        MOV     HpTemp, #hpdsize
        STR     HpTemp, hpdbase           ; hpd!base  := hpdsize
        STR     size,   hpdend            ; hpd!end   := size

 [ debheap
 MOV HpTemp, #0 ; No debugging until the punter sets this Word
 STR HpTemp, hpddebug
 ]
        B       GoodHeapExit

NaffHeapInitialise
 [ debheap
 WRLN "Unaligned/too big hpd/size: InitHeap failed"
 ]
        ADR     R0, ErrorBlock_HeapFail_Init
      [ International
        BL      TranslateError
      ]
        B       NaffHeapExit               ; VSet exit

        LTORG

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; DescribeHeap. Top level HeapEntry
; ============
;
; Return information about the heap whose descriptor is pointed to by hpd

; In : hpd -> heap descriptor

; Out : VClear -> addr = max block size claimable, size = total free store
;       VSet   -> Something wrong
;       Rest of universe ok

DescribeHeap ROUT
        ValidateHpd describefailed

 [ debheap
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT00
 Push  link
 WRLN "DescribeHeap"
 BL iShowHeap
 Pull link
00
 ]
        LDR     addr, hpdend
        LDR     HpTemp, hpdbase

        SUB     addr, addr, HpTemp        ; unused area at base to end
        MOV     size, addr

        LDR     bp, hpdfree
        ADR     tp, hpdfree
        ADD     HpTemp, HpTemp, hpd      ; address of end of allocated memory
        B       %FT20


; Main loop chaining up free space list. size = total, addr = maxvec

15      ADD     tp, tp, bp              ; get address of next
        CMP     tp, HpTemp
        BHS     describefailed_badlink  ; points outside allocated memory
        LDR     bp, [tp, #fresize]      ; Size of this block.
        CMP     bp, addr                ; if size > maxvec then maxvec := size
        MOVHI   addr, bp
        ADD     size, size, bp          ; tfree +:= size
        LDR     bp, [tp, #frelink]      ; Get offset to next block
20      CMP     bp,#Nil                 ; we know Nil is 0!
        BLT     describefailed_badlink  ; -ve are naff
        BNE     %BT15

        CMP     addr, #0
        SUBGT   addr, addr, #4          ; max block claimable
        B       GoodHeapExit            ; VClear Exit


describefailed_badhpd
 [ debheap
 WRLN "Invalid heap descriptor: DescribeHeap failed"
 ]
        ADR     R0, ErrorBlock_HeapFail_BadDesc
      [ International
        BL      TranslateError
      ]
        B       NaffHeapExit            ; VSet Exit

describefailed_badlink
 [ debheap
 WRLN "Invalid heap link: DescribeHeap failed"
 ]
        ADR     R0, ErrorBlock_HeapFail_BadLink
      [ International
        BL      TranslateError
      ]
        B       NaffHeapExit            ; VSet Exit

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; GetArea. Top level HeapEntry
; =======
;
; Allocate a block of memory from the heap

; This will allocate the first block of sufficiently large size in the free
; list, with an oversize block being split.
; Failure to find a large enough block on the free list will try to claim
; space out of the heap block.
; Fails if requesting size = 0

; In : hpd -> heap pointer, size = size of block required

; Out : VClear : addr -> got a block
;       VSet   : addr = 0, couldn't get block
;       Rest of universe ok

GetArea ROUT
        Push   "size"
        ValidateHpd garfailed

 [ debheap
; HpTemp not critical
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT00
 Push  "r0, link"
 MOV r0, size
 DREG r0, "GetArea "
 BL iShowHeap
 Pull "r0, link"
00
 ]

        CMP     size, #0                        ; Can't deallocate 0, so there!
        BLE     garfailed_zero                  ; And -ve is invalid as well!
     ; note sizes of many megabytes thrown out by looking.

628 629
        ADD     size, size, #3+4                ; Make block size multiple of 4
        BIC     size, size, #3                  ; including header
Neil Turton's avatar
Neil Turton committed
630 631 632 633 634 635 636 637 638 639 640 641

        ADR     addr, hpdfree-frelink           ; addr:= @(hpd!free)-frelink

garloop
        LDR     tp, [addr, #frelink]        ; tp := addr!fre.link
        CMP     tp, #Nil                    ; Is this the end of the chain ?
        BEQ     garmore                     ;  - so try main blk
        ADD     addr, addr, tp              ; convert offset
        LDR     HpTemp, [addr, #fresize]    ; If length < size then no good
        SUBS    HpTemp, HpTemp, size        ; In case this works, for below split
        BLO     garloop

642 643 644 645 646 647 648 649
;
; Try and stop very small blocks appearing due to fragmentation - if we fitted with
; a minimal amount of overhead, pretend we had an exact match
;
        CMPNE   HpTemp, #minheapfragsize+1  ; set LO if we can salvage this tiny block
        ADDLO   size, size, HpTemp          ; increment the size to encompass the block
        MOVLOS  HpTemp, #0                  ; pretend we fitted exactly, set EQ

Neil Turton's avatar
Neil Turton committed
650 651 652 653
; Now addr -> a block on the free space list that our item will fit in
; If we have an exact fit (or as close as the granularity of the free list will
; allow), unlink this block and return it

654 655 656 657 658
        CMP     HpTemp, #freblksize
        BGE     SplitFreeBlock

; Increase allocation size if there wasn't enough space to split the free block
        ADD     size, size, HpTemp
Neil Turton's avatar
Neil Turton committed
659 660 661 662 663 664 665 666 667 668 669 670 671

 [ debheap
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT60
 WRLN "Got an exact fit block"
60
 ]

        LDR     HpTemp, [addr, #frelink]  ; Move this block's link field
        CMP     HpTemp, #Nil
        ADDNE   HpTemp, HpTemp, tp        ; convert offset into offset from
                                          ; previous block
Kevin Bracey's avatar
Kevin Bracey committed
672
        WritePSRc SVC_mode+I_bit, lr
Neil Turton's avatar
Neil Turton committed
673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690
        ASSERT  frelink=0
        STR     HpTemp, [addr, -tp]       ; store in link of previous block
        B       ResultIsAddrPlus4

SplitFreeBlock
; Need to split the free block, returning the end portion to the caller

 [ debheap
; HpTemp critical
 Push  HpTemp
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT70
 WRLN "Splitting free block"
70
 Pull HpTemp
 ]

Kevin Bracey's avatar
Kevin Bracey committed
691
        WritePSRc SVC_mode+I_bit, lr
Neil Turton's avatar
Neil Turton committed
692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707
        STR     HpTemp, [addr, #fresize]  ; Adjust size of free block remaining
        ADD     addr, addr, HpTemp        ; addr -> free block just deallocated

ResultIsAddrPlus4
 [ DebugHeaps
        ORR     lr, hpd, #UsedSpaceDebugMask    ; form word to store throughout block
        ADD     HpTemp, addr, size              ; HpTemp -> end of block
75
        STR     lr, [HpTemp, #-4]!              ; store word, pre-decrementing
        TEQ     HpTemp, addr
        BNE     %BT75
 ]

        STR     size, [addr], #4        ; Store block size and increment addr
        Pull    "size"                  ; Return original value to the punter
                                    ; Note : real size got would be an option!
708
        CLRV
Neil Turton's avatar
Neil Turton committed
709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727
        B       GoodHeapExit            ; RESULTIS addr


; Got no more free blocks of length >= size, so try to allocate more heap space
; out of the block described by hpd

garmore
 [ debheap
; HpTemp not critical
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT80
 WRLN "Trying to get more from main block"
80
 ]

        LDR     addr, hpdbase
        ADD     tp, addr, size        ; addr := (hpd!base +:= size)
        LDR     HpTemp, hpdend
Kevin Bracey's avatar
Kevin Bracey committed
728
        WritePSRc SVC_mode+I_bit, lr
Neil Turton's avatar
Neil Turton committed
729 730 731 732 733 734 735 736 737
        CMP     tp, HpTemp            ; See if we'd fall out of the bottom
        STRLS   tp, hpdbase           ; Only adjust hpdbase if valid alloc
        ADDLS   addr, addr, hpd       ; offset conversion
        BLS     ResultIsAddrPlus4
 [ debheap
 STRIM "Not enough room to allocate in main block"
 ]

garfailed
738
        ADRL    R0, ErrorBlock_HeapFail_Alloc
Neil Turton's avatar
Neil Turton committed
739 740 741 742 743 744 745 746 747 748 749 750 751 752 753
      [ International
        BL      TranslateError
      ]
 [ debheap
 WRLN " : GetArea failed"
 ]
garfail_common
        MOV     addr, #0                ; addr := 0 if we couldn't allocate
        Pull    "size"                  ; RESULTIS 0
        B       NaffHeapExit            ; VSet Exit

garfailed_badhpd
 [ debheap
 STRIM "Invalid heap descriptor"
 ]
754
        ADRL    R0, ErrorBlock_HeapFail_BadDesc
Neil Turton's avatar
Neil Turton committed
755 756 757 758 759 760 761 762 763 764 765 766 767
      [ International
        BL      TranslateError
      ]
        B garfail_common

 [ debheap
garfailed_zero
 STRIM "Can't allocate 0 or less bytes"
 B garfailed
 |
garfailed_zero * garfailed
 ]

768 769 770 771 772
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; GetAreaAligned. Top level HeapEntry
; ==============
;
773
; Allocate an aligned block of memory from the heap.
774 775 776

; This is the same as GetArea, except it will only allocate areas with the given
; (power-of-two) alignment.
777 778
; HeapReason_GetAligned aligns block user area using the logical address.
; HeapReason_GetSkewAligned aligns the area using the value in R5 (alignrel).
779 780 781 782 783 784
; Fails if requesting size = 0

; In : hpd -> heap pointer
;      size = size of block required
;      addr = alignment (power of 2)
;      work = boundary (power of 2, 0 for none)
785
;      alignrel = offset to use for alignment/boundary (GetSkewAligned)
786 787 788 789 790 791

; Out : VClear : addr -> got a block
;       VSet   : addr = 0, couldn't get block
;       Rest of universe ok

GetAreaAligned ROUT
792
        Push    "r0,size,work,alignrel"
793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824
        ValidateHpd garafailed

 [ debheap
; HpTemp not critical
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT00
 Push  "r0, link"
 MOV r0, size
 DREG r0, "GetAreaAligned "
 MOV r0, addr
 DREG r0, "alignment "
 MOV r0, work
 DREG r0, "boundary "
 BL iShowHeap
 Pull "r0, link"
00
 ]

        CMP     size, #0                        ; Can't deallocate 0, so there!
        BLE     garafailed_zero                 ; And -ve is invalid as well!
     ; note sizes of many megabytes thrown out by looking.

        ADD     size, size, #3                  ; Make block size multiple of 4
        BIC     size, size, #3                  ; excluding header

        SUB     bp, addr, #1                    ; Store alignment-1 in bp
        TST     bp, addr
        BNE     garafailed_align                ; Must be power of 2!
        CMP     bp, #3
        MOVLT   bp, #3                          ; Minimum alignment is 4

825 826 827 828 829 830 831 832
        ; Set up alignrel to be the offset for converting logical address to
        ; alignment address
        CMP     r0, #HeapReason_GetAligned
        MOVEQ   alignrel, #0
        SUBNE   alignrel, alignrel, hpd
        TST     alignrel, #3                    ; Alignment offset must be multiple of 4
        BNE     garafailed

833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856
        SUB     r0, work, #1                    ; Store boundary-1 in r0
        TST     r0, work
        BNE     garafailed_boundary             ; Must be power of 2!

        ADR     addr, hpdfree-frelink           ; addr:= @(hpd!free)-frelink

        ; If we have a boundary, it must be >= alignment, and >= size
        CMP     r0, #-1
        BEQ     garaloop
        CMP     r0, bp
        CMPHS   work, size
        BLO     garafailed_boundary2

garaloop
        LDR     tp, [addr, #frelink]        ; tp := addr!fre.link
        CMP     tp, #Nil                    ; Is this the end of the chain ?
        BEQ     garamore                    ;  - so try main blk
        ADD     addr, addr, tp              ; convert offset
        LDR     HpTemp, [addr, #fresize]

; Calculate start and end addresses as if we were to allocate from this block
        ADD     work,addr,#4 ; 4 bytes for storing block size
        ADD     HpTemp,HpTemp,addr ; End of free block
        ADD     work,work,bp
857 858
        ADD     work,work,alignrel
        ADD     addr,addr,alignrel
859
garaloop2
860
        BIC     work,work,bp ; work = start of user block (in alignment space)
861 862 863 864 865 866 867 868 869 870 871 872 873
        SUB     lr,work,addr
        CMP     lr,#4
        BEQ     garastartok ; Start alignment is exact
        CMP     lr,#freblksize+4
        BGE     garastartok ; Enough space to fit a free block at the start

; We need a free block, but there isn't enough space for it.
; Shift 'work' up by one unit of alignment and try again.

        ADD     work,work,bp,LSL #1
        B       garaloop2

garastartok
874 875
        SUB     work,work,alignrel
        SUB     addr,addr,alignrel
876 877 878 879 880 881 882 883
; Calculate block end address
        ADD     lr,work,size ; End of user block
        SUBS    lr,HpTemp,lr ; Gap after user block
        BLO     garaloop ; Not big enough

; Check boundary requirement
        CMP     r0,#-1
        BEQ     garaboundaryok
884
        ADD     work,work,alignrel
885
        AND     lr,work,r0 ; Start offset within boundary
886
        SUB     work,work,alignrel
887 888 889 890 891 892
        ADD     lr,lr,size
        SUB     lr,lr,#1 ; Last byte of allocation
        CMP     lr,r0
        BLS     garaboundaryok

; This allocation crosses a boundary. Shift 'work' up to be boundary aligned.
893 894
        ADD     work,work,alignrel
        ADD     addr,addr,alignrel
895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962
        ADD     work,work,r0
        BIC     work,work,r0
        B       garaloop2 ; Loop back round to recheck everything (with small boundary sizes, we may have created a situation where we can't fit an initial free block)

garaboundaryok

; We have a suitable space to allocate from.
        ADD     size,size,#4 ; Correct size to store
        SUB     work,work,#4 ; Correct block start

 [ debheap
 LDR lr, hpddebug
 CMP lr, #0
 BEQ %FT60
 WRLN "Using existing free block"
60
 ]

; Note: bp now being used as scratch

        ADD     bp,work,size ; End of user block
        SUB     bp,HpTemp,bp ; Gap after user block

        WritePSRc SVC_mode+I_bit, lr

; Work out if we need a new free block afterwards
        CMP     bp, #freblksize
        ADDLT   size, size, bp ; Not enough space, so enlarge allocated block
        BLT     %FT10

; Create a new free block that will lie after our allocated block
        SUB     HpTemp, HpTemp, bp
        STR     bp, [HpTemp, #fresize]    ; Write size
        LDR     bp, [addr, #frelink]
        CMP     bp, #Nil
        ADDNE   bp, bp, addr
        SUBNE   bp, bp, HpTemp
        STR     bp, [HpTemp, #frelink]    ; Write next ptr
        SUB     HpTemp, HpTemp, addr
        STR     HpTemp, [addr, #frelink]  ; Fix up link from previous block
10

; Shrink this free block to take up the space preceeding the allocated block.
        SUBS    bp,work,addr
        STRNE   bp, [addr, #fresize]
        BNE     ResultIsWorkPlus4

; No space for an initial free block. Get rid of it.
        ASSERT  frelink=0 ; otherwise LDR bp,[addr,#frelink]!
        LDR     bp, [addr]
        CMP     bp, #0
        ADDNE   bp, bp, tp
        STR     bp, [addr, -tp]
        B       ResultIsWorkPlus4

; Got no more free blocks of length >= size, so try to allocate more heap space
; out of the block described by hpd

garamore
 [ debheap
 LDR work, hpddebug
 CMP work, #0
 BEQ %FT80
 WRLN "Trying to get more from main block"
80
 ]
        LDR     work, hpdbase
        ADD     work, work, hpd
963
        ADD     work, work, alignrel
964 965 966
        ADD     tp, work, #4
        ADD     tp, tp, bp
garamoreloop
967
        BIC     tp, tp, bp            ; tp = pointer (in alignment space) to return to user
968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992

; Make sure there's enough space for a free block if necessary
        SUB     HpTemp, tp, work      ; HpTemp = tp-(hpd+hpdbase)
        CMP     HpTemp, #4
        BEQ     garamoreok
        CMP     HpTemp, #freblksize+4
        ADDLT   tp, tp, bp, LSL #1 ; Not enough space for free block
        BLT     garamoreloop

garamoreok
; Boundary check
        CMP     r0, #-1
        BEQ     garamoreboundaryok
        AND     HpTemp, tp, r0
        ADD     HpTemp, HpTemp, size
        SUB     HpTemp, HpTemp, #1
        CMP     HpTemp, r0
        BLS     garamoreboundaryok

; Shift 'tp' up to be boundary aligned
        ADD     tp, tp, r0
        BIC     tp, tp, r0
        B       garamoreloop

garamoreboundaryok
993 994
        SUB     tp, tp, alignrel
        SUB     work, work, alignrel
995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025
        ADD     HpTemp, tp, size      ; New heap end
        SUB     HpTemp, HpTemp, hpd   ; New heap size
        LDR     lr, hpdend
        CMP     HpTemp, lr
        BGT     garafailed

        WritePSRc SVC_mode+I_bit, lr

; Set up the block to return to the user
        ADD     size, size, #4
        STR     size, [tp, #-4]!

; Grow the heap
        STR     HpTemp, hpdbase

; Create preceeding free block if necessary
        SUBS    HpTemp, tp, work
        BEQ     ResultIsTpPlus4

; Write the free block
        STR     HpTemp, [work, #fresize]
        MOV     HpTemp, #Nil
        STR     HpTemp, [work, #frelink]

; Patch up the preceeding block
        SUB     HpTemp, work, addr
        STR     HpTemp, [addr, #frelink]

ResultIsTpPlus4
; Block size is already stored
        ADD     addr, tp, #4
1026
        Pull    "r0,size,work,alignrel"
1027 1028 1029 1030 1031 1032
        CLRV
        B       GoodHeapExit

ResultIsWorkPlus4
        STR     size, [work]           ; Store block size
        ADD     addr, work, #4         ; Move to correct return reg & add offset
1033
        Pull    "r0,size,work,alignrel"
1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046
        CLRV
        B       GoodHeapExit

garafailed
        ADRL    R0, ErrorBlock_HeapFail_Alloc
      [ International
        BL      TranslateError
      ]
 [ debheap
 WRLN " : GetAreaAligned failed"
 ]
garafail_common
        MOV     addr, #0                ; addr := 0 if we couldn't allocate
1047 1048
        ADD     sp, sp, #4              ; junk R0
        Pull    "size,work,alignrel"    ; RESULTIS 0
1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080
        B       NaffHeapExit            ; VSet Exit

garafailed_badhpd
 [ debheap
 STRIM "Invalid heap descriptor"
 ]
        ADRL    R0, ErrorBlock_HeapFail_BadDesc
      [ International
        BL      TranslateError
      ]
        B garafail_common

 [ debheap
garafailed_zero
 STRIM "Can't allocate 0 or less bytes"
 B garafailed
garafailed_align
 STRIM "Alignment not power of 2"
 B garafailed
garafailed_boundary
 STRIM "Boundary not power of 2"
 B garafailed
garafailed_boundary2
 STRIM "Boundary too small"
 B garafailed
 |
garafailed_zero * garafailed
garafailed_align * garafailed
garafailed_boundary * garafailed
garafailed_boundary2 * garafailed
 ]

Neil Turton's avatar
Neil Turton committed
1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148
; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; FreeArea. Top level HeapEntry
; ========
;
; Return an area of store to the heap

; In : hpd -> heap descriptor, addr -> block to free

; Out : VClear -> block freed
;       VSet   -> failed to free block, size invalid
;       Rest of universe ok

; The block to be freed is matched against those on the free list and inserted
; in it's correct place, with the list being maintained in ascending address
; order. If possible, the freed block is merged with contigous blocks above
; and below it to give less fragmentation, and if contiguous with main memory,
; is merged with that. If the latter, check to see if there is a block which
; would be made contiguous with main memory by the former's freeing, and if so,
; merge that with main memory too. Phew !

FreeArea ROUT
        Push    "addr, size, work"

 [ debheap
; HpTemp not critical
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT00
 Push  "r0, link"
 STRIM "FreeArea "
 SUB r0, addr, hpd
 SUB r0, r0, #4
 BL PrintOffsetLine
 BL iShowHeap
 Pull "r0, link"
00
 ]
        BL      FindHeapBlock
        BLVC    FreeChunkWithConcatenation

        Pull    "addr, size, work"
        BVC     GoodHeapExit
        B       NaffHeapExit            ; VSet Exit

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; ExtendBlock. Top level HeapEntry
; ===========
;
; Extend or reallocate existing block

; In : hpd -> heap descriptor, addr -> block, size = size to change by

; Out : VClear -> block freed, addr new block pointer
;       VSet   -> failed to extend block
;       Rest of universe ok

ExtendBlock

        Push    "addr, size, work"

 [ debheap
; HpTemp not critical
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT00
 Push  "r0, link"
1149
 DREG size, "ExtendBlock by ",cc
Neil Turton's avatar
Neil Turton committed
1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160
 STRIM " block  at "
 SUB r0, addr, hpd
 SUB r0, r0, #4
 BL PrintOffsetLine
 BL iShowHeap
 Pull "r0, link"
00
 ]
        BL      FindHeapBlock
        BVS     NaffExtension

1161 1162
        ADD     size, size, #3             ; round size as appropriate :
        BICS    size, size, #3             ; round up to nearest 4
Neil Turton's avatar
Neil Turton committed
1163 1164 1165 1166 1167 1168

        BEQ     GoodExtension              ; get the easy case done.
        BPL     MakeBlockBigger

        RSB     size, size, #0
        LDR     bp, [addr, hpd]          ; get block size
Kevin Bracey's avatar
Kevin Bracey committed
1169
        WritePSRc SVC_mode+I_bit, R14
1170 1171
        SUB     bp, bp, size             ; size of block left
        CMP     bp, #4
Neil Turton's avatar
Neil Turton committed
1172 1173 1174 1175 1176 1177 1178 1179 1180

 [ debheap
; HpTemp not critical, GE/LT critical
 BLE %FT01
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT01
 WRLN "Freeing part of block"
01
1181
 CMP bp, #4  ; restore GE/Lt
Neil Turton's avatar
Neil Turton committed
1182 1183 1184 1185
 ]

        MOVLE    HpTemp, #-1               ; if discarding block, then
        STRLE    HpTemp, [stack]           ; make pointer really naff.
1186
        BLE      GoodShrink
Neil Turton's avatar
Neil Turton committed
1187

1188 1189 1190 1191 1192 1193
        ; If we're only shrinking 4 bytes, only allow the shrink to go ahead
        ; if there's a free block (or hpdbase) after us
        CMP      size, #4
        BGT      DoShrink
        LDR      HpTemp, [hpd, tp]
        CMP      HpTemp, #Nil
1194
        ADDNE    HpTemp, HpTemp, tp        ; Offset of next free block
1195 1196 1197 1198 1199 1200
        LDREQ    HpTemp, hpdbase
        SUB      HpTemp, HpTemp, addr      ; Offset from start of this block
        SUB      HpTemp, HpTemp, size      ; Apply shrink amount to match bp
        CMP      HpTemp, bp
        MOVGT    size, #0                  ; Used block after us. Deny shrink.
        BGT      GoodExtension
1201
        BLT      CorruptExtension          ; Heap corrupt! Next free block is before us
1202 1203 1204 1205 1206 1207 1208
        ; Else there's a free block (or hpdbase) directly after us
DoShrink
        STR      bp, [addr, hpd]           ; update size of block left
        ADD      addr, addr, bp            ; offset of block to free
        STR      size, [addr, hpd]         ; construct block for freeing

GoodShrink
Neil Turton's avatar
Neil Turton committed
1209 1210 1211 1212
        BL      FreeChunkWithConcatenation ; work still set from block lookup
GoodExtension
        Pull    "addr, size, work"
 [ DebugHeaps
1213
        MOVS    lr, size                        ; work out how much we actually extended by
Neil Turton's avatar
Neil Turton committed
1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226
        BEQ     %FT99                           ; if zero or negative
        BMI     %FT99                           ; then nothing to do
        LDR     HpTemp, [addr, #-4]             ; get new block size
        SUB     HpTemp, HpTemp, #4              ; Exclude size word itself
        ADD     HpTemp, addr, HpTemp            ; end of new block
        SUB     lr, HpTemp, lr                  ; start of new extension
        ORR     bp, hpd, #UsedSpaceDebugMask
98
        STR     bp, [HpTemp, #-4]!              ; store word
        TEQ     HpTemp, lr
        BNE     %BT98
99
 ]
1227
        CLRV
Neil Turton's avatar
Neil Turton committed
1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251
        B        GoodHeapExit

MakeBlockBigger
        LDR      HpTemp, [addr, hpd]       ; get size
        ADD      HpTemp, HpTemp, addr      ; block end
; TMD 01-Mar-89: FindHeapBlock now never returns tp=Nil, only tp=hpdfree,
; so no need for check
        LDR      bp, [tp, hpd]             ; next free
        CMP      bp, #Nil
        ADDNE    bp, bp, tp
        LDREQ    bp, hpdbase

; bp is potential following block
        CMP      HpTemp, bp
        BNE      try_preceding_block

; now get size available, see if fits

        LDR      HpTemp, hpdbase
        CMP      bp, HpTemp
        ADDNE    HpTemp, bp, hpd
        LDRNE    HpTemp, [HpTemp, #fresize]
        LDREQ    HpTemp, hpdend
        SUBEQ    HpTemp, HpTemp, bp
1252
        BICEQ    HpTemp, HpTemp, #3
Neil Turton's avatar
Neil Turton committed
1253
                                           ; force it to a sensible blocksize
1254
        MRS      lr, CPSR                  ; save EQ/NE state
Neil Turton's avatar
Neil Turton committed
1255 1256 1257 1258

        CMP      HpTemp, size
        BLT      try_add_preceding_block

Kevin Bracey's avatar
Kevin Bracey committed
1259
        ORR      lr, lr, #I32_bit          ; disable IRQs
1260
        MSR      CPSR_cf, lr
Neil Turton's avatar
Neil Turton committed
1261 1262 1263 1264 1265 1266 1267 1268 1269 1270

 [ debheap
; HpTemp, EQ/NE critical
 Push "HpTemp,lr"
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT02
 STRIM "Extending block into "
02
 Pull "HpTemp,lr"
1271
 msr CPSR_f, lr
Neil Turton's avatar
Neil Turton committed
1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305
 ]

        LDR      work, [addr, hpd]         ; get size back
        ADD      work, work, size          ; new size
        STR      work, [addr, hpd]         ; block updated

; now see which we're extending into
        BNE      IntoFreeEntry

 [ debheap
 Push HpTemp
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT03
 WRLN "base-end area"
03
 Pull HpTemp
 ]
        ADD      work, work, addr
        STR      work, hpdbase
        B        GoodExtension

IntoFreeEntry

 [ debheap
 Push HpTemp
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT04
 WRLN "free entry"
04
 Pull HpTemp
 ]

1306 1307 1308 1309 1310 1311 1312
        SUB      HpTemp, HpTemp, size      ; new freblk size
        CMP      HpTemp, #4
        BGT      SplitFreeBlockForExtend

; Not enough space for a free block. Increase the grow amount a bit.
        ADDEQ    work, work, #4
        STREQ    work, [addr, hpd]
Neil Turton's avatar
Neil Turton committed
1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368

; free entry just right size : remove from free list
        LDR      HpTemp, [bp, hpd]         ; free link
        CMP      HpTemp, #Nil
        ADDNE    HpTemp, HpTemp, bp        ; offset from heap start
        SUBNE    HpTemp, HpTemp, tp
        STR      HpTemp, [tp, hpd]         ; free list updated
        B        GoodExtension

SplitFreeBlockForExtend
        LDR      work, [tp, hpd]
        ADD      work, work, size
        STR      work, [tp, hpd]           ; prevnode points at right place
        ADD      work, work, tp            ; offset of new free entry
        ADD      work, work, hpd
        STR      HpTemp, [work, #fresize]
        LDR      HpTemp, [bp, hpd]
        CMP      HpTemp, #Nil
        SUBNE    HpTemp, HpTemp, size      ; reduced offset for free link
        STR      HpTemp, [work, #frelink]
        B        GoodExtension

try_preceding_block
; TMD 01-Mar-89: FindHeapBlock now never returns tp=Nil, only tp=hpdfree,
; so no need for check
        CMP      tp, #:INDEX: hpdfree  ; no real preceder?
        BEQ      got_to_reallocate
        ADD      bp, tp, hpd
        LDR      bp, [bp, #fresize]
        ADD      bp, bp, tp            ; end of preceding block
        CMP      addr, bp
        BNE      got_to_reallocate

; now get size available, see if fits

        SUB      bp, bp, tp           ; freblk size
        SUBS     bp, bp, size         ; compare, find free size left
        BLT      got_to_reallocate

 [ debheap
 Push "HpTemp,lr"
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT10
 CMP bp, #0
 BEQ %FT11
 STRIM "Extending block into previous free"
 B   %FT12
11
 STRIM "Previous free perfect fit"
12
 SWI XOS_NewLine
10
 Pull "HpTemp,lr"
 ]

Kevin Bracey's avatar
Kevin Bracey committed
1369
        WritePSRc SVC_mode+I_bit, HpTemp   ; IRQs off
Neil Turton's avatar
Neil Turton committed
1370 1371 1372 1373 1374 1375 1376

hack_preceder
; bp is new size of preceding block
; tp is prevfree offset
; work is prevprevfree offset
; size is amount block grows by
; addr is block offset
1377 1378 1379 1380
        CMP      bp, #freblksize
        ADDGE    HpTemp, tp, hpd
        STRGE    bp, [HpTemp, #fresize]    ; prevblock shrunk
        BGE      copy_backwards
Neil Turton's avatar
Neil Turton committed
1381 1382 1383

 ; free freblk: work is still prevprevblk pointer
        LDR      HpTemp, [tp, hpd]
1384 1385
        ADDNE    size, size, bp            ; Increase grow amount by any remainder
        MOVNE    bp, #0                    ; And make sure the block does die
Neil Turton's avatar
Neil Turton committed
1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401
        CMP      HpTemp, #Nil
        ADDNE    HpTemp, HpTemp, tp        ; offset from heap start
        SUBNE    HpTemp, HpTemp, work
        STR      HpTemp, [work, hpd]       ; free list updated

copy_backwards
        ADD      bp, bp, tp
        LDR      HpTemp, [addr, hpd]!      ; current block size
        ADD      size, HpTemp, size
        STR      size, [bp, hpd]!          ; update blocksize

 [ debheap
 Push r0
 LDR r0, hpddebug
 CMP r0, #0
 BEQ %FT06
1402
 DREG HpTemp, "copying -4+",cc
Neil Turton's avatar
Neil Turton committed
1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453
 STRIM " from "
 SUB  R0, addr, hpd
 BL   PrintOffset
 STRIM " to "
 SUB  R0, bp, hpd
 BL   PrintOffsetLine
06
 Pull r0
 ]

; TMD 02-Mar-89: We've finished messing about with the heap structure
; so we can branch outside danger zone and restore IRQ status while doing copy
        B       CopyBackwardsInSafeZone

try_add_preceding_block
    [ {TRUE}
; HpTemp is size of following block
        CMP      tp, #:INDEX: hpdfree  ; no real preceder?
        BEQ      got_to_reallocate
        Push    "work, size"           ; need prevprevblk ptr
        SUB      size, size, HpTemp    ; size still needed
        ADD      HpTemp, tp, hpd
        LDR      HpTemp, [HpTemp, #fresize]
        ADD      HpTemp, HpTemp, tp        ; end of preceding block
        CMP      addr, HpTemp
        BNE      got_to_reallocate2

; now get size available, see if fits

        SUB      HpTemp, HpTemp, tp    ; freblk size
        SUBS     HpTemp, HpTemp, size
        BLT      got_to_reallocate2

 [ debheap
 Push "HpTemp,lr"
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT10
 Pull HpTemp
 CMP HpTemp, #0
 BEQ %FT11
 STRIM "Extending block into previous free and block after"
 B   %FT12
11
 STRIM "Previous free+nextblock perfect fit"
12
 SWI XOS_NewLine
10
 Pull "lr"
 ]

Kevin Bracey's avatar
Kevin Bracey committed
1454
        WritePSRc SVC_mode+I_bit, work ; IRQs off
Neil Turton's avatar
Neil Turton committed
1455 1456 1457 1458 1459 1460
   ; delink block at bp
        LDR      work, hpdbase
        CMP      bp, work              ; extend into free, or delink block?
        BNE      ext_delink
        LDR      work, hpdend
        SUB      work, work, bp        ; get back real size
1461
        BIC      work, work, #3
Neil Turton's avatar
Neil Turton committed
1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497
        ADD      work, work, bp
        STR      work, hpdbase         ; all free allocated
        B        ext_hack
ext_delink
        LDR      work, [bp, hpd]
        CMP      work, #Nil
        ADDNE    work, work, bp
        SUBNE    work, work, tp
        STR      work, [tp, hpd]       ; block delinked
ext_hack
        MOV      bp, HpTemp
        Pull    "work, size"
; bp is new size of preceding block
; tp is prevfree offset
; work is prevprevfree offset
; size is amount block grows by
; addr is block offset
        B        hack_preceder

got_to_reallocate2
       Pull     "work, size"
  ]
got_to_reallocate
; claim block of new size ; copy data
; Done by recursive SWIs: somewhat inefficient, but simple.

 [ debheap
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT05
 WRLN "reallocating block"
05
 ]

        B       ReallocateInSafeZone

1498 1499 1500 1501 1502 1503
CorruptExtension
        ADRL    R0,ErrorBlock_HeapFail_BadLink
      [ International
        BL      TranslateError
      ]

Neil Turton's avatar
Neil Turton committed
1504 1505
NaffExtension
        Pull    "addr, size, work"
1506
        B       NaffHeapExit
Neil Turton's avatar
Neil Turton committed
1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534


; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; ExtendHeap. Top level HeapEntry
; ==========
;
; Extend or shrink heap

; In : hpd -> heap descriptor, size = size to change by

; Out : VClear -> heap size changed OK
;       VSet   -> failed to change by specified amount
;       size = amount changed by

ExtendHeap       ROUT
        ValidateHpd  ExtendHeap

        CMP      r3, #0
        ADDMI    r3, r3, #3          ; round towards 0
        BIC      R3, R3, #3          ; ensure word amount

        LDR      HpTemp, hpdend
        ADD      HpTemp, HpTemp, R3  ; HpTemp := new size
        LDR      tp, hpdbase
        CMP      tp, HpTemp
        BGT      ExtendHeap_badshrink

Kevin Bracey's avatar
Kevin Bracey committed
1535
        WritePSRc SVC_mode+I_bit, lr
Neil Turton's avatar
Neil Turton committed
1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 1630 1631 1632 1633 1634 1635 1636 1637 1638 1639 1640 1641 1642 1643 1644 1645 1646 1647 1648 1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698
        Push    "R0, R1"
        MOV      R0, hpd             ; Ensure heap will be in valid area
        ADD      R1, hpd, HpTemp
        SWI      XOS_ValidateAddress
        Pull    "R0, R1"
        BCS      ExtendHeap_nafforf

 [ DebugHeaps
        CMP     R3, #0                  ; if shrunk or stayed same
        BLE     %FT15                   ; then nothing to do
        ADD     tp, hpd, HpTemp         ; tp -> end of heap
        SUB     bp, tp, R3              ; bp -> start of new bit
        ORR     lr, hpd, #FreeSpaceDebugMask
10
        STR     lr, [tp, #-4]!          ; store word
        TEQ     tp, bp
        BNE     %BT10
15
 ]

        STR      HpTemp, hpdend      ; uppy date him
        B        GoodHeapExit        ; moved all the size asked for

ExtendHeap_badhpd
        ADRL     R0, ErrorBlock_HeapFail_BadDesc
      [ International
        BL       TranslateError
      ]
        MOV      size, #0
        B        NaffHeapExit

ExtendHeap_nafforf
        ADRL     R0, ErrorBlock_HeapFail_BadExtend
      [ International
        BL      TranslateError
      ]
        MOV      size, #0
        B        NaffHeapExit

ExtendHeap_badshrink
        LDR      HpTemp, hpdend
        STR      tp, hpdend          ; update heap
        SUB      size, HpTemp, tp    ; size managed to change by
        ADRL     R0, ErrorBlock_HeapFail_ExcessiveShrink
      [ International
        BL       TranslateError
      ]
        B        NaffHeapExit        ; and sort of fail

; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; ReadBlockSize. Top level HeapEntry
; =============
;

ReadBlockSize

        Push    "addr, work"
        BL      FindHeapBlock
        LDRVC   size, [addr, hpd]
        Pull   "addr, work"
        BVC     GoodHeapExit
        B       NaffHeapExit

;**************************************************************************
; Common routines for free/extend

FindHeapBlock   ROUT
; Convert addr to address
; Validate heap
; check block is an allocated block
; return tp = free list entry before the block (hpdfree if none)
;      work = free list before that (if exists)
; corrupts HpTemp, bp

        Push    lr

        ValidateHpd findfailed

        SUB     addr, addr, hpd     ; convert to offset
        SUB     addr, addr, #4      ; real block posn

; Find block in heap by chaining down freelist, stepping through blocks

; TMD 01-Mar-89
; no need to check explicitly for null free list, code drops thru OK

 [ debheap
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT03
 Push lr
 WRLN "Scanning freelist"
 Pull lr
03
 ]

; step down free list to find appropriate chunk
; get tp = free block before addr
; HpTemp =  "     "   after   "
;   work = block before tp

        MOV     tp, #:INDEX: hpdfree
StepDownFreeList
        LDR     HpTemp, [hpd, tp]     ; link offset
        CMP     HpTemp,#Nil
        BEQ     ListEnded             ; EQ state used!
        ADD     HpTemp, HpTemp, tp
        CMP     HpTemp, addr
        MOVLS   work, tp
        MOVLS   tp, HpTemp
        BLS     StepDownFreeList
ListEnded
        LDREQ   HpTemp, hpdbase      ; if EQ from CMP HpTemp, addr
                                     ; then bad block anyway
        CMP     tp, #:INDEX: hpdfree
        MOVEQ   bp, #hpdsize         ; is this a fudge I see before me?
        BEQ     ScanAllocForAddr
        ADD     bp, tp, #fresize
        LDR     bp, [hpd, bp]
        ADD     bp, tp, bp

ScanAllocForAddr
; bp     -> start of allocated chunk
; HpTemp -> end    "   "        "
; scan to find addr, error if no in here

       Push    work       ; keep prevlink ptr

  [ debheap
; HpTemp critical
 Push "HpTemp, R0, link"
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT02
 STRIM "Scan for addr from "
 MOV   R0, bp
 BL    PrintOffset
 STRIM " to "
 LDR   R0,[stack,#4]  ; HpTemp
 BL    PrintOffsetLine
02
 Pull "HpTemp, r0, link"
 ]
        B       CheckForNullAllocn

ScanAllocForAddrLoop
        CMP     bp, addr
        BEQ     ValidBlock
        LDR     work, [bp, hpd]    ; get size
        ADD     bp, bp, work
CheckForNullAllocn
        CMP     bp, HpTemp
        BLT     ScanAllocForAddrLoop

 [ debheap
 Push lr
 STRIM "Given pointer not a block"
 Pull lr
 ]
       ADRL    R0, ErrorBlock_HeapFail_NotABlock
     [ International
       BL      TranslateError
Kevin Bracey's avatar
Kevin Bracey committed
1699 1700
     |
       SETV
Neil Turton's avatar
Neil Turton committed
1701
     ]
Kevin Bracey's avatar
Kevin Bracey committed
1702
       Pull   "work, pc"
Neil Turton's avatar
Neil Turton committed
1703 1704

ValidBlock    ; tp = free link offset, addr = block offset
Kevin Bracey's avatar
Kevin Bracey committed
1705 1706
       CLRV
       Pull   "work, pc"
Neil Turton's avatar
Neil Turton committed
1707 1708 1709 1710 1711 1712 1713 1714 1715 1716

findfailed_badhpd
 [ debheap
 Push   lr
 STRIM "Invalid heap descriptor"
 Pull   lr
 ]
        ADRL    R0, ErrorBlock_HeapFail_BadDesc
      [ International
        BL      TranslateError
Kevin Bracey's avatar
Kevin Bracey committed
1717 1718
      |
        SETV
Neil Turton's avatar
Neil Turton committed
1719
      ]
Kevin Bracey's avatar
Kevin Bracey committed
1720
        Pull    PC
Neil Turton's avatar
Neil Turton committed
1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777

;****************************************************************************

FreeChunkWithConcatenation ROUT
; in : addr -> block
;      tp   -> preceding free list entry
; out : block freed, concatenated with any free parts on either side,
;       base reduced if can do
; corrupts HpTemp, bp, size, addr

; TMD 01-Mar-89: FindHeapBlock now never returns tp=Nil, only tp=hpdfree,
; so no need for check, code will get there eventually!

; attempt concatenation with free blocks on both/either side
 [ debheap
 Push "R0, lr"
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT04
 STRIM "concatenation attempt with free ptr "
 MOV   R0,tp
 BL    PrintOffsetLine
04
 Pull  "R0, lr"
 ]

 [ DebugHeaps
        ORR     bp, hpd, #FreeSpaceDebugMask
        LDR     size, [addr, hpd]!
        ADD     HpTemp, addr, size
        SUB     HpTemp, HpTemp, #4      ; HpTemp -> last word of block
10
        STR     bp, [HpTemp], #-4       ; store word, then go back
        TEQ     HpTemp, addr            ; loop until done, but don't overwrite size field
        BNE     %BT10                   ; otherwise we might get an IRQ with a duff heap
        SUB     addr, addr, hpd         ; make addr an offset again
 ]

        LDR     size, [addr, hpd]      ; block size
        ADD     bp, size, addr         ; eob offset
        LDR     HpTemp, [tp, hpd]      ; Nil doesn't matter here!
        ADD     HpTemp, HpTemp, tp     ; offset of free block after ours
        CMP     HpTemp, bp             ; if tp was hpdfree then <> bp
        BNE     NoConcatWithNext       ; so will take branch

 [ debheap
 Push lr
 LDR bp, hpddebug
 CMP bp, #0
 BEQ %FT05
 WRLN "concatenating with block after"
05
 Pull lr
 ]
        ADD    bp, hpd, HpTemp
        LDR    bp, [bp, #fresize]
        ADD    bp, bp, size
Kevin Bracey's avatar
Kevin Bracey committed
1778
        WritePSRc SVC_mode+I_bit, size
Neil Turton's avatar
Neil Turton committed
1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812
        STR    bp, [addr, hpd]       ; enlarge our block
        LDR    bp, [HpTemp, hpd]     ; offset in free list
        CMP    bp, #Nil
        ADDNE  bp, HpTemp, bp        ; offset from heap start
        SUBNE  bp, bp, tp            ; free list offset
        STR    bp, [tp, hpd]         ; free list updated, our block bigger
                                     ; - but not in the free list yet!

NoConcatWithNext  ; tp = free link offset, addr = block offset
                  ; now try for concatenation with previous block
        CMP    tp, #:INDEX: hpdfree  ; are we before any real free blocks?
        BEQ    NoConcatenation       ; yup

        ADD    HpTemp, tp, hpd
        LDR    size, [HpTemp, #fresize]
        ADD    bp, size, tp
        CMP    bp, addr
        BNE    NoConcatenation
 [ debheap
 Push lr
 LDR bp, hpddebug
 CMP bp, #0
 BEQ %FT06
 WRLN "concatenating with block before"
 STRIM "prevfree = "
 Push  R0
 MOV   R0, work
 BL    PrintOffsetLine
 Pull  R0
06
 Pull lr
 ]
        LDR    bp, [addr, hpd]         ; get block size
        ADD    size, bp, size          ; new free block size
Kevin Bracey's avatar
Kevin Bracey committed
1813
        WritePSRc SVC_mode+I_bit, bp
Neil Turton's avatar
Neil Turton committed
1814 1815 1816 1817 1818
        STR    size, [HpTemp, #fresize]
; now check for butts against base : work is still prevnode to tp
        ADD    HpTemp, size, tp
        LDR    bp, hpdbase
        CMP    bp, HpTemp
Kevin Bracey's avatar
Kevin Bracey committed
1819
        BNE    %FT06                 ; all done : exit keeping IRQs off
Neil Turton's avatar
Neil Turton committed
1820 1821 1822 1823
        SUB    bp, bp, size
        STR    bp, hpdbase           ; step unused bit back
        MOV    bp, #Nil              ; this MUST have been last free block!
        STR    bp, [work, hpd]
Kevin Bracey's avatar
Kevin Bracey committed
1824 1825 1826
06
        CLRV
        MOV    PC, lr                ; Whew!
Neil Turton's avatar
Neil Turton committed
1827 1828 1829 1830 1831 1832 1833 1834 1835

NoConcatenation ; check if block butts against base
; tp = previous freelink offset
        LDR     size, [addr, hpd]
        ADD     HpTemp, size, addr
        LDR     bp, hpdbase
        CMP     bp, HpTemp
        BNE     AddToFreeList
        SUB     bp, bp, size
Kevin Bracey's avatar
Kevin Bracey committed
1836
        WritePSRc SVC_mode+I_bit, HpTemp
Neil Turton's avatar
Neil Turton committed
1837
        STR     bp, hpdbase
Kevin Bracey's avatar
Kevin Bracey committed
1838 1839
        CLRV
        MOV     PC, lr
Neil Turton's avatar
Neil Turton committed
1840 1841 1842 1843 1844 1845 1846 1847 1848 1849 1850 1851 1852 1853 1854 1855 1856

AddToFreeList  ; block at addr, previous free at tp
 [ debheap
 Push "R0, lr"
 LDR HpTemp, hpddebug
 CMP HpTemp, #0
 BEQ %FT07
 STRIM "add to free list : free link "
 MOV   R0,tp
 BL    PrintOffset
 STRIM ", block "
 MOV   R0, addr
 BL    PrintOffsetLine
07
 Pull "R0, lr"
 ]
        LDR    size, [addr, hpd]!
Kevin Bracey's avatar
Kevin Bracey committed
1857
        WritePSRc SVC_mode+I_bit, HpTemp
Neil Turton's avatar
Neil Turton committed
1858 1859 1860 1861 1862 1863 1864 1865 1866
        STR    size, [addr, #fresize]
        SUB    addr, addr, hpd
        LDR    size, [hpd, tp]      ; prevlink
        CMP    size, #Nil
        SUBNE  size, size, addr
        ADDNE  size, size, tp       ; form offset if not eolist
        STR    size, [addr, hpd]
        SUB    size, addr, tp
        STR    size, [tp, hpd]
Kevin Bracey's avatar
Kevin Bracey committed
1867 1868
        CLRV
        MOV    PC, lr
Neil Turton's avatar
Neil Turton committed
1869 1870 1871 1872 1873 1874 1875 1876 1877 1878 1879 1880 1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903 1904 1905 1906 1907 1908 1909 1910 1911 1912 1913 1914

;*****************************************************************************

 [ debheap
;
; ShowHeap. Top level HeapEntry
; ========
;
; Dump the heap pointed to by hpd

ShowHeap
        Push    link
        BL      iShowHeap       ; Needed to fudge link for SVC mode entry
        Pull    link
        B       GoodHeapExit


iShowHeap ROUT ; Internal entry point for debugging heap

        Push    "r0, hpd, addr, size, work, bp, tp, link"

        ValidateHpd showfailed  ; debugging heaps won't work interruptibly

        LDR     tp, hpdfree
        CMP     tp, #Nil
        ADDNE   tp, tp, #:INDEX: hpdfree
        LDR     bp, hpdbase
        MOV     addr, #hpdsize
        LDR     work, hpdend

        SWI     OS_NewLine              ; Initial blurb about hpd contents
        DREG    hpd, "**** Heap map **** : hpd "
        STRIM   "->  free"
        MOV     r0, tp
        BL      PrintOffset
        STRIM   ", base"
        MOV     r0, bp
        BL      PrintOffsetLine
        STRIM   "-> start"
        MOV     r0, addr
        BL      PrintOffset
        STRIM   ",  end"
        MOV     r0, work
        BL      PrintOffsetLine

        SUB     r0, work, bp            ; hpdend-hpdbase
1915
        DREG    r0,"Bytes free: ",cc, Word
Neil Turton's avatar
Neil Turton committed
1916 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975
        SUB     r0, bp, addr            ; hpdbase-hpdsize
        DREG    r0,", bytes used: ",, Word
        SWI     XOS_NewLine

        CMP     tp, #Nil                ; No free blocks at all ?
        BNE     %FT10
        WRLN    "No Free Blocks"

        CMP     bp, addr                ; Is a block allocated at all ?
        MOVNE   r0, addr ; hpdsize
        BNE     %FT40
        WRLN    "No Used Blocks"
        B       %FT99


10      CMP     tp, addr ; hpdsize       ; Allocated block below first free ?
        BEQ     %FT15

        MOV     r0, addr ; hpdbase
        BL      HexUsedBlk
        SUB     r0, tp, addr ; hpdfree-hpdsize
        DREG    r0
        SWI     XOS_NewLine

; Main loop chaining up free space list

15      ADD     addr, tp, hpd             ; convert to address
        LDR     size, [addr, #fresize]    ; Size of this block
        LDR     addr, [addr, #frelink]    ; offset to next block

        STRIM   "Free Block "
        MOV     r0, tp
        BL      PrintOffset
        DREG    size, ", size "

        ADD     r0, tp, size ; r0 -> eob. Adjacent free blocks don't exist

        CMP     addr, #Nil ; If last block, then must we see if we're = hpdbase
        BEQ     %FT40

; Used block starts at r0, ends at addr+tp - so size = (addr+tp)-r0

        BL      HexUsedBlk
        SUB     r0, addr, r0  ; addr-r0
        ADD     r0, r0, tp    ; used block size
        DREG    r0
        SWI     XOS_NewLine

        ADD     tp, addr, tp  ; step down free list
        B       %BT15         ; And loop


40      CMP     r0, bp      ; Is there any allocated space after this block ?
        BEQ     %FT99
        BL      HexUsedBlk
        SUB     r0, bp, r0  ; hpdbase-sob
        DREG    r0
        SWI     XOS_NewLine

99
Kevin Bracey's avatar
Kevin Bracey committed
1976
        CLRV
1977
        Pull   "r0, hpd, addr, size, work, bp, tp, pc"
Neil Turton's avatar
Neil Turton committed
1978 1979 1980 1981


showfailed_badhpd
        WRLN    "Invalid heap descriptor : ShowHeap failed"
1982
        Pull    "r0, hpd, addr, size, work, bp, tp, pc"
Neil Turton's avatar
Neil Turton committed
1983 1984 1985 1986 1987 1988 1989 1990


HexUsedBlk
        Push   "lr"
        STRIM  "Used Block "
        BL      PrintOffset
        STRIM  ", size"
        Pull   "lr"
Kevin Bracey's avatar
Kevin Bracey committed
1991
        MOV     PC, R14
Neil Turton's avatar
Neil Turton committed
1992 1993 1994 1995 1996 1997

PrintOffset
        Push   "r0, lr"
        DREG    r0
        CMP     R0, #0
        ADDNE   R0, R0, hpd
1998
        DREG    r0," (",cc
Neil Turton's avatar
Neil Turton committed
1999
        STRIM   ")"
2000
        Pull   "R0, PC"
Neil Turton's avatar
Neil Turton committed
2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014

PrintOffsetLine
        Push   "lr"
        BL      PrintOffset
        SWI     XOS_NewLine
        Pull   "PC"

 ]

HeapCode_end

; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

        END