author | werner |
Fri, 02 Apr 2004 18:28:16 +0200 | |
changeset 8288 | 0bc2cce47912 |
parent 7855 | 27f64d1beaa1 |
child 8901 | 824a89d0b5c7 |
permissions | -rw-r--r-- |
6459 | 1 |
" |
2 |
COPYRIGHT (c) 1993 by Claus Gittinger |
|
3 |
All Rights Reserved |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
4 |
|
6459 | 5 |
This software is furnished under a license and may be used |
6 |
only in accordance with the terms of that license and with the |
|
7 |
inclusion of the above copyright notice. This software may not |
|
8 |
be provided or otherwise made available to, or used by, any |
|
9 |
other person. No title to or ownership of the software is |
|
10 |
hereby transferred. |
|
11 |
" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
12 |
|
5378 | 13 |
"{ Package: 'stx:libbasic' }" |
14 |
||
3208
2d71538b9fd5
now subclass of UIBytes - which contains common protocol
Claus Gittinger <cg@exept.de>
parents:
3206
diff
changeset
|
15 |
UninterpretedBytes subclass:#ExternalBytes |
3211
ef7a5411afa1
remove methods which are provided by my (new) superClass
Claus Gittinger <cg@exept.de>
parents:
3208
diff
changeset
|
16 |
instanceVariableNames:'address* size' |
5378 | 17 |
classVariableNames:'AllocatedInstances Lobby DebugMalloc TraceMalloc AccessLock' |
3211
ef7a5411afa1
remove methods which are provided by my (new) superClass
Claus Gittinger <cg@exept.de>
parents:
3208
diff
changeset
|
18 |
poolDictionaries:'' |
ef7a5411afa1
remove methods which are provided by my (new) superClass
Claus Gittinger <cg@exept.de>
parents:
3208
diff
changeset
|
19 |
category:'System-Support' |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
20 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
21 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
22 |
!ExternalBytes primitiveFunctions! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
23 |
%{ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
24 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
25 |
struct mallocList { |
6459 | 26 |
char *chunk; |
27 |
unsigned size; |
|
28 |
struct mallocList *next; |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
29 |
}; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
30 |
static struct mallocList *mallocList = (struct mallocList *)0; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
31 |
static mallocCount = 0; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
32 |
|
6242 | 33 |
static void |
34 |
removeFromMallocList(ptr) |
|
35 |
char *ptr; |
|
36 |
{ |
|
37 |
struct mallocList *this, *prev, *next; |
|
38 |
int found = 0; |
|
39 |
||
40 |
if (@global(DebugMalloc) != true) return; |
|
41 |
||
42 |
if (ptr) { |
|
6459 | 43 |
found = 0; |
44 |
for (this=mallocList, prev=0; this; this=next) { |
|
45 |
next = this->next; |
|
46 |
if (this->chunk == ptr) { |
|
47 |
if (prev) { |
|
48 |
prev->next = next; |
|
49 |
} else { |
|
50 |
mallocList = next; |
|
51 |
} |
|
52 |
free(this); |
|
53 |
found++; |
|
54 |
mallocCount--; |
|
55 |
} else { |
|
56 |
prev = this; |
|
57 |
} |
|
58 |
} |
|
59 |
if (! found) { |
|
6242 | 60 |
#ifdef alpha64 |
6459 | 61 |
printf("EXTBYTES [warning]: **** free: alien %lx (allocated somewhere else ?))\n", ptr); |
6242 | 62 |
#else |
6459 | 63 |
printf("EXTBYTES [warning]: **** free: alien %x (allocated somewhere else ?))\n", ptr); |
6242 | 64 |
#endif |
6459 | 65 |
} |
6242 | 66 |
} |
67 |
} |
|
68 |
||
69 |
static void |
|
70 |
addToMallocList(ptr, nBytes) |
|
71 |
char *ptr; |
|
72 |
{ |
|
73 |
struct mallocList *e, *this; |
|
6457 | 74 |
char *malloc(); |
6242 | 75 |
int found; |
76 |
||
77 |
if (@global(DebugMalloc) != true) return; |
|
78 |
||
79 |
if (ptr) { |
|
6459 | 80 |
found = 0; |
81 |
for (this=mallocList; this; this=this->next) { |
|
82 |
if (this->chunk == ptr) { |
|
6242 | 83 |
#ifdef alpha64 |
6459 | 84 |
printf("EXTBYTES [warning]: **** %016lx already allocated (freed somewhere else ?)\n", ptr); |
6242 | 85 |
#else |
6459 | 86 |
printf("EXTBYTES [warning]: **** %08x already allocated (freed somewhere else ?)\n", ptr); |
6242 | 87 |
#endif |
6459 | 88 |
found++; |
89 |
} |
|
90 |
} |
|
91 |
if (! found) { |
|
92 |
e = (struct mallocList *) malloc(sizeof(struct mallocList)); |
|
93 |
e->next = mallocList; |
|
94 |
e->chunk = ptr; |
|
95 |
e->size = nBytes; |
|
96 |
mallocList = e; |
|
97 |
mallocCount++; |
|
98 |
} |
|
6242 | 99 |
} |
100 |
} |
|
101 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
102 |
char * |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
103 |
__stx_malloc(nBytes) { |
6459 | 104 |
char *ptr; |
105 |
char *malloc(); |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
106 |
|
6459 | 107 |
ptr = malloc(nBytes); |
6242 | 108 |
|
6459 | 109 |
if (@global(TraceMalloc) == true) { |
2788 | 110 |
#ifdef alpha64 |
6459 | 111 |
printf("EXTBYTES [info]: allocated %d bytes at: %016lx\n", nBytes, ptr); |
2779 | 112 |
#else |
6459 | 113 |
printf("EXTBYTES [info]: allocated %d bytes at: %08x\n", nBytes, ptr); |
2779 | 114 |
#endif |
6459 | 115 |
} |
6242 | 116 |
|
6459 | 117 |
addToMallocList(ptr, nBytes); |
6242 | 118 |
|
6459 | 119 |
return ptr; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
120 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
121 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
122 |
char * |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
123 |
__stx_calloc(n, size) { |
6459 | 124 |
char *ptr; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
125 |
|
6459 | 126 |
ptr = __stx_malloc(n * size); |
127 |
if (ptr != (char *)0) { |
|
128 |
bzero(ptr, (n * size)); |
|
129 |
} |
|
130 |
return ptr; |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
131 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
132 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
133 |
char * |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
134 |
__stx_realloc(ptr, nBytes) |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
135 |
char *ptr; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
136 |
{ |
6459 | 137 |
char *newPtr; |
138 |
char *realloc(); |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
139 |
|
6459 | 140 |
removeFromMallocList(ptr); |
141 |
newPtr = realloc(ptr, nBytes); |
|
142 |
addToMallocList(newPtr, nBytes); |
|
6457 | 143 |
|
6459 | 144 |
if (@global(TraceMalloc) == true) { |
2788 | 145 |
#ifdef alpha64 |
6459 | 146 |
printf("EXTBYTES [info]: realloc %d bytes for %016lx at: %016lx\n", nBytes, ptr, newPtr); |
2779 | 147 |
#else |
6459 | 148 |
printf("EXTBYTES [info]: realloc %d bytes for %08x at: %08x\n", nBytes, ptr, newPtr); |
2779 | 149 |
#endif |
6459 | 150 |
} |
151 |
return newPtr; |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
152 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
153 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
154 |
__stx_free(ptr) |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
155 |
char *ptr; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
156 |
{ |
6459 | 157 |
if (@global(TraceMalloc) == true) { |
158 |
printf("EXTBYTES: free bytes at: %08x\n", ptr); |
|
159 |
} |
|
160 |
removeFromMallocList(ptr); |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
161 |
|
6459 | 162 |
return free(ptr); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
163 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
164 |
|
3320 | 165 |
__stx_mallocStatistics() { |
6459 | 166 |
struct mallocList *this; |
167 |
int amount = 0; |
|
168 |
int n = 0; |
|
3320 | 169 |
|
6459 | 170 |
for (this=mallocList; this; this=this->next) { |
171 |
n++; |
|
172 |
amount += this->size; |
|
173 |
} |
|
174 |
printf("EXTBYTES [info]: allocated %d blocks with %d bytes overall\n", n, amount); |
|
3320 | 175 |
} |
176 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
177 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
178 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
179 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
180 |
!ExternalBytes class methodsFor:'documentation'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
181 |
|
6459 | 182 |
copyright |
183 |
" |
|
184 |
COPYRIGHT (c) 1993 by Claus Gittinger |
|
185 |
All Rights Reserved |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
186 |
|
6459 | 187 |
This software is furnished under a license and may be used |
188 |
only in accordance with the terms of that license and with the |
|
189 |
inclusion of the above copyright notice. This software may not |
|
190 |
be provided or otherwise made available to, or used by, any |
|
191 |
other person. No title to or ownership of the software is |
|
192 |
hereby transferred. |
|
193 |
" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
194 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
195 |
|
6459 | 196 |
documentation |
197 |
" |
|
198 |
This class provides access to any memory in the system. Its main purpose |
|
199 |
is to provide a baseclass for objects referencing structured external data. |
|
200 |
Normally, instances are created by primitive code which wants to pass C-data |
|
201 |
to Smalltalk AND grants smalltalk access to individual bytes afterwards. |
|
202 |
Primitives which do not want to grant this access should return instances of |
|
203 |
ExternalAddress. See more info there. Also, have a look at ExternalFunction |
|
204 |
which is another similar class, but specialized to represent callable C-functions. |
|
205 |
||
206 |
Since the memory address of an instance stays fixed (once allocated), |
|
207 |
it can also be used to share data with external C-parts |
|
208 |
(which are not prepared for objects to change their address). |
|
209 |
||
210 |
Use with great care - access is not always checked for out-of-bounds |
|
211 |
or valid addresses. |
|
212 |
||
213 |
Since the data is allocated outside the garbage collected smalltalk space, |
|
214 |
its address stays fix. Thus, it can be passed to external C-functions without |
|
215 |
any danger. However, you have to take care for freeing the memory yourself. |
|
216 |
||
217 |
To help in avoiding memory bugs, instances created with #new: are |
|
218 |
registered in a local classvar and deregistered when the underlying memory |
|
219 |
is explicitely freed. Since a life reference (from that classvar) exists, |
|
220 |
the garbage collector will never find these to be reclaimable, and the |
|
221 |
underlying memory stays allocated (at a fix address) forever. |
|
222 |
To release the memory, either #free it or #unprotect it. |
|
223 |
The first will immediately release the memory, while the second will delay |
|
224 |
freeing until the next garbage collect occurs. |
|
225 |
||
226 |
If you need memory which is automatically freed, create |
|
227 |
the instance via #unprotectedNew: right away; the underlying malloced-memory |
|
228 |
will be released as soon as no smalltalk reference to the ExtBytes object |
|
229 |
exists any more (however, you have to know for sure, that no C-references |
|
230 |
exist to this memory). |
|
231 |
||
232 |
To release all memory call #releaseAllMemory which simply sets the |
|
233 |
AllocatedInstances class variable to nil (thus releasing those refs). |
|
234 |
||
235 |
Example (automatic freeing as soon as ref to buffer is gone): |
|
236 |
|buffer| |
|
237 |
||
238 |
buffer := ExternalBytes unprotectedNew:100. |
|
239 |
... |
|
240 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
241 |
|
6459 | 242 |
Example (manual freeing - never freed, if ref to buffer is gone): |
243 |
|buffer| |
|
244 |
||
245 |
buffer := ExternalBytes new:100. |
|
246 |
... |
|
247 |
buffer free |
|
248 |
||
249 |
||
250 |
Example (delayed automatic freeing as soon as ref to buffer is gone): |
|
251 |
|buffer| |
|
252 |
||
253 |
buffer := ExternalBytes new:100. |
|
254 |
... |
|
255 |
buffer unregister |
|
256 |
||
257 |
This class only supports unstructured external data |
|
258 |
- see the companion class ExternalStructure for more. |
|
259 |
||
260 |
Notice: support for external data is still being developed - |
|
261 |
a parser for C structure syntax and typedefs is on the way, |
|
262 |
making shared data with C programs much easier in the future. |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
263 |
|
6459 | 264 |
Also notice, that this class may not be available or behave different |
265 |
in other smalltalk systems, making code using it very unportable. |
|
266 |
It is provided for C interfacing only. |
|
267 |
||
268 |
Finally note, that ST/X's memory system is much faster than malloc/free |
|
269 |
in the normal case - especially for short term temporary objects, |
|
270 |
automatically reclaimed object memory is about 5-10 times faster than |
|
271 |
malloc/free. |
|
272 |
Things may be different for huge byte-valued objects, which are to be |
|
273 |
reclaimed by the oldspace colletor. |
|
274 |
Anyway, for portability, we strongly warn from using this as a substitute |
|
275 |
for byteArrays; it is meant for shared data with external C-functions ONLY. |
|
276 |
||
277 |
Debugging: |
|
278 |
since all manual memory systems are subject of obscure errors, |
|
279 |
you may want to turn malloc-tracing on; this traces all allocations/frees |
|
280 |
done here. To do this, evaluate: 'ExternalBytes mallocTrace:true'. |
|
281 |
||
282 |
In addition, you may turn on full debugging (with 'ExternalBytes mallocDebug:true'); |
|
283 |
if turned on, all malloc/realloc requests are remembered and later free / realloc |
|
284 |
requests validated against this list (i.e. to detect freeing unallocated chunks). |
|
285 |
||
286 |
To benefit from this in C-code, we recommend you use __stx_malloc() / __stx_free() |
|
287 |
instead of malloc() / free(). To do so, redefine them in a header file (or cc comand line) |
|
6242 | 288 |
and recompile your external c-libraries with this. |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
289 |
|
6242 | 290 |
I used this here to find memory leaks in the Xt libraries (there are still some in |
291 |
the HTML widget ...). If mallocDebug is on, #dumpMallocChunks will print out what is |
|
292 |
leftOver. This may help to find trouble spots in your C-code. |
|
1286 | 293 |
|
294 |
[author:] |
|
6242 | 295 |
Claus Gittinger |
1317 | 296 |
|
297 |
[see also:] |
|
6242 | 298 |
ExternalAddress ExternalFunction |
299 |
ByteArray |
|
300 |
( how to write primitive code :html: programming/primitive.html ) |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
301 |
" |
6459 | 302 |
! |
303 |
||
304 |
examples |
|
305 |
" |
|
306 |
These examples below are not directly executable; |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
307 |
some require primitive code to be compiled, or are simply given as sceletton. |
6459 | 308 |
Notice, that in C, indexing is 0-based, while in Smalltalk, indices start |
309 |
at 1. |
|
310 |
||
311 |
allocating memory in ST, passing it to C: |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
312 |
|
6459 | 313 |
in smalltalk: |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
314 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
315 |
bytes := ExternalBytes new:100. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
316 |
... |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
317 |
|
6459 | 318 |
in C (assuming that the bytes-object has been passed): |
319 |
||
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
320 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
321 |
char *bytePtr; |
6459 | 322 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
323 |
bytePtr = (char *)(__externalBytesAddress(bytes)); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
324 |
if (bytePtr) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
325 |
... do something with bytes at bytePtr ... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
326 |
} |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
327 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
328 |
freeing (in ST): |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
329 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
330 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
331 |
bytes free. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
332 |
... |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
333 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
334 |
allocating memory in C, passing it to ST: |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
335 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
336 |
in C: |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
337 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
338 |
char *bytePtr; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
339 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
340 |
bytePtr = (char *)(malloc(100)); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
341 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
342 |
RETURN (__MKEXTERNALBYTES(bytePtr)); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
343 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
344 |
in Smalltalk (extracting bytes, integers or strings): |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
345 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
346 |
byteVal := bytes byteAt:1. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
347 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
348 |
intVal := bytes doubleWordAt:1 MSB:true. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
349 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
350 |
string := bytes stringAt:20. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
351 |
... |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
352 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
353 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
354 |
|data bytes2| |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
355 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
356 |
data := #[0 1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1 0] copy. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
357 |
bytes2 := ExternalBytes new:30. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
358 |
bytes2 replaceBytesFrom:1 to:20 with:data startingAt:1. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
359 |
data replaceBytesFrom:2 to:20 with:bytes2 startingAt:1. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
360 |
bytes2 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
361 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
362 |
|data bytes1 bytes2| |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
363 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
364 |
data := #[0 1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1 0]. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
365 |
bytes1 := ExternalBytes new:30. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
366 |
bytes2 := ExternalBytes new:30. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
367 |
bytes1 replaceBytesFrom:1 to:20 with:data startingAt:1. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
368 |
bytes2 atAllPut:99. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
369 |
bytes2 replaceBytesFrom:2 to:21 with:bytes1 startingAt:1. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
370 |
bytes2 asByteArray |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
371 |
|
7192
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
372 |
|data1 bytes1 data2| |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
373 |
|
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
374 |
data1 := #[0 1 2 3 4 5 6 7 8 9 9 8 7 6 5 4 3 2 1 0]. |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
375 |
bytes1 := ExternalBytes new:30. |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
376 |
bytes1 replaceBytesFrom:1 to:20 with:data1 startingAt:1. |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
377 |
|
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
378 |
data2 := ByteArray new:30 withAll:99. |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
379 |
data2 replaceBytesFrom:2 to:21 with:bytes1 startingAt:1. |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
380 |
data2 |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
381 |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
382 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
383 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
384 |
|
6459 | 385 |
!ExternalBytes class methodsFor:'initialization'! |
386 |
||
387 |
initialize |
|
388 |
Lobby isNil ifTrue:[ |
|
389 |
Lobby := Registry new. |
|
390 |
AccessLock := Semaphore forMutualExclusion. |
|
391 |
] |
|
392 |
! ! |
|
393 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
394 |
!ExternalBytes class methodsFor:'instance creation'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
395 |
|
6459 | 396 |
address:aNumber |
397 |
"return a new ExternalBytes object to access bytes starting at aNumber. |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
398 |
The memory at aNumber has been allocated elsewhere. The size is not known, |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
399 |
therefore byte accesses will NOT be checked for valid index. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
400 |
Use this, if you get a pointer from some external source (such as a |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
401 |
C-callBack function) and you have to extract bytes from that. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
402 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
403 |
DANGER ALERT: this method allows very bad things to be done to the |
6242 | 404 |
system - use with GREAT care (better: do not use it)" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
405 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
406 |
^ self basicNew setAddress:aNumber size:nil |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
407 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
408 |
|
6459 | 409 |
address:aNumber size:size |
410 |
"return a new ExternalBytes object to access bytes starting at aNumber. |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
411 |
The memory at aNumber has been allocated elsewhere. The size is known, |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
412 |
which allows byte accesses to be checked for valid index. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
413 |
Use this, if you get a pointer to a structure from some external source |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
414 |
(such as a C-callBack function) and you have to extract things from that. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
415 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
416 |
DANGER ALERT: this method allows very bad things to be done to the |
6242 | 417 |
system - use with GREAT care (better: do not use it)" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
418 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
419 |
^ self basicNew setAddress:aNumber size:size |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
420 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
421 |
|
6459 | 422 |
new:numberOfBytes |
423 |
"allocate some memory usable for data; |
|
424 |
the memory is not controlled by the garbage collector. |
|
425 |
Return a corresponding ExternalBytes object or raise MallocFailure (if malloc fails). |
|
426 |
||
427 |
Use this, if you have to pass a block of bytes to some |
|
428 |
external destination (such as a C function) which does not copy the |
|
429 |
data, but instead keeps a reference to it. For example, many functions |
|
430 |
which expect strings simply keep a ref to the passed string - for those, |
|
431 |
an ST/X string-pointer is not the right thing to pass, since ST/X objects |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
432 |
may change their address. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
433 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
434 |
DANGER ALERT: the memory is NOT automatically freed until it is either |
6445 | 435 |
MANUALLY freed (see #free) or the returned externalBytes object |
436 |
is unprotected or the classes releaseAllMemory method is called." |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
437 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
438 |
|newInst| |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
439 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
440 |
newInst := self unprotectedNew:numberOfBytes. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
441 |
newInst protectFromGC. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
442 |
^ newInst |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
443 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
444 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
445 |
|bytes| |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
446 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
447 |
bytes := ExternalBytes new:100. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
448 |
bytes wordAt:1 put:1. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
449 |
bytes doubleWordAt:3 put:16r12345678. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
450 |
bytes inspect |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
451 |
" |
6459 | 452 |
! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
453 |
|
6459 | 454 |
unprotectedNew:numberOfBytes |
455 |
"allocate some memory usable for data; |
|
456 |
the memory is under the control of the garbage collector. |
|
457 |
Return a corresponding ExternalBytes object or raise MallocFailure (if malloc fails). |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
458 |
|
6459 | 459 |
DANGER ALERT: the memory block as allocated will be automatically freed |
460 |
as soon as the reference to the returned externalBytes object |
|
6445 | 461 |
is gone (by the next garbage collect). |
462 |
If the memory has been passed to a C-function which |
|
463 |
remembers this pointer, bad things may happen ...." |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
464 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
465 |
|newInst| |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
466 |
|
6444 | 467 |
newInst := self basicNew allocateBytes:numberOfBytes. |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
468 |
Lobby register:newInst. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
469 |
^ newInst |
6444 | 470 |
|
471 |
" |
|
472 |
|bytes| |
|
473 |
||
474 |
bytes := ExternalBytes unprotectedNew:100. |
|
475 |
bytes wordAt:1 put:1. |
|
476 |
bytes doubleWordAt:3 put:16r12345678. |
|
477 |
bytes inspect |
|
478 |
" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
479 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
480 |
|
6459 | 481 |
!ExternalBytes class methodsFor:'instance release'! |
482 |
||
483 |
releaseAllMemory |
|
484 |
AllocatedInstances := nil |
|
485 |
" |
|
486 |
... the next GC will get 'em |
|
487 |
" |
|
488 |
! ! |
|
489 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
490 |
!ExternalBytes class methodsFor:'malloc debug'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
491 |
|
6459 | 492 |
dumpMallocChunks |
493 |
%{ /* NOCONTEXT */ |
|
494 |
struct mallocList *entry; |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
495 |
|
6459 | 496 |
for (entry = mallocList; entry; entry=entry->next) { |
497 |
#ifdef alpha64 |
|
498 |
printf(" %016lx (%d)\n", entry->chunk, entry->size); |
|
499 |
#else |
|
500 |
printf(" %08x (%d)\n", entry->chunk, entry->size); |
|
501 |
#endif |
|
502 |
} |
|
503 |
%} |
|
3321 | 504 |
" |
6459 | 505 |
self dumpMallocChunks |
3321 | 506 |
" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
507 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
508 |
|
6459 | 509 |
freeAllMallocChunks |
510 |
"free all stx_malloc'd memory. Be careful, this does no validation at all; |
|
511 |
It simply walks through all chunks and frees them unconditionally. |
|
512 |
This may be helpful during debugging memory-leaks, to release memory which |
|
513 |
was not correctly freed by C-code. Howeve, only memory which was allocated |
|
514 |
by __stx_malloc() is freed here - so you better compile your primitive code with |
|
515 |
malloc redefined to stx_malloc. |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
516 |
Also, mallocDebug has to be on to do this." |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
517 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
518 |
"first free my own memory ..." |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
519 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
520 |
self releaseAllMemory. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
521 |
ObjectMemory garbageCollect. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
522 |
%{ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
523 |
struct mallocList *entry; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
524 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
525 |
while ((entry = mallocList) != (struct mallocList *)0) { |
6242 | 526 |
if (@global(TraceMalloc) == true ) { |
2788 | 527 |
#ifdef alpha64 |
6242 | 528 |
printf("EXTBYTES [info]: **** forced free of %016lx (%d)\n", entry->chunk, entry->size); |
2779 | 529 |
#else |
6242 | 530 |
printf("EXTBYTES [info]: **** forced free of %08x (%d)\n", entry->chunk, entry->size); |
2779 | 531 |
#endif |
6242 | 532 |
} |
533 |
__stx_free(entry->chunk); |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
534 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
535 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
536 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
537 |
|
6459 | 538 |
mallocDebug:aBoolean |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
539 |
DebugMalloc := aBoolean |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
540 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
541 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
542 |
ExternalBytes mallocDebug:true |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
543 |
ExternalBytes mallocDebug:false |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
544 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
545 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
546 |
|
6459 | 547 |
mallocStatistics |
548 |
%{ |
|
549 |
__stx_mallocStatistics(); |
|
550 |
%} |
|
551 |
" |
|
552 |
self mallocStatistics |
|
3486 | 553 |
" |
554 |
! |
|
555 |
||
6459 | 556 |
mallocTrace:aBoolean |
557 |
TraceMalloc := aBoolean |
|
558 |
||
559 |
" |
|
560 |
ExternalBytes mallocTrace:true |
|
561 |
ExternalBytes mallocTrace:false |
|
562 |
" |
|
563 |
! |
|
564 |
||
565 |
numberOfAllocatedChunks |
|
566 |
%{ /* NOCONTEXT */ |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
567 |
RETURN ( __MKSMALLINT(mallocCount) ); |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
568 |
%} |
3321 | 569 |
" |
570 |
self numberOfAllocatedChunks |
|
571 |
" |
|
6459 | 572 |
! ! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
573 |
|
6459 | 574 |
!ExternalBytes class methodsFor:'queries'! |
575 |
||
576 |
isBuiltInClass |
|
577 |
"return true if this class is known by the run-time-system. |
|
1267 | 578 |
Here, true is returned." |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
579 |
|
3553 | 580 |
^ self == ExternalBytes |
1267 | 581 |
|
3553 | 582 |
"Modified: / 11.6.1998 / 17:12:51 / cg" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
583 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
584 |
|
6459 | 585 |
sizeofDouble |
586 |
"return the number of bytes used by the machines native doubles" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
587 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
588 |
%{ /* NOCONTEXT */ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
589 |
RETURN (__MKSMALLINT( sizeof(double))); |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
590 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
591 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
592 |
ExternalBytes sizeofDouble |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
593 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
594 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
595 |
|
6459 | 596 |
sizeofFloat |
597 |
"return the number of bytes used by the machines native floats" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
598 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
599 |
%{ /* NOCONTEXT */ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
600 |
RETURN (__MKSMALLINT( sizeof(float))); |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
601 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
602 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
603 |
ExternalBytes sizeofFloat |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
604 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
605 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
606 |
|
6459 | 607 |
sizeofInt |
608 |
"return the number of bytes used by the machines native integer" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
609 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
610 |
%{ /* NOCONTEXT */ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
611 |
RETURN (__MKSMALLINT( sizeof(int))); |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
612 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
613 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
614 |
ExternalBytes sizeofInt |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
615 |
" |
6459 | 616 |
! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
617 |
|
6459 | 618 |
sizeofLong |
619 |
"return the number of bytes used by the machines native longs" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
620 |
|
6459 | 621 |
%{ /* NOCONTEXT */ |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
622 |
RETURN (__MKSMALLINT( sizeof(long))); |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
623 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
624 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
625 |
ExternalBytes sizeofLong |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
626 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
627 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
628 |
|
6459 | 629 |
sizeofPointer |
630 |
"return the number of bytes used by the machines native pointer" |
|
631 |
||
632 |
%{ /* NOCONTEXT */ |
|
633 |
RETURN (__MKSMALLINT( sizeof(char *))); |
|
634 |
%} |
|
635 |
" |
|
636 |
ExternalBytes sizeofPointer |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
637 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
638 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
639 |
|
6459 | 640 |
sizeofShort |
641 |
"return the number of bytes used by the machines native short" |
|
642 |
||
643 |
%{ /* NOCONTEXT */ |
|
644 |
RETURN (__MKSMALLINT( sizeof(short))); |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
645 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
646 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
647 |
ExternalBytes sizeofShort |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
648 |
" |
6459 | 649 |
! ! |
650 |
||
651 |
!ExternalBytes methodsFor:'accessing'! |
|
652 |
||
653 |
address |
|
654 |
"return the start address as an integer" |
|
655 |
||
656 |
%{ /* NOCONTEXT */ |
|
657 |
||
658 |
int addr; |
|
659 |
||
660 |
if (__INST(address_) != nil) { |
|
661 |
addr = (INT)__INST(address_); |
|
662 |
if (addr <= _MAX_INT) { |
|
663 |
RETURN ( __MKSMALLINT(addr) ); |
|
664 |
} |
|
665 |
RETURN ( __MKUINT(addr)); |
|
666 |
} |
|
667 |
%}. |
|
668 |
^ nil |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
669 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
670 |
|
6459 | 671 |
basicAt:index |
672 |
"return the byte at index, anInteger; |
|
673 |
Indices are 1-based, therefore |
|
674 |
this is the byte at (address + index - 1)" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
675 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
676 |
%{ /* NOCONTEXT */ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
677 |
|
1822 | 678 |
unsigned char *cp = (unsigned char *)(__INST(address_)); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
679 |
int idx; |
1997 | 680 |
OBJ sz; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
681 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
682 |
if (cp && __isSmallInteger(index)) { |
6242 | 683 |
idx = __intVal(index); |
684 |
if (idx > 0) { |
|
685 |
if (((sz = __INST(size)) == nil) |
|
686 |
|| (__intVal(sz) >= idx)) { |
|
687 |
cp = cp + idx - 1; |
|
688 |
RETURN ( __MKSMALLINT(*cp) ); |
|
689 |
} |
|
690 |
} |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
691 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
692 |
%}. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
693 |
(size notNil and:[self address notNil]) ifTrue:[ |
6242 | 694 |
^ self subscriptBoundsError:index |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
695 |
]. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
696 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
697 |
invalid index or unallocated |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
698 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
699 |
self primitiveFailed |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
700 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
701 |
|
6459 | 702 |
basicAt:index put:value |
703 |
"set the byte at index, anInteger to value which must be 0..255. |
|
704 |
Returns value (sigh). |
|
705 |
Indices are 1-based, therefore |
|
706 |
this is the byte at (address + index - 1)" |
|
707 |
||
708 |
%{ /* NOCONTEXT */ |
|
709 |
||
710 |
unsigned char *cp = (unsigned char *)(__INST(address_)); |
|
711 |
int val; |
|
712 |
int idx; |
|
713 |
OBJ sz; |
|
714 |
||
715 |
if (__isSmallInteger(value)) { |
|
716 |
val = __smallIntegerVal(value); |
|
717 |
} else if (__isCharacter(value)) { |
|
718 |
val = __smallIntegerVal(_characterVal(value)); |
|
719 |
} else |
|
720 |
goto badArg; |
|
721 |
||
722 |
if (cp && __isSmallInteger(index)) { |
|
723 |
idx = __intVal(index); |
|
724 |
if (idx > 0) { |
|
6445 | 725 |
if (((sz = __INST(size)) == nil) |
726 |
|| (__intVal(sz) >= idx)) { |
|
727 |
if ((val & ~0xFF) == 0) /* i.e. (val >= 0) && (val <= 255) */ { |
|
728 |
cp[idx-1] = val; |
|
729 |
RETURN ( value ); |
|
730 |
} |
|
731 |
} |
|
732 |
} |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
733 |
} |
6302
32ede83e77e5
allow for character arg in #at:put:
Claus Gittinger <cg@exept.de>
parents:
6242
diff
changeset
|
734 |
|
32ede83e77e5
allow for character arg in #at:put:
Claus Gittinger <cg@exept.de>
parents:
6242
diff
changeset
|
735 |
badArg: ; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
736 |
%}. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
737 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
738 |
(size notNil and:[self address notNil]) ifTrue:[ |
6445 | 739 |
(index between:1 and:size) ifTrue:[ |
740 |
^ ElementOutOfBoundsSignal raise |
|
741 |
]. |
|
742 |
^ self subscriptBoundsError:index |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
743 |
]. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
744 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
745 |
invalid index, invalid value or unallocated |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
746 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
747 |
self primitiveFailed |
1220 | 748 |
|
749 |
"Modified: 19.4.1996 / 11:15:05 / cg" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
750 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
751 |
|
6459 | 752 |
byteAt:index |
753 |
"return the unsigned byte at index, anInteger. |
|
754 |
Indices are 1-based, therefore |
|
755 |
this is the byte at (address + index - 1)" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
756 |
|
6459 | 757 |
^ self basicAt:index |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
758 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
759 |
|
6459 | 760 |
byteAt:index put:aByteValuedInteger |
761 |
"set the byte at index. |
|
762 |
Indices are 1-based, therefore |
|
763 |
this is the byte at (address + index - 1)" |
|
764 |
||
765 |
^ self basicAt:index put:aByteValuedInteger |
|
766 |
! |
|
767 |
||
768 |
instVarAt:index |
|
769 |
"redefined to suppress direct access to my address, which is a non-object" |
|
770 |
||
771 |
index == 1 ifTrue:[ |
|
772 |
^ self address |
|
6458 | 773 |
]. |
6459 | 774 |
^ super instVarAt:index |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
775 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
776 |
|
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
777 |
!ExternalBytes methodsFor:'converting'! |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
778 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
779 |
asExternalAddress |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
780 |
"return the start address as an external address" |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
781 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
782 |
%{ /* NOCONTEXT */ |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
783 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
784 |
RETURN(__MKEXTERNALADDRESS(__INST(address_))); |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
785 |
%}. |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
786 |
! |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
787 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
788 |
asExternalBytes |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
789 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
790 |
^ self |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
791 |
! ! |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
792 |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
793 |
!ExternalBytes methodsFor:'filling & replacing'! |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
794 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
795 |
replaceBytesFrom:start to:stop with:aCollection startingAt:repStart |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
796 |
"replace elements from another collection, which must be a ByteArray- |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
797 |
like collection. |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
798 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
799 |
Notice: This operation modifies the receiver, NOT a copy; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
800 |
therefore the change may affect all others referencing the receiver." |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
801 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
802 |
%{ /* NOCONTEXT */ |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
803 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
804 |
int nIndex, repNIndex; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
805 |
int startIndex, stopIndex; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
806 |
REGISTER unsigned char *src; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
807 |
REGISTER int repStartIndex; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
808 |
int repStopIndex, count; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
809 |
REGISTER unsigned char *dst; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
810 |
OBJ cls; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
811 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
812 |
if ((__isBytes(aCollection) || __isExternalBytesLike(aCollection)) |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
813 |
&& __bothSmallInteger(start, stop) |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
814 |
&& __isSmallInteger(repStart)) { |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
815 |
startIndex = __intVal(start) - 1; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
816 |
if (startIndex >= 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
817 |
dst = (unsigned char *)__INST(address_) + startIndex; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
818 |
nIndex = __smallIntegerVal(__INST(size)); |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
819 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
820 |
stopIndex = __intVal(stop) - 1; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
821 |
count = stopIndex - startIndex + 1; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
822 |
if (count == 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
823 |
RETURN ( self ); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
824 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
825 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
826 |
if ((count > 0) && (stopIndex < nIndex)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
827 |
repStartIndex = __intVal(repStart) - 1; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
828 |
if (repStartIndex >= 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
829 |
if (__isExternalBytesLike(aCollection)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
830 |
OBJ sz; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
831 |
|
7386
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
832 |
src = __externalBytesVal(aCollection); |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
833 |
if (src == 0) goto fallBack; |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
834 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
835 |
sz = __externalBytesSize(aCollection); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
836 |
if (__isSmallInteger(sz)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
837 |
repNIndex = __smallIntegerVal(sz); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
838 |
} else { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
839 |
repNIndex = -1; /* unknown */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
840 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
841 |
src = src + repStartIndex; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
842 |
} else { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
843 |
repNIndex = __qSize(aCollection) - OHDR_SIZE; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
844 |
src = __byteArrayVal(aCollection) + repStartIndex; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
845 |
if ((cls = __qClass(aCollection)) != @global(ByteArray)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
846 |
int nInst; |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
847 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
848 |
nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars)); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
849 |
src += nInst; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
850 |
repNIndex -= nInst; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
851 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
852 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
853 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
854 |
repStopIndex = repStartIndex + (stopIndex - startIndex); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
855 |
if (repStopIndex < repNIndex) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
856 |
if (aCollection == self) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
857 |
/* take care of overlapping copy */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
858 |
if (src < dst) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
859 |
/* must do a reverse copy */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
860 |
src += count; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
861 |
dst += count; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
862 |
while (count-- > 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
863 |
*--dst = *--src; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
864 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
865 |
RETURN ( self ); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
866 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
867 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
868 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
869 |
#ifdef memcpy4 |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
870 |
if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
871 |
int nW; |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
872 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
873 |
/* copy unaligned part */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
874 |
while (count && ((unsigned INT)src & 3)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
875 |
*dst++ = *src++; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
876 |
count--; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
877 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
878 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
879 |
if (count > 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
880 |
/* copy aligned part */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
881 |
nW = count >> 2; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
882 |
memcpy4(dst, src, nW); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
883 |
if ((count = count & 3) != 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
884 |
/* copy any remaining part */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
885 |
src += (nW<<2); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
886 |
dst += (nW<<2); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
887 |
while (count--) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
888 |
*dst++ = *src++; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
889 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
890 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
891 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
892 |
RETURN ( self ); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
893 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
894 |
#else |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
895 |
# ifdef alpha64 |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
896 |
if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
897 |
/* copy unaligned part */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
898 |
while (count && ((unsigned INT)src & 7)) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
899 |
*dst++ = *src++; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
900 |
count--; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
901 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
902 |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
903 |
/* copy aligned part */ |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
904 |
while (count >= 8) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
905 |
((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0]; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
906 |
dst += 8; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
907 |
src += 8; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
908 |
count -= 8; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
909 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
910 |
while (count--) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
911 |
*dst++ = *src++; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
912 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
913 |
RETURN ( self ); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
914 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
915 |
# endif /* alpha64 */ |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
916 |
#endif /* memcpy4 */ |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
917 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
918 |
#ifdef FAST_MEMCPY |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
919 |
memcpy(dst, src, count); |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
920 |
#else |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
921 |
# ifdef UNROLL_LOOPS |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
922 |
while (count >= 8) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
923 |
dst[0] = src[0]; dst[1] = src[1]; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
924 |
dst[2] = src[2]; dst[3] = src[3]; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
925 |
dst[4] = src[4]; dst[5] = src[5]; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
926 |
dst[6] = src[6]; dst[7] = src[7]; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
927 |
dst += 8; src += 8; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
928 |
count -= 8; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
929 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
930 |
# endif /* UNROLL_LOOPS */ |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
931 |
while (count-- > 0) { |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
932 |
*dst++ = *src++; |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
933 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
934 |
#endif |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
935 |
RETURN ( self ); |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
936 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
937 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
938 |
} |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
939 |
} |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
940 |
} |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
941 |
fallBack: ; |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
942 |
%}. |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
943 |
" |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
944 |
fall back for the error report if any index is invalid |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
945 |
" |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
946 |
^ super replaceBytesFrom:start to:stop with:aCollection startingAt:repStart |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
947 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
948 |
" |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
949 |
(ExternalBytes unprotectedNew:16) |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
950 |
replaceFrom:1 to:8 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
951 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
952 |
startingAt:1 |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
953 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
954 |
(ExternalBytes unprotectedNew:16) |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
955 |
replaceFrom:3 to:10 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
956 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
957 |
startingAt:4 |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
958 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
959 |
(ExternalBytes unprotectedNew:16) |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
960 |
replaceFrom:3 to:4 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
961 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
962 |
startingAt:1 |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
963 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
964 |
(ExternalBytes unprotectedNew:16) |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
965 |
replaceFrom:0 to:9 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
966 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
967 |
startingAt:1 |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
968 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
969 |
(ExternalBytes unprotectedNew:16) |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
970 |
replaceFrom:1 to:10 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
971 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
972 |
startingAt:0 |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
973 |
" |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
974 |
! ! |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
975 |
|
6444 | 976 |
!ExternalBytes methodsFor:'finalization'! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
977 |
|
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
978 |
executor |
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
979 |
"redefined to return a lightweight copy |
7184 | 980 |
- all we need is the memory handle and the size." |
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
981 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
982 |
%{ /* NOCONTEXT */ |
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
983 |
|
7386
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
984 |
OBJ theCopy, cls; |
7184 | 985 |
|
7855
27f64d1beaa1
Have to protect self, otherwise bad things happen in the VM.
Stefan Vogel <sv@exept.de>
parents:
7386
diff
changeset
|
986 |
__PROTECT__(self); |
7184 | 987 |
theCopy = __MKEXTERNALBYTES_N(__INST(address_), __smallIntegerVal(__INST(size))); |
7855
27f64d1beaa1
Have to protect self, otherwise bad things happen in the VM.
Stefan Vogel <sv@exept.de>
parents:
7386
diff
changeset
|
988 |
__UNPROTECT__(self); |
7386
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
989 |
__InstPtr(theCopy)->o_class = cls = __InstPtr(self)->o_class; |
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
990 |
__STORE(theCopy, cls); |
7184 | 991 |
RETURN (theCopy); |
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
992 |
%} |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
993 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
994 |
" |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
995 |
(ExternalBytes unprotectedNew:10) executor |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
996 |
" |
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
997 |
! |
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
998 |
|
6462
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
999 |
finalizationLobby |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1000 |
"answer the registry used for finalization. |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1001 |
ExternalBytes have their own Registry" |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1002 |
|
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1003 |
^ Lobby |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1004 |
! |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1005 |
|
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
1006 |
finalize |
2779 | 1007 |
"some ExternalBytes object was finalized; |
1008 |
free the associated heap memory with it" |
|
1009 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1010 |
%{ /* NOCONTEXT */ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1011 |
|
6457 | 1012 |
char *mem = (char *)(__INST(address_)); |
1013 |
if (mem && (OBJ)mem != nil) { |
|
6459 | 1014 |
__stx_free(mem); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1015 |
} |
1133 | 1016 |
__INST(address_) = __INST(size) = nil; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1017 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1018 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1019 |
|
6444 | 1020 |
!ExternalBytes methodsFor:'freeing'! |
1021 |
||
6459 | 1022 |
free |
1023 |
"free a previously allocated piece of memory - be very careful, there |
|
1024 |
are no checks done here. All dangers you usually have with malloc/free |
|
1025 |
are present here ..." |
|
1026 |
||
1027 |
"at least, we check for double freeing the same chunk" |
|
1028 |
self address isNil ifTrue:[ |
|
1029 |
self error:'freeing memory twice'. |
|
1030 |
^ self |
|
1031 |
]. |
|
1032 |
Lobby unregister:self. |
|
1033 |
self finalize. "/ does what we need here .. |
|
1034 |
self unprotectFromGC |
|
7184 | 1035 |
! |
1036 |
||
1037 |
register |
|
1038 |
"register the receiver to be automatically finalized by the GC" |
|
1039 |
||
1040 |
Lobby register:self. |
|
6444 | 1041 |
! ! |
1042 |
||
6443 | 1043 |
!ExternalBytes methodsFor:'pointer arithmethic'! |
1044 |
||
6502
87f587d1542e
rename #from:to to #referenceToBytesFrom:to
Stefan Vogel <sv@exept.de>
parents:
6491
diff
changeset
|
1045 |
referenceToBytesFrom:start to:stop |
6459 | 1046 |
"answer a new ExternalBytes referencing a range within the receiver. |
6502
87f587d1542e
rename #from:to to #referenceToBytesFrom:to
Stefan Vogel <sv@exept.de>
parents:
6491
diff
changeset
|
1047 |
BE CAREFUL: after the receiver has been freed, the new ExternalBytes |
6459 | 1048 |
contents is undefined" |
1049 |
||
1050 |
%{ /* NOCONTEXT */ |
|
1051 |
||
6471 | 1052 |
char *addr; |
6459 | 1053 |
int size; |
1054 |
int __start, __stop; |
|
1055 |
||
1056 |
if (__bothSmallInteger(start, stop) && __INST(address_) != nil) { |
|
6503 | 1057 |
__start = __smallIntegerVal(start); |
1058 |
__stop = __smallIntegerVal(stop); |
|
1059 |
if (__start > 0 && __start <= __stop && __stop <= __smallIntegerVal(__INST(size))) { |
|
1060 |
addr = (char *)(__INST(address_)) + (__start - 1); |
|
1061 |
size = __stop - __start + 1; |
|
1062 |
RETURN( __MKEXTERNALBYTES_N(addr, size) ); |
|
1063 |
} |
|
6459 | 1064 |
} |
1065 |
%}. |
|
1066 |
^ self primitiveFailed |
|
6458 | 1067 |
! ! |
6443 | 1068 |
|
6458 | 1069 |
!ExternalBytes methodsFor:'printing & storing'! |
6443 | 1070 |
|
6459 | 1071 |
displayString |
1072 |
"return a printed representation of the receiver for displaying" |
|
1073 |
||
1074 |
|addr addrString| |
|
6443 | 1075 |
|
6459 | 1076 |
(addr := self address) isNil ifTrue:[ |
6503 | 1077 |
addrString := '[free]' |
6459 | 1078 |
] ifFalse:[ |
6503 | 1079 |
addrString := '[', size printString, ' at:' , (self address printStringRadix:16), ']' |
6459 | 1080 |
]. |
1081 |
^ self class name , addrString |
|
1082 |
||
1083 |
"Modified: / 24.2.2000 / 19:02:19 / cg" |
|
6458 | 1084 |
! ! |
1085 |
||
7257 | 1086 |
!ExternalBytes methodsFor:'private-accessing'! |
6458 | 1087 |
|
6459 | 1088 |
setAddress:aNumber size:sz |
1089 |
"set the start address and size" |
|
1090 |
||
1091 |
%{ /* NOCONTEXT */ |
|
1092 |
if (__INST(address_) == nil) { |
|
1093 |
if (aNumber == nil) { |
|
1094 |
__INST(address_) = nil; |
|
1095 |
} else { |
|
1096 |
if (__isSmallInteger(aNumber)) { |
|
1097 |
__INST(address_) = (OBJ) __intVal(aNumber); |
|
1098 |
} else if(__isInteger(aNumber)) { |
|
1099 |
__INST(address_) = (OBJ) __unsignedLongIntVal(aNumber); |
|
1100 |
} else if(__isExternalAddress(aNumber)) { |
|
1101 |
__INST(address_) = __externalAddressVal(aNumber); |
|
1102 |
} |
|
6445 | 1103 |
} |
6459 | 1104 |
__INST(size) = sz; |
1105 |
RETURN (self); |
|
6443 | 1106 |
} |
1107 |
%}. |
|
6459 | 1108 |
^ self error:'cannot change address' |
8288 | 1109 |
! |
1110 |
||
1111 |
setSize:sz |
|
1112 |
"set the size - warning: dangerous if wrong" |
|
1113 |
||
1114 |
size := sz |
|
6443 | 1115 |
! ! |
1116 |
||
7257 | 1117 |
!ExternalBytes methodsFor:'private-allocation'! |
6444 | 1118 |
|
1119 |
allocateBytes:numberOfBytes |
|
1120 |
"allocate (malloc) numberOfBytes. |
|
1121 |
Fail if already allocated. |
|
1122 |
Raise MallocFailure if malloc fails to allocate enough memory" |
|
1123 |
||
1124 |
|mallocFailure| |
|
1125 |
||
6457 | 1126 |
%{ |
6444 | 1127 |
char *space; |
1128 |
unsigned int nBytes; |
|
1129 |
char *__stx_malloc(); |
|
1130 |
||
1131 |
/* |
|
1132 |
* Fail if already allocated |
|
1133 |
*/ |
|
1134 |
||
1135 |
if (__INST(address_) == nil && __isSmallInteger(numberOfBytes)) { |
|
6503 | 1136 |
nBytes = __smallIntegerVal(numberOfBytes); |
1137 |
if (nBytes > 0) { |
|
1138 |
space = __stx_malloc(nBytes); |
|
1139 |
if (space) { |
|
1140 |
__INST(address_) = (OBJ)space; |
|
1141 |
__INST(size) = numberOfBytes; |
|
1142 |
RETURN(self); |
|
1143 |
} else { |
|
1144 |
mallocFailure = true; |
|
1145 |
} |
|
1146 |
} |
|
6444 | 1147 |
} |
1148 |
%}. |
|
1149 |
mallocFailure == true ifTrue:[ |
|
6503 | 1150 |
^ MallocFailure raiseRequestWith:numberOfBytes. |
6444 | 1151 |
] ifFalse:[ |
6503 | 1152 |
self primitiveFailed. |
6444 | 1153 |
]. |
1154 |
! ! |
|
1155 |
||
5557 | 1156 |
!ExternalBytes methodsFor:'queries'! |
1157 |
||
6459 | 1158 |
basicSize |
1159 |
"we do not know how many bytes are valid" |
|
5557 | 1160 |
|
6459 | 1161 |
size isNil ifTrue:[^ 0]. |
1162 |
^ size |
|
6443 | 1163 |
! |
1164 |
||
6459 | 1165 |
species |
1166 |
"when copying, or concatenating, return instances of this class" |
|
1167 |
||
1168 |
^ ByteArray |
|
5557 | 1169 |
! ! |
1170 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1171 |
!ExternalBytes methodsFor:'registration'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1172 |
|
6459 | 1173 |
protectFromGC |
1174 |
"enter a reference to the receiver into the AllocatedInstances |
|
1175 |
class variable - this prevents it from ever being finalized by |
|
1176 |
the garbage collector, thus protecting the underlying memory." |
|
1177 |
||
1178 |
AccessLock critical:[ |
|
1179 |
AllocatedInstances isNil ifTrue:[ |
|
1180 |
AllocatedInstances := IdentitySet new |
|
1181 |
]. |
|
1182 |
AllocatedInstances add:self |
|
1183 |
] |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1184 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1185 |
|
6459 | 1186 |
unprotectFromGC |
1187 |
"remove the receiver from the AllocatedInstances |
|
1188 |
class variable - if there is no other reference to the receiver, |
|
1189 |
the next garbage collect will finalize the receiver and the underlying |
|
1190 |
memory be freed." |
|
1191 |
||
1192 |
AllocatedInstances notNil ifTrue:[ |
|
1193 |
AccessLock critical:[ |
|
1194 |
AllocatedInstances remove:self ifAbsent:nil |
|
1195 |
] |
|
1196 |
] |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1197 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1198 |
|
6457 | 1199 |
!ExternalBytes methodsFor:'resizing'! |
1200 |
||
1201 |
grow:numberOfBytes |
|
1202 |
"reallocate (realloc) numberOfBytes. |
|
1203 |
Raise MallocFailure if realloc fails to allocate enough memory" |
|
1204 |
||
1205 |
|mallocStatus| |
|
1206 |
||
1207 |
%{ |
|
1208 |
char *space, *prevSpace; |
|
1209 |
unsigned int nBytes; |
|
1210 |
char *__stx_realloc(); |
|
1211 |
||
1212 |
if (__isSmallInteger(numberOfBytes)) { |
|
6503 | 1213 |
nBytes = __smallIntegerVal(numberOfBytes); |
1214 |
if (nBytes > 0) { |
|
1215 |
prevSpace = (char *)__INST(address_); |
|
1216 |
if (prevSpace == (char *)nil) |
|
1217 |
prevSpace = 0; /* allocate from scratch */ |
|
1218 |
space = __stx_realloc(prevSpace, nBytes); |
|
1219 |
if (space) { |
|
1220 |
__INST(address_) = (OBJ)space; |
|
1221 |
__INST(size) = numberOfBytes; |
|
1222 |
if (space == prevSpace) { |
|
1223 |
/* same address, no re-registration */ |
|
1224 |
RETURN(self); |
|
1225 |
} |
|
1226 |
mallocStatus = true; |
|
1227 |
} else { |
|
1228 |
mallocStatus = false; |
|
1229 |
} |
|
1230 |
} |
|
6457 | 1231 |
} |
1232 |
%}. |
|
1233 |
mallocStatus == true ifTrue:[ |
|
6503 | 1234 |
Lobby registerChange:self. |
6457 | 1235 |
] ifFalse:[mallocStatus == false ifTrue:[ |
6503 | 1236 |
^ MallocFailure raiseRequestWith:numberOfBytes. |
6457 | 1237 |
] ifFalse:[ |
6503 | 1238 |
self primitiveFailed. |
6457 | 1239 |
]]. |
1240 |
! ! |
|
1241 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1242 |
!ExternalBytes class methodsFor:'documentation'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1243 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1244 |
version |
8288 | 1245 |
^ '$Header: /cvs/stx/stx/libbasic/ExternalBytes.st,v 1.56 2004-04-02 16:28:16 werner Exp $' |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1246 |
! ! |
7184 | 1247 |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1248 |
ExternalBytes initialize! |