diff options
Diffstat (limited to 'qemu/roms/openbios/forth/bootstrap/memory.fs')
-rw-r--r-- | qemu/roms/openbios/forth/bootstrap/memory.fs | 216 |
1 files changed, 0 insertions, 216 deletions
diff --git a/qemu/roms/openbios/forth/bootstrap/memory.fs b/qemu/roms/openbios/forth/bootstrap/memory.fs deleted file mode 100644 index 6fa4a2cc7..000000000 --- a/qemu/roms/openbios/forth/bootstrap/memory.fs +++ /dev/null @@ -1,216 +0,0 @@ -\ 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 - - ; |