Return to memory-testsuite.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / testsuite

Annotation of qemu/roms/openbios/forth/testsuite/memory-testsuite.fs, revision 1.1.1.1

1.1       root        1: \ this is the memory management testsuite.
                      2: \ 
                      3: \ run it with   paflof < memory-testsuite.fs 2>/dev/null
                      4: 
                      5: s" memory.fs" included
                      6: 
                      7: \ dumps all free-list entries
                      8: \ useful for debugging.
                      9: 
                     10: : dump-freelist ( -- )
                     11:   ." Dumping freelist:" cr
                     12:   free-list @
                     13: 
                     14:   \ If the free list is empty we notify the user.
                     15:   dup 0= if ."   empty." drop cr exit then
                     16:   
                     17:   begin dup 0<> while
                     18:     dup ." entry 0x" .                 \ print pointer to entry
                     19:     dup cell+ @ ." , next=0x" u.       \ pointer to next entry
                     20:     dup @ ." , size=0x" u. cr          \ len of current entry
                     21: 
                     22:     cell+ @
                     23:   repeat
                     24:   cr drop
                     25:   ;
                     26: 
                     27: \ simple testsuite. run testsuite-init to initialize
                     28: \ with some dummy memory in the dictionary.
                     29: \ run testsuite-test[1..3] for different tests.
                     30: 
                     31: : testsuite-init ( -- )
                     32:   here 40000 cell+ dup allot ( -- ptr len )
                     33:   init-mem
                     34: 
                     35:   ." start-mem = 0x" start-mem @ . cr
                     36:   ." end-mem   = 0x" end-mem @ . cr
                     37:   ." free-list = 0x" free-list @ . cr
                     38:   
                     39:   ." Memory management initialized." cr
                     40:   dump-freelist
                     41:   ;
                     42: 
                     43: : testsuite-test1 ( -- )
                     44:   ." Test No. 1: Allocating all available memory (256k)" cr
                     45: 
                     46:   40000 alloc-mem
                     47:   dup 0<> if 
                     48:     ." worked, ptr=0x" dup .
                     49:   else
                     50:     ." did not work."
                     51:   then
                     52:   cr
                     53: 
                     54:   dump-freelist
                     55:   ." Freeing memory." cr
                     56:   ." stack=" .s cr
                     57:   free-mem
                     58:   dump-freelist
                     59:   ;
                     60:   
                     61: : testsuite-test2 ( -- )
                     62:   ." Test No. 2: Allocating 5 blocks" cr
                     63:   4000 alloc-mem
                     64:   4000 alloc-mem
                     65:   4000 alloc-mem
                     66:   4000 alloc-mem
                     67:   4000 alloc-mem
                     68:   
                     69:   ." Allocated 5 blocks. Stack:" cr .s cr
                     70: 
                     71:   dump-freelist
                     72:   
                     73:   ." Freeing Block 2" cr
                     74:   3 pick free-mem dump-freelist
                     75: 
                     76:   ." Freeing Block 4" cr
                     77:   over free-mem dump-freelist
                     78: 
                     79:   ." Freeing Block 3" cr
                     80:   2 pick free-mem dump-freelist
                     81: 
                     82:   ." Cleaning up blocks 1 and 5" cr
                     83:   free-mem     \ Freeing block 5
                     84:   dump-freelist
                     85:   3drop                \ blocks 4, 3, 2
                     86:   free-mem
                     87:   
                     88:   dump-freelist
                     89:   ;
                     90: 
                     91: : testsuite-test3 ( -- )
                     92:   ." Test No. 3: freeing illegal address 0xdeadbeef." cr
                     93:   deadbeef free-mem
                     94:   dump-freelist
                     95:   ;
                     96:   
                     97: : testsuite ( -- )
                     98:   testsuite-init
                     99:   testsuite-test1
                    100:   testsuite-test2
                    101:   testsuite-test3
                    102:   ;
                    103: 
                    104: testsuite
                    105: 
                    106: bye

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