; ***** DON'T KNOW WHETHER THIS WORKS. WAS NEVER USED!! *****
; ----------------------------------------------------------------------
;                   Copyright (C) 1991 by Natrlich!
;                      This file is copyrighted!
;                Refer to the documentation for details.
; ----------------------------------------------------------------------
;                 Nothing beats a selfwritten malloc....
; HEAD -> [used.w][size.w][next.l] -> ....
; This mallocer doesn't really free anything back to the OS. Why should
; we ? For all programs that are expected to run in a matter of seconds
; not hours, the overhead isn't justified.
; Leaves in the worst case MANY bytes of fragmented OS space unused
;    This is only a crutch for GEMDOSes fucked up memory manager
; ----------------------------------------------------------------------
         .export  malloc
         .export  free

BLOCKSIZE   equ   $6008                ;; must be within 15 bits
GBLOCK      equ   $03


         .code
failed:
         sub.l    a0,a0
         bra      done

malloc:
         move.w   d0,1
         move.l   a3,-(a7)             ;; save two regs
         move.l   d3,-(a7)

         move.l   d0,d3                ;; try to alloc 0 ??
         beq.b    failed               ;; that's stupid
         bmi.b    failed               ;; negative is wrong also
         
         cmpi.l   #BLOCKSIZE-$100,d0   ;; more than we can handle
         ble.b    goodenough           ;; then give it to GEMDOS

         addq.l   #8,d0                ;; so this is too big for us
         move.l   d0,-(a7)             ;; use MALLOC from GEMDOS
         move.w   #$48,-(a7)
         trap     #1
         addq.l   #6,a7
         tst.l    d0                   ;; Enough memory ??
         beq.b    failed               ;; njet ->
         move.l   d0,a0                ;; else mark it as
         move.w   #GBLOCK,(a0)         ;; being a GEMDOS block
         addq.l   #8,a0                ;; skip header
         bra.b    done                 ;; and return

goodenough:
         lea      head,a1              ;; get head pointer
         bra.b    next

loop:
         tst.w    (a1)                 ;; block in USE ?
         bne.b    next                 ;; yes ->next
         cmp.l    (a1),d0              ;; size OK ?  (First fit)
         ble.b    ok
next:
         lea      4(a1),a3             ;; save address of NEXT pointer
         move.l   (a3),a1              ;; get NEXT pointer
         move.l   a1,d1                ;; end of list
         bne.b    loop                 ;; da nada ---^

alloc:
         pea      BLOCKSIZE
         move.w   #$48,-(a7)
         trap     #1
         addq.l   #6,a7
         tst.l    d0
         beq.b    failed               ;; not enough room ---V

         move.l   d0,(a3)              ;; initialize header
         move.l   d0,a1                ;; of memory block
         move.l   #BLOCKSIZE-8,(a1)    ;; actual block - header
         clr.l    4(a1)                ;; clear next pointer

ok:
         lea      8(a1),a0             ;; get memory area anyway
         move.l   (a1),d1              ;; get block size
         sub.l    d3,d1                ;; subtract #bytes
         subq.l   #8,d1                ;; less the header
         cmpi.w   #4,d1                ;; no split for less than 4
         blt.b    success              ;; then we are thru!!

         move.l   d3,(a1)+             ;; mosey on up to NEXT field
         lea      4(d3,a1),a3          ;;       DO THE SPLIT
         move.l   (a1),4(a3)           ;; save old NEXT in new
         move.l   a3,(a1)              ;; save new as NEXT in old
         move.l   d1,(a3)              ;; save SIZE and clear USED

success:
         st       -8(a0)               ;; mark as used
done:
         move.l   (a7)+,d3
fdone:
         move.l   (a7)+,a3
         rts


free:
         move.l   a3,-(a7)             ;; save a reg

         move.l   a0,d0                ;; 0 pointer (MAYBE WE SHOULD CRASH)
         beq.b    fdone                ;; but we don't
         
         lea      -8(a0),a3            ;; get header
         move.w   (a3),d0
         beq.b    fdone                ;; LUSER tried to free twice
         subq.w   #GBLOCK,d0           ;; Was it a bona fide GEMDOS block ?
         beq.b    yup                  ;; then we DO free ---V

         clr.w    (a3)                 ;; mark as unused
         move.l   (a3),d1              ;; get size in D1
         add.l    a3,d1                ;; add with current pointer
         addq.l   #8,d1                ;; add header len
         move.l   4(a3),a1             ;; get NEXT pointer
         cmpa.l   d1,a1                ;; curr + #header + size == NEXT ??
         bne.b    nojoin               ;; NO join impossible
         tst.w    (a1)                 ;; next block free  ?
         bne.b    nojoin               ;; no --V
         bsr.b    join_adjacent

nojoin:
         lea      head,a1              ;; get head (CHK LFT NEIGHBOR)

loop2a:
         move.l   4(a1),a1             ;; get next pointer address
         move.l   a1,d1                ;; end of list
         beq.b    fdone

         move.l   (a1),d1              ;; get size in A2
         add.l    a1,d1                ;; add with current pointer
         addq.l   #8,d1                ;; add header len
         cmpa.l   d1,a3                ;; points to us ??
         bne.b    loop2a               ;; yes -> done

         bsr.b    join_adjacent        ;; USED must have been CLEAR 
         bra.b    fdone                ;; for this to work

yup:
         move.l   a0,-(a7)             ;; free that sucker
         move.w   #$49,-(a7)
         trap     #1
         addq.l   #6,a7
         bra.b    fdone



join_adjacent:
         move.l   (a3),d0              ;; get SIZE of LEFT guy
         add.l    (a1),d0              ;; add sizes of RITE to it
         addq.l   #8,d0                ;; don't forget the header
         move.l   d0,(a3)              ;; write in LEFT
         move.l   4(a1),4(a3)          ;; copy RITE NEXT pointer to LEFT
         rts


         .data
head:
         .dc.w    $FFFF                ;; used internally flag
         .dc.w    $0000                ;; no size
headnext:
         .dc.l    0                    ;; points nowhere