diff options
Diffstat (limited to 'roms/openbios/forth/bootstrap/memory.fs')
| -rw-r--r-- | roms/openbios/forth/bootstrap/memory.fs | 216 |
1 files changed, 216 insertions, 0 deletions
diff --git a/roms/openbios/forth/bootstrap/memory.fs b/roms/openbios/forth/bootstrap/memory.fs new file mode 100644 index 000000000..6fa4a2cc7 --- /dev/null +++ b/roms/openbios/forth/bootstrap/memory.fs @@ -0,0 +1,216 @@ +\ tag: forth memory allocation +\ +\ Copyright (C) 2002-2003 Stefan Reinauer +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + +\ 7.3.3.2 memory allocation + +\ these need to be initialized by the forth kernel by now. +variable start-mem 0 start-mem ! \ start of memory +variable end-mem 0 end-mem ! \ end of memory +variable free-list 0 free-list ! \ free list head + +\ initialize necessary variables and write a valid +\ free-list entry containing all of the memory. +\ start-mem: pointer to start of memory. +\ end-mem: pointer to end of memory. +\ free-list: head of linked free list + +: init-mem ( start-addr size ) + over dup + start-mem ! \ write start-mem + free-list ! \ write first freelist entry + 2dup /n - swap ! \ write 'len' entry + over cell+ 0 swap ! \ write 'next' entry + + end-mem ! \ write end-mem + ; + +\ -------------------------------------------------------------------- + +\ return pointer to smallest free block that contains +\ at least nb bytes and the block previous the the +\ actual block. On failure the pointer to the smallest +\ free block is 0. + +: smallest-free-block ( nb -- prev ptr | 0 0 ) + 0 free-list @ + fffffff 0 0 >r >r >r + begin + dup + while + ( nb prev pp R: best_nb best_pp ) + dup @ 3 pick r@ within if + ( nb prev pp ) + r> r> r> 3drop \ drop old smallest + 2dup >r >r dup @ >r \ new smallest + then + nip dup \ prev = pp + cell + @ \ pp = pp->next + repeat + 3drop r> drop r> r> +; + + +\ -------------------------------------------------------------------- + +\ allocate size bytes of memory +\ return pointer to memory (or throws an exception on failure). + +: alloc-mem ( size -- addr ) + + \ make it legal (and fast) to allocate 0 bytes + dup 0= if exit then + + aligned \ keep memory aligned. + dup smallest-free-block \ look up smallest free block. + + dup 0= if + \ 2drop + -15 throw \ out of memory + then + + ( al-size prev addr ) + + \ If the smallest fitting block found is bigger than + \ the size of the requested block plus 2*cellsize we + \ can split the block in 2 parts. otherwise return a + \ slightly bigger block than requested. + + dup @ ( d->len ) 3 pick cell+ cell+ > if + + \ splitting the block in 2 pieces. + \ new block = old block + len field + size of requested mem + dup 3 pick cell+ + ( al-size prev addr nd ) + + \ new block len = old block len - req. mem size - 1 cell + over @ ( al-size prev addr nd addr->len ) + 4 pick ( ... al-size ) + cell+ - ( al-size prev addr nd nd nd->len ) + over ! ( al-size prev addr nd ) + + over cell+ @ ( al-size prev addr nd addr->next ) + \ write addr->next to nd->next + over cell+ ! ( al-size prev addr nd ) + over 4 pick swap ! + else + \ don't split the block, it's too small. + dup cell+ @ + then + + ( al-size prev addr nd ) + + \ If the free block we got is the first one rewrite free-list + \ pointer instead of the previous entry's next field. + rot dup 0= if drop free-list else cell+ then + ( al-size addr nd prev->next|fl ) + ! + nip cell+ \ remove al-size and skip len field of returned pointer + + ; + + +\ -------------------------------------------------------------------- + +\ free block given by addr. The length of the +\ given block is stored at addr - cellsize. +\ +\ merge with blocks to the left and right +\ immediately, if they are free. + +: free-mem ( addr len -- ) + + \ we define that it is legal to free 0-byte areas + 0= if drop exit then + ( addr ) + + \ check if the address to free is somewhere within + \ our available memory. This fails badly on discontigmem + \ architectures. If we need more RAM than fits on one + \ contiguous memory area we are too bloated anyways. ;) + + dup start-mem @ end-mem @ within 0= if + \ ." free-mem: no such memory: 0x" u. cr + exit + then + + /n - \ get real block address + 0 free-list @ ( addr prev l ) + + begin \ now scan the free list + dup 0<> if \ only check len, if block ptr != 0 + dup dup @ cell+ + 3 pick < + else + false + then + while + nip dup \ prev=l + cell+ @ \ l=l->next + repeat + + ( addr prev l ) + + dup 0<> if \ do we have free memory to merge with? + + dup dup @ cell+ + 3 pick = if \ hole hit. adding bytes. + \ freeaddr = end of current block -> merge + ( addr prev l ) + rot @ cell+ ( prev l f->len+cellsize ) + over @ + \ add l->len + over ! ( prev l ) + swap over cell+ @ \ f = l; l = l->next; + + \ The free list is sorted by addresses. When merging at the + \ start of our block we might also want to merge at the end + \ of it. Therefore we fall through to the next border check + \ instead of returning. + true \ fallthrough value + else + false \ no fallthrough + then + >r \ store fallthrough on ret stack + + ( addr prev l ) + + dup 3 pick dup @ cell+ + = if \ hole hit. real merging. + \ current block starts where block to free ends. + \ end of free block addr = current block -> merge and exit + ( addr prev l ) + 2 pick dup @ ( f f->len ) + 2 pick @ cell+ + ( f newlen ) + swap ! ( addr prev l ) + 3dup drop + 0= if + free-list + else + 2 pick cell+ + then ( value prev->next|free-list ) + ! ( addr prev l ) + cell+ @ rot ( prev l->next addr ) + cell+ ! drop + r> drop exit \ clean up return stack + then + + r> if 3drop exit then \ fallthrough? -> exit + then + + \ loose block - hang it before current. + + ( addr prev l ) + + \ hang block to free in front of the current entry. + dup 3 pick cell+ ! \ f->next = l; + free-list @ = if \ is block to free new list head? + over free-list ! + then + + ( addr prev ) + dup 0<> if \ if (prev) prev->next=f + cell+ ! + else + 2drop \ no fixup needed. clean up. + then + + ; |