106 lines
2 KiB
Forth
106 lines
2 KiB
Forth
\ this is the memory management testsuite.
|
|
\
|
|
\ run it with paflof < memory-testsuite.fs 2>/dev/null
|
|
|
|
s" memory.fs" included
|
|
|
|
\ dumps all free-list entries
|
|
\ useful for debugging.
|
|
|
|
: dump-freelist ( -- )
|
|
." Dumping freelist:" cr
|
|
free-list @
|
|
|
|
\ If the free list is empty we notify the user.
|
|
dup 0= if ." empty." drop cr exit then
|
|
|
|
begin dup 0<> while
|
|
dup ." entry 0x" . \ print pointer to entry
|
|
dup cell+ @ ." , next=0x" u. \ pointer to next entry
|
|
dup @ ." , size=0x" u. cr \ len of current entry
|
|
|
|
cell+ @
|
|
repeat
|
|
cr drop
|
|
;
|
|
|
|
\ simple testsuite. run testsuite-init to initialize
|
|
\ with some dummy memory in the dictionary.
|
|
\ run testsuite-test[1..3] for different tests.
|
|
|
|
: testsuite-init ( -- )
|
|
here 40000 cell+ dup allot ( -- ptr len )
|
|
init-mem
|
|
|
|
." start-mem = 0x" start-mem @ . cr
|
|
." end-mem = 0x" end-mem @ . cr
|
|
." free-list = 0x" free-list @ . cr
|
|
|
|
." Memory management initialized." cr
|
|
dump-freelist
|
|
;
|
|
|
|
: testsuite-test1 ( -- )
|
|
." Test No. 1: Allocating all available memory (256k)" cr
|
|
|
|
40000 alloc-mem
|
|
dup 0<> if
|
|
." worked, ptr=0x" dup .
|
|
else
|
|
." did not work."
|
|
then
|
|
cr
|
|
|
|
dump-freelist
|
|
." Freeing memory." cr
|
|
." stack=" .s cr
|
|
free-mem
|
|
dump-freelist
|
|
;
|
|
|
|
: testsuite-test2 ( -- )
|
|
." Test No. 2: Allocating 5 blocks" cr
|
|
4000 alloc-mem
|
|
4000 alloc-mem
|
|
4000 alloc-mem
|
|
4000 alloc-mem
|
|
4000 alloc-mem
|
|
|
|
." Allocated 5 blocks. Stack:" cr .s cr
|
|
|
|
dump-freelist
|
|
|
|
." Freeing Block 2" cr
|
|
3 pick free-mem dump-freelist
|
|
|
|
." Freeing Block 4" cr
|
|
over free-mem dump-freelist
|
|
|
|
." Freeing Block 3" cr
|
|
2 pick free-mem dump-freelist
|
|
|
|
." Cleaning up blocks 1 and 5" cr
|
|
free-mem \ Freeing block 5
|
|
dump-freelist
|
|
3drop \ blocks 4, 3, 2
|
|
free-mem
|
|
|
|
dump-freelist
|
|
;
|
|
|
|
: testsuite-test3 ( -- )
|
|
." Test No. 3: freeing illegal address 0xdeadbeef." cr
|
|
deadbeef free-mem
|
|
dump-freelist
|
|
;
|
|
|
|
: testsuite ( -- )
|
|
testsuite-init
|
|
testsuite-test1
|
|
testsuite-test2
|
|
testsuite-test3
|
|
;
|
|
|
|
testsuite
|
|
|
|
bye
|