opt o+,ow-
;*************************************************
;** AllocP                                      **
;** Version 2.01                                **
;**---------------------------------------------**
;** © 1997 Andreas Kleinert                     **
;** © 1997 THOR-Software, Thomas Richter        **
;** rewritten in assembly language with the     **
;** friendly permission of A. Kleinert          **
;*************************************************

        include INC:exec_lib.asm                ;exec defines
        include INC:macros.asm                  ;macro sets

        section main_code,code

;FOLD Start
;*************************************************
;** Start                                       **
;** main program, patch exec and detach         **
;** does not check for arguments                **
;*************************************************
Start:
        move.l ExecBase,a6
        jsr Forbid(a6)

        lea OldAllocVec,a2
        move.l #NewAllocMem,d0
        move.l a6,a1                            ;Library
        lea AllocMem,a0
        move.l 2(a1,a0.l),(a2)
        jsr SetFunction(a6)                     ;install patch
        move.l d0,(a2)                          ;Save back old pointer

        lea Start(pc),a0
        clr.l -4(a0)                            ;unlink the resident segment

        jsr Permit(a6)
        moveq #0,d0                             ;that's all, folks!
        rts
;ENDFOLD
        dc.b "$VER: AllocP 2.01",0              ;Version ID

        section resident_code,code
;FOLD NewAllocMem
;*************************************************
;** NewAllocMem                                 **
;** this is the new AllocMem vector             **
;** a6=ExecBase, d0=bytesize, d1=req.ments      **
;**                                             **
;** no need to patch AllocVec separately,       **
;** it calls this vector anyways.               **
;*************************************************
NewAllocMem:
        saveregs d2-d3/a2                       ;local variables

        move.l OldAllocVec(pc),a2               ;get old vector

        move.l d1,d3                            ;no expunge?
        bmi.s .tryonce                          ;yes, so try only once
                                                ;Check if this is an Expunge-Call
        cmp.l #$ffffff00,d0
        bhs.s .tryonce                          ;yes, try only once (to expunge!)

        move.l d0,d2

        ;remember well: We DO NOT need to round the size
        ;here, this is done by the exec function internally
        ;you are GUARANTEED to get memory aligned to
        ;8 byte boundaries and of a size divisible by 8

        jsr (a2)                                ;try to get memory
        tst.l d0                                ;got it ?
        bne.s .exit                             ;yes, so fine and exit

        ;if not: The above memory allocation may have started a flush
        ;operation, but since everything happend in the Forbid() mode
        ;above, some memory-free handlers might not have had a chance
        ;to run. That happens AT LEAST HERE (multitasking!), so
        ;we should try again. Call it an exec-feature!

        ;We DO NOT flush the memory with trying to allocate a
        ;memory block of size ~0, since this will flush ALL
        ;libraries & devices which is propably not necessary.

        move.l d2,d0
        move.l d3,d1                            ;get parameters
        jsr (a2)
        tst.l d0
        bne.s .exit                             ;now fine ?

        ;seems that this hasn't helped yet. So, now let's try it
        ;the hard way: Remove ALL the stuff from memory by
        ;trying the impossible: Public memory of size ~0

        moveq #-1,d0
        moveq #1,d1
        jsr (a2)                                ;get ALL of it!

        ;no chance that this has worked, but at least, the
        ;memory is clean now!
        ;We try again for a last time and give up if that hasn't
        ;helped.

        move.l d2,d0
        move.l d3,d1                    ;get parameters
.tryonce:
        jsr (a2)                        ;try it a last time

        ;if this fails, the user has to take care about it!
.exit:
        loadregs
        rts
;ENDFOLD

OldAllocVec:
        dc.l 0                          ;Room for the old vector