Initial revision
[ssr] / StraySrc / Libraries / Sapphire / s / subAlloc
1 ;
2 ; suballoc.s
3 ;
4 ; Handling of requests for small link blocks (MDW)
5 ;
6 ; © 1994-1998 Straylight
7 ;
8
9 ;----- Licensing note -------------------------------------------------------
10 ;
11 ; This file is part of Straylight's Sapphire library.
12 ;
13 ; Sapphire is free software; you can redistribute it and/or modify
14 ; it under the terms of the GNU General Public License as published by
15 ; the Free Software Foundation; either version 2, or (at your option)
16 ; any later version.
17 ;
18 ; Sapphire is distributed in the hope that it will be useful,
19 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ; GNU General Public License for more details.
22 ;
23 ; You should have received a copy of the GNU General Public License
24 ; along with Sapphire. If not, write to the Free Software Foundation,
25 ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26
27 ;----- Standard header ------------------------------------------------------
28
29 GET libs:swis
30 GET libs:header
31
32 ;----- External dependencies ------------------------------------------------
33
34 GET sapphire:alloc
35 GET sapphire:mem
36 GET sapphire:sapphire
37
38 ;----- Word to the wise -----------------------------------------------------
39 ;
40 ; Various bits of Sapphire require lots of small blocks for linked lists and
41 ; things. To avoid mangling the heap, we allocate very big blocks and then
42 ; split them up into littler ones. These big blocks just contain lots of
43 ; little ones.
44 ;
45 ; The data blocks are allocated such that they are just big enough for the
46 ; data -- the caller must specify the actual size of the block when freeing.
47 ; Completely free big blocks just stay in the heap ready to be allocated
48 ; again by this system. They are not returned to the heap.
49 ;
50 ; We keep a table of pointers to the big block lists for each supported
51 ; block size. This is rather like the `bins' idea in the C library malloc
52 ; algorithms.
53
54 ;----- Main code ------------------------------------------------------------
55
56 AREA |Sapphire$$Code|,CODE,READONLY
57
58 ; --- sub_alloc ---
59 ;
60 ; On entry: R0 == size of block to allocate
61 ;
62 ; On exit: R0 == pointer to block allocated
63 ; May return an error
64 ;
65 ; Use: Allocates a block of the size specified, typically very
66 ; quickly indeed.
67 ;
68 ; If the size is not one of those supported (currently
69 ; supported sizes are 8-40 inclusive in 4 byte increments),
70 ; the behaviour is undefined (but very predictable).
71
72 EXPORT sub_alloc
73 sub_alloc ROUT
74
75 STMFD R13!,{R1-R3,R12,R14}
76
77 ; --- Find the correct table entry ---
78
79 WSPACE sub__wSpace ;Find my workspace
80 ADD R1,R12,R0 ;Find the entry in the table
81
82 ; --- Are there any free blocks? ---
83
84 LDR R2,[R1] ;Get the free list offset
85 CMP R2,#0 ;Are there any free blocks?
86 BEQ %20sub_alloc ;No -- better allocate some
87
88 ; --- Mess about with the free list and return ---
89
90 10sub_alloc LDR R0,[R2] ;Get next pointer from block
91 STR R0,[R1] ;This is now first free block
92 MOV R0,R2 ;Return the old free block
93 LDMFD R13!,{R1-R3,R12,R14} ;Restore registers and return
94 BICS PC,R14,#V_flag ;Clear error as we leave
95
96 ; --- Create a big block ---
97 ;
98 ; We're now using alloc for this. To avoid extra memory
99 ; usage, we nobble alloc's `extra' word which allows it
100 ; to find the free routine, because we'll never free it
101 ; anyway!
102
103 20sub_alloc MOV R2,R0 ;Keep the size safe
104 MOV R0,R0,LSL #3 ;Find the chunk size
105 SUB R0,R0,#4 ;This is evil. I don't care
106 BL alloc ;Allocate some memory
107 BCS %90sub_alloc ;If failed, report error
108 SUB R0,R0,#4 ;Gobble alloc's overhead
109
110 ; --- Now set up the links for the free list ---
111
112 MOV R14,#0 ;Next free pointer start at 0
113 MOV R3,#8 ;We have 8 blocks to do
114 00 STR R14,[R0],R2 ;Store in next field
115 SUB R14,R0,R2 ;Remember old block pointer
116 SUBS R3,R3,#1 ;Point to previous block
117 BGT %b00 ;If more to do, continue...
118
119 ; --- The links are set up -- now take off a block ---
120
121 MOV R2,R14 ;Use last block allocated
122 B %10sub_alloc ;Then allocate as normal
123
124 ; --- Handle an error ---
125
126 90 BL alloc_error ;Find the error message
127 LDMFD R13!,{R1-R3,R12,R14} ;Restore registers
128 ORRS PC,R14,#V_flag ;And return the error
129
130 LTORG
131
132 ; --- sub_free ---
133 ;
134 ; On entry: R0 == pointer to block
135 ; R1 == size of the block
136 ;
137 ; On exit: --
138 ;
139 ; Use: Frees a block allocated using sub_alloc.
140
141 EXPORT sub_free
142 sub_free ROUT
143
144 STMFD R13!,{R0,R1,R12,R14} ;Preserve registers
145
146 ; --- Find the correct table entry ---
147
148 WSPACE sub__wSpace ;Find my workspace
149 ADD R1,R12,R1 ;Find the entry in the table
150
151 ; --- Mess about with the list ---
152
153 LDR R14,[R1] ;Get current first block
154 STR R14,[R0] ;Store in newly freed block
155 STR R0,[R1] ;And insert new block in list
156 LDMFD R13!,{R0,R1,R12,PC}^ ;Oh, and return to caller
157
158 LTORG
159
160 ; --- sub_init ---
161 ;
162 ; On entry: --
163 ;
164 ; On exit: --
165 ;
166 ; Use: Initialises the suballocation system for use.
167
168 EXPORT sub_init
169 sub_init ROUT
170
171 STMFD R13!,{R0-R2,R12,R14} ;Save some registers
172 WSPACE sub__wSpace ;Find my workspace
173
174 ; --- Am I initialised? ---
175
176 LDR R14,sub__flags ;Get my flags word
177 TST R14,#sub__INITED ;Test the flag
178 LDMNEFD R13!,{R0-R2,R12,PC}^ ;Yes -- return to caller
179
180 ; --- Set up the workspace properly ---
181
182 ORR R14,R14,#sub__INITED ;We are now initialised
183 STR R14,sub__flags ;Store it in the flags
184 ADD R0,R12,#4 ;Point to the table
185 MOV R1,#10*4 ;Number of entries supported
186 MOV R2,#0 ;Zero them all
187 BL mem_set ;Zero-initialise my workspace
188 BL alloc_init ;Make sure alloc is awake
189 LDMFD R13!,{R0-R2,R12,PC}^ ;Return to caller
190
191 LTORG
192
193 sub__wSpace DCD 0
194
195 ;----- Workspace ------------------------------------------------------------
196
197 ^ 0,R12
198 sub__wStart # 0
199
200 sub__flags # 0 ;Various interesting flags
201
202 sub__INITED EQU (1<<0) ;Am I initialised?
203
204 sub__table # 4*10 ;The suballoc root table
205
206 sub__wSize EQU {VAR}-sub__wStart
207
208 AREA |Sapphire$$LibData|,CODE,READONLY
209
210 DCD sub__wSize
211 DCD sub__wSpace
212 DCD 0
213 DCD sub_init
214
215 ;----- That's all folks -----------------------------------------------------
216
217 END