qemu/roms/openbios/forth/bootstrap/memory.fs - view

File: [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / bootstrap / memory.fs
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 19:19:39 2018 UTC (8 years, 1 month ago) by root
Branches: qemu, MAIN
CVS tags: qemu1101, qemu1001, HEAD

qemu 1.0.1

\ 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 ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.