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