10 REM > BLib.MAllocA/src 1.05 15Sep2011

   20 REM Version A: checks last slot before scanning list

   30 REM

   40 REM v1.05 15Sep2011 JGH Extends last slot into free space, adds names to heap on first call

   50 REM v1.04 12Aug2006 JGH Checks for size of free memory

   60 REM v1.03 23Jul2006 JGH m_zalloc() added

   70 REM v1.02 15Sep1989 JGH m_realloc() added

   80 REM v1.01 08Sep1989 JGH Bug in reuse of released memory fixed

   90 REM v1.00 06Sep1989 JGH m_alloc() and m_free() written

  100 :

  110 REM Memory Allocation Routines

  120 REM ~~~~~~~~~~~~~~~~~~~~~~~~~~

  130 REM *BUG* When scanning heap, when link=0, !0 is read from

  140 :

  150 :

  160 DEFFNm_alloc(size%):LOCALA%,B%,E%:m_heap%=m_heap%        :REM Create m_heap%

  170 IFm_heap%=0:PROCm_free(0)                                :REM If first call, add names to heap

  180 size%=(size%+3)AND-4:DIME%-1:IFsize%=0:=HIMEM-E%-1280    :REM Return free space

  190 A%=m_heap%

  200 IFA%:IF!A%<=size%:IFA%+!A%+4=E%:DIME%size%-!A%:!A%=size%:m_heap%=A%!4:=A%+4 :REM Extend last slot

  210 IFA%:IF!A%< size%:REPEATB%=A%:A%=A%!4:UNTIL!A%>=size%ORA%=0 :REM Scan for big enough slot

  220 IFA%=0:IFHIMEM-E%-size%-1280<0:=0                           :REM No slot, no free space

  230 IFA%=0:DIMA%size%+3:!A%=size%:=A%+4                         :REM No slot, claim new space

  240                                                :REM Slot bigger than needed, split it

  250 IF!A%>size%+7:A%!(size%+8)=A%!4:A%!(size%+4)=!A%-size%-4:A%!4=A%+size%+4:!A%=size%

  260 IFB%:B%!4=A%!4 ELSE m_heap%=A%!4               :REM Get link, point to next slot

  270 =A%+4                                          :REM Return this claimed slot

  280 :

  290 DEFPROCm_free(ptr%):m_heap%=m_heap%:IFptr%=0:ENDPROC

  300 !ptr%=m_heap%:m_heap%=ptr%-4

  310 IF!ptr%=ptr%+ptr%!-4:ptr%!-4=ptr%!-4+!!ptr%+4:!ptr%=!(!ptr%+4)

  320 ENDPROC

  330 :

  340 DEFFNm_realloc(ptr%,size%):PROCm_free(ptr%):=FNm_alloc(size%)

  350 :

  360 DEFFNm_zalloc(size%):LOCALA%:A%=FNm_alloc(size%):IFA%=0ORsize%<1:=A%

  370 REPEATsize%=size%-1:A%?size%=0:UNTILsize%<0:=A%