📄 memory-testsuite.fs
字号:
\ this is the memory management testsuite.\ \ run it with paflof < memory-testsuite.fs 2>/dev/nulls" 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 ;testsuitebye
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -