summaryrefslogtreecommitdiffstats
path: root/qemu/roms/openbios/forth/bootstrap/memory.fs
diff options
context:
space:
mode:
Diffstat (limited to 'qemu/roms/openbios/forth/bootstrap/memory.fs')
-rw-r--r--qemu/roms/openbios/forth/bootstrap/memory.fs216
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
-
- ;