1 \ @(#) t_alloc.fth 97/01/28 1.4
\r
2 \ Test PForth ALLOCATE
\r
4 \ Copyright 1994 3DO, Phil Burk
\r
6 anew task-t_alloc.fth
\r
9 64 constant NUM_TAF_SLOTS
\r
11 variable TAF-MAX-ALLOC
\r
12 variable TAF-MAX-SLOT
\r
14 \ hold addresses and sizes
\r
15 NUM_TAF_SLOTS array TAF-ADDRESSES
\r
16 NUM_TAF_SLOTS array TAF-SIZES
\r
18 : TAF.MAX.ALLOC? { | numb addr ior maxb -- max }
\r
20 \ determine maximum amount we can allocate
\r
25 numb allocate -> ior -> addr
\r
28 addr free abort" Free failed!"
\r
44 taf.max.alloc? ." Total Avail = " dup . cr
\r
46 NUM_TAF_SLOTS / taf-max-slot !
\r
49 : TAF.ALLOC.SLOT { slotnum | addr size -- }
\r
53 dup allocate abort" Allocation failed!"
\r
56 addr slotnum taf-addresses !
\r
57 size slotnum taf-sizes !
\r
59 \ paint RAM with slot number
\r
60 addr size slotnum fill
\r
63 : TAF.FREE.SLOT { slotnum | addr size -- }
\r
64 slotnum taf-addresses @ -> addr
\r
65 \ something allocated so check it and free it.
\r
66 slotnum taf-sizes @ 0
\r
68 addr i + c@ slotnum -
\r
70 ." Error at " addr i + .
\r
71 ." , slot# " slotnum . cr
\r
75 addr free abort" Free failed!"
\r
76 0 slotnum taf-addresses !
\r
79 : TAF.DO.SLOT { slotnum -- }
\r
80 slotnum taf-addresses @ 0=
\r
82 slotnum taf.alloc.slot
\r
84 slotnum taf.free.slot
\r
97 taf.max.alloc? dup ." Final MAX = " . cr
\r
98 ." Original MAX = " taf-max-alloc @ dup . cr
\r
99 = IF ." Test PASSED." ELSE ." Test FAILED!" THEN cr
\r
103 : TAF.TEST ( NumTests -- )
\r
105 dup . ." tests" cr \ flushemit
\r
107 ." Please wait for test to complete..." cr
\r
109 DO NUM_TAF_SLOTS choose taf.do.slot
\r
114 .( Testing ALLOCATE and FREE) cr
\r