1 \ @(#) t_alloc.fth 97/01/28 1.4
4 \ Copyright 1994 3DO, Phil Burk
6 INCLUDE? }T{ t_tools.fth
11 64 constant NUM_TAF_SLOTS
13 variable TAF-MAX-ALLOC
16 \ hold addresses and sizes
17 NUM_TAF_SLOTS array TAF-ADDRESSES
18 NUM_TAF_SLOTS array TAF-SIZES
20 : TAF.MAX.ALLOC? { | numb addr ior maxb -- max }
22 \ determine maximum amount we can allocate
27 numb allocate -> ior -> addr
30 addr free abort" Free failed!"
46 taf.max.alloc? ." Total Avail = " dup . cr
48 NUM_TAF_SLOTS / taf-max-slot !
51 : TAF.ALLOC.SLOT { slotnum | addr size -- }
55 dup allocate abort" Allocation failed!"
58 addr slotnum taf-addresses !
59 size slotnum taf-sizes !
61 \ paint RAM with slot number
62 addr size slotnum fill
65 : TAF.FREE.SLOT { slotnum | addr size -- }
66 slotnum taf-addresses @ -> addr
67 \ something allocated so check it and free it.
72 ." Error at " addr i + .
73 ." , slot# " slotnum . cr
77 addr free abort" Free failed!"
78 0 slotnum taf-addresses !
81 : TAF.DO.SLOT { slotnum -- }
82 slotnum taf-addresses @ 0=
84 slotnum taf.alloc.slot
90 : TAF.TERM ( -- error , 0 if PASSED )
99 taf.max.alloc? dup ." Final MAX = " . cr
100 ." Original MAX = " taf-max-alloc @ dup . cr
101 = IF ." Test PASSED." 0
102 ELSE ." Test FAILED!" 1
107 : TAF.TEST ( NumTests -- )
109 dup . ." tests" cr \ flushemit
111 ." Please wait for test to complete..." cr
113 DO NUM_TAF_SLOTS choose taf.do.slot
118 .( Testing ALLOCATE and FREE) cr
122 T{ 10000 taf.test }T{ 0 }T