dynamic-memory-allocation
An implementation of ALLOCATE FREE RESIZE in Forth-94
\ Forth-94 version of Klaus Schleisiek's dynamic memory allocation (FORML'88) uh 2016-10-28 Variable anchor 0 anchor ! decimal 050 Constant waste -1 1 rshift Constant #max #max invert Constant #free \ sign bit : size ( mem -- size ) 1 cells - @ #max and ; : addr&size ( mem -- mem size ) dup size ; : above ( mem -- >mem ) addr&size + 2 cells + ; : use ( mem size -- ) dup >r swap 2dup 1 cells - ! r> #max and + ! ; : release ( mem size -- ) #free or use ; : fits? ( size -- mem | false ) >r anchor @ BEGIN addr&size r@ u< 0= IF r> drop EXIT THEN @ dup anchor @ = UNTIL 0= r> drop ; : link ( mem >mem <mem -- ) >r 2dup cell+ ! over ! r> 2dup ! swap cell+ ! ; : @links ( mem -- <mem mem> ) dup @ swap cell+ @ ; : setanchor ( mem -- mem ) dup anchor @ = IF dup @ anchor ! THEN ; : unlink ( mem -- ) setanchor @links 2dup ! swap cell+ ! ; : allocate ( size -- mem ior ) 3 cells max dup >r fits? ?dup 0= IF r> -8 EXIT THEN ( "dictionary overflow" ) addr&size r@ - dup waste u< IF drop dup @ over unlink over addr&size use ELSE 2 cells - over r@ use over above dup rot release 2dup swap @links link THEN r> drop anchor ! 0 ; : free ( mem -- ior ) addr&size over 2 cells - @ dup 0< IF #max and 2 cells + rot over - rot rot + ELSE drop over anchor @ dup cell+ @ link THEN 2dup + cell+ dup @ dup 0< IF #max and swap cell+ unlink + 2 cells + release 0 EXIT THEN 2drop release 0 ; : resize ( mem newsize -- mem' ior ) over swap over size 2dup > IF ( mem mem size newsize ) swap allocate ?dup IF >r drop 2drop r> EXIT THEN dup >r swap move free r> swap EXIT THEN 2drop drop 0 ; : empty-memory ( addr size -- ) >r cell+ dup anchor ! dup 2 cells use dup 2dup link dup above swap over dup link dup r> 7 cells - release above 1 cells - 0 swap ! ; cr cr .( dynamic memory allocation:) cr .( Use addr size EMPTY-MEMORY to initialize,) cr .( then use the standard memory allocation wordset ALLOCATE FREE RESIZE to manage memory.)
by UlrichHoffmann
Versions
Tags
ansforth94, forth-94, forth-2012, memory, allocation, allocate, free, resize
Dependencies
None
Dependents
None