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     ! 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.