bb6b2dcd |
1 | \ @(#) t_alloc.fth 97/01/28 1.4\r |
2 | \ Test PForth ALLOCATE\r |
3 | \\r |
4 | \ Copyright 1994 3DO, Phil Burk\r |
5 | \r |
6 | anew task-t_alloc.fth\r |
7 | decimal\r |
8 | \r |
9 | 64 constant NUM_TAF_SLOTS\r |
10 | \r |
11 | variable TAF-MAX-ALLOC\r |
12 | variable TAF-MAX-SLOT\r |
13 | \r |
14 | \ hold addresses and sizes\r |
15 | NUM_TAF_SLOTS array TAF-ADDRESSES\r |
16 | NUM_TAF_SLOTS array TAF-SIZES\r |
17 | \r |
18 | : TAF.MAX.ALLOC? { | numb addr ior maxb -- max }\r |
19 | 0 -> maxb\r |
20 | \ determine maximum amount we can allocate\r |
21 | 1024 40 * -> numb\r |
22 | BEGIN\r |
23 | numb 0>\r |
24 | WHILE\r |
25 | numb allocate -> ior -> addr\r |
26 | ior 0=\r |
27 | IF \ success\r |
28 | addr free abort" Free failed!"\r |
29 | numb -> maxb\r |
30 | 0 -> numb\r |
31 | ELSE\r |
32 | numb 1024 - -> numb\r |
33 | THEN\r |
34 | REPEAT\r |
35 | maxb\r |
36 | ;\r |
37 | \r |
38 | : TAF.INIT ( -- )\r |
39 | NUM_TAF_SLOTS 0\r |
40 | DO\r |
41 | 0 i taf-addresses !\r |
42 | LOOP\r |
43 | \\r |
44 | taf.max.alloc? ." Total Avail = " dup . cr\r |
45 | dup taf-max-alloc !\r |
46 | NUM_TAF_SLOTS / taf-max-slot !\r |
47 | ;\r |
48 | \r |
49 | : TAF.ALLOC.SLOT { slotnum | addr size -- }\r |
50 | \ allocate some RAM\r |
51 | taf-max-slot @ 8 -\r |
52 | choose 8 + \r |
53 | dup allocate abort" Allocation failed!"\r |
54 | -> addr\r |
55 | -> size\r |
56 | addr slotnum taf-addresses !\r |
57 | size slotnum taf-sizes !\r |
58 | \\r |
59 | \ paint RAM with slot number\r |
60 | addr size slotnum fill\r |
61 | ;\r |
62 | \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 |
67 | DO\r |
68 | addr i + c@ slotnum -\r |
69 | IF\r |
70 | ." Error at " addr i + .\r |
71 | ." , slot# " slotnum . cr\r |
72 | abort\r |
73 | THEN\r |
74 | LOOP\r |
75 | addr free abort" Free failed!"\r |
76 | 0 slotnum taf-addresses !\r |
77 | ;\r |
78 | \r |
79 | : TAF.DO.SLOT { slotnum -- }\r |
80 | slotnum taf-addresses @ 0=\r |
81 | IF\r |
82 | slotnum taf.alloc.slot\r |
83 | ELSE\r |
84 | slotnum taf.free.slot\r |
85 | THEN\r |
86 | ;\r |
87 | \r |
88 | : TAF.TERM\r |
89 | NUM_TAF_SLOTS 0\r |
90 | DO\r |
91 | i taf-addresses @\r |
92 | IF\r |
93 | i taf.free.slot\r |
94 | THEN\r |
95 | LOOP\r |
96 | \\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 |
100 | \r |
101 | ;\r |
102 | \r |
103 | : TAF.TEST ( NumTests -- )\r |
104 | 1 max\r |
105 | dup . ." tests" cr \ flushemit\r |
106 | taf.init\r |
107 | ." Please wait for test to complete..." cr\r |
108 | 0\r |
109 | DO NUM_TAF_SLOTS choose taf.do.slot\r |
110 | LOOP\r |
111 | taf.term\r |
112 | ;\r |
113 | \r |
114 | .( Testing ALLOCATE and FREE) cr\r |
115 | 10000 taf.test\r |
116 | \r |