author | Claus Gittinger <cg@exept.de> |
Mon, 16 Dec 2019 11:42:32 +0100 | |
changeset 25131 | ef5405956d85 |
parent 25005 | cfabf497d6d2 |
child 25332 | 524b4a68a681 |
permissions | -rw-r--r-- |
25005 | 1 |
"{ Encoding: utf8 }" |
2 |
||
6459 | 3 |
" |
4 |
COPYRIGHT (c) 1993 by Claus Gittinger |
|
5 |
All Rights Reserved |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
6 |
|
6459 | 7 |
This software is furnished under a license and may be used |
8 |
only in accordance with the terms of that license and with the |
|
9 |
inclusion of the above copyright notice. This software may not |
|
10 |
be provided or otherwise made available to, or used by, any |
|
11 |
other person. No title to or ownership of the software is |
|
12 |
hereby transferred. |
|
13 |
" |
|
5378 | 14 |
"{ Package: 'stx:libbasic' }" |
15 |
||
17627 | 16 |
"{ NameSpace: Smalltalk }" |
17 |
||
3208
2d71538b9fd5
now subclass of UIBytes - which contains common protocol
Claus Gittinger <cg@exept.de>
parents:
3206
diff
changeset
|
18 |
UninterpretedBytes subclass:#ExternalBytes |
3211
ef7a5411afa1
remove methods which are provided by my (new) superClass
Claus Gittinger <cg@exept.de>
parents:
3208
diff
changeset
|
19 |
instanceVariableNames:'address* size' |
21406 | 20 |
classVariableNames:'AllocatedInstances DebugMalloc Lobby TraceMalloc' |
3211
ef7a5411afa1
remove methods which are provided by my (new) superClass
Claus Gittinger <cg@exept.de>
parents:
3208
diff
changeset
|
21 |
poolDictionaries:'' |
ef7a5411afa1
remove methods which are provided by my (new) superClass
Claus Gittinger <cg@exept.de>
parents:
3208
diff
changeset
|
22 |
category:'System-Support' |
848
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 |
|
14749 | 25 |
!ExternalBytes primitiveDefinitions! |
26 |
%{ |
|
19376 | 27 |
#include <stdlib.h> |
28 |
#include <stdio.h> |
|
19392 | 29 |
// cg: not needed |
30 |
#if 0 |
|
31 |
# ifdef __osx__ |
|
32 |
# include <sys/malloc.h> |
|
33 |
# else |
|
34 |
# include <malloc.h> |
|
35 |
# endif |
|
36 |
#endif |
|
19376 | 37 |
|
38 |
extern char *__stx_malloc(size_t); |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
39 |
extern char *__stx_calloc(size_t, size_t); |
19376 | 40 |
extern char *__stx_realloc(char *, size_t); |
41 |
extern void __stx_free(char *); |
|
42 |
extern void __stx_mallocStatistics(void); |
|
14749 | 43 |
%} |
44 |
! ! |
|
45 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
46 |
!ExternalBytes primitiveFunctions! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
47 |
%{ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
48 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
49 |
struct mallocList { |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
50 |
char *chunk; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
51 |
size_t size; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
52 |
struct mallocList *next; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
53 |
}; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
54 |
static struct mallocList *mallocList = (struct mallocList *)0; |
8913 | 55 |
static INT mallocCount = 0; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
56 |
|
6242 | 57 |
static void |
19376 | 58 |
removeFromMallocList(char *ptr) |
6242 | 59 |
{ |
60 |
struct mallocList *this, *prev, *next; |
|
61 |
int found = 0; |
|
62 |
||
63 |
if (@global(DebugMalloc) != true) return; |
|
64 |
||
65 |
if (ptr) { |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
66 |
found = 0; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
67 |
for (this=mallocList, prev=0; this; this=next) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
68 |
next = this->next; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
69 |
if (this->chunk == ptr) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
70 |
if (prev) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
71 |
prev->next = next; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
72 |
} else { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
73 |
mallocList = next; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
74 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
75 |
free(this); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
76 |
found++; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
77 |
mallocCount--; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
78 |
} else { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
79 |
prev = this; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
80 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
81 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
82 |
if (! found) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
83 |
console_printf("ExternalBytes [warning]: **** free: alien %"_lx_" (allocated somewhere else ?))\n", (INT)ptr); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
84 |
} |
6242 | 85 |
} |
86 |
} |
|
87 |
||
88 |
static void |
|
19376 | 89 |
addToMallocList(char *ptr, size_t nBytes) |
6242 | 90 |
{ |
91 |
struct mallocList *e, *this; |
|
9895 | 92 |
void *malloc(); |
6242 | 93 |
int found; |
94 |
||
95 |
if (@global(DebugMalloc) != true) return; |
|
96 |
||
97 |
if (ptr) { |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
98 |
found = 0; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
99 |
for (this=mallocList; this; this=this->next) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
100 |
if (this->chunk == ptr) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
101 |
console_printf("ExternalBytes [warning]: **** %016"_lx_" already allocated (freed somewhere else ?)\n", (INT)ptr); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
102 |
found++; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
103 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
104 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
105 |
if (! found) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
106 |
e = (struct mallocList *) malloc(sizeof(struct mallocList)); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
107 |
e->next = mallocList; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
108 |
e->chunk = ptr; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
109 |
e->size = nBytes; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
110 |
mallocList = e; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
111 |
mallocCount++; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
112 |
} |
6242 | 113 |
} |
114 |
} |
|
115 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
116 |
char * |
19376 | 117 |
__stx_malloc(size_t nBytes) { |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
118 |
char *ptr = malloc(nBytes); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
119 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
120 |
if (@global(TraceMalloc) == true) { |
24043 | 121 |
console_printf("ExternalBytes [info]: allocated %ld bytes at: %p\n", (long)nBytes, ptr); |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
122 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
123 |
addToMallocList(ptr, nBytes); |
6242 | 124 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
125 |
return ptr; |
19376 | 126 |
} |
6242 | 127 |
|
19376 | 128 |
char * |
129 |
__stx_calloc(size_t n, size_t size) { |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
130 |
char *ptr = __stx_malloc(n * size); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
131 |
if (ptr != 0) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
132 |
bzero(ptr, (n * size)); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
133 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
134 |
return ptr; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
135 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
136 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
137 |
char * |
19376 | 138 |
__stx_realloc(char *ptr, size_t nBytes) |
139 |
{ |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
140 |
char *newPtr; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
141 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
142 |
removeFromMallocList(ptr); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
143 |
newPtr = realloc(ptr, nBytes); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
144 |
addToMallocList(newPtr, nBytes); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
145 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
146 |
if (@global(TraceMalloc) == true) { |
24043 | 147 |
console_printf("ExternalBytes [info]: realloc %ld bytes for %p at: %p\n", (long)nBytes, ptr, newPtr); |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
148 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
149 |
return newPtr; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
150 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
151 |
|
18653 | 152 |
void |
19376 | 153 |
__stx_free(char *ptr) |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
154 |
{ |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
155 |
if (@global(TraceMalloc) == true) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
156 |
console_printf("ExternalBytes: free bytes at: %"_lx_"\n", (INT)ptr); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
157 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
158 |
removeFromMallocList(ptr); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
159 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
160 |
free(ptr); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
161 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
162 |
|
18653 | 163 |
void |
3320 | 164 |
__stx_mallocStatistics() { |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
165 |
struct mallocList *this; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
166 |
int amount = 0; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
167 |
int n = 0; |
3320 | 168 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
169 |
for (this=mallocList; this; this=this->next) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
170 |
n++; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
171 |
amount += this->size; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
172 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
173 |
console_printf("ExternalBytes [info]: allocated %d blocks with %d bytes overall\n", n, amount); |
3320 | 174 |
} |
175 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
176 |
%} |
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 |
!ExternalBytes class methodsFor:'documentation'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
180 |
|
6459 | 181 |
copyright |
182 |
" |
|
183 |
COPYRIGHT (c) 1993 by Claus Gittinger |
|
184 |
All Rights Reserved |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
185 |
|
6459 | 186 |
This software is furnished under a license and may be used |
187 |
only in accordance with the terms of that license and with the |
|
188 |
inclusion of the above copyright notice. This software may not |
|
189 |
be provided or otherwise made available to, or used by, any |
|
190 |
other person. No title to or ownership of the software is |
|
191 |
hereby transferred. |
|
192 |
" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
193 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
194 |
|
6459 | 195 |
documentation |
196 |
" |
|
197 |
This class provides access to any memory in the system. Its main purpose |
|
8908 | 198 |
is to provide a baseclass for objects referencing structured external data. |
6459 | 199 |
Normally, instances are created by primitive code which wants to pass C-data |
200 |
to Smalltalk AND grants smalltalk access to individual bytes afterwards. |
|
201 |
Primitives which do not want to grant this access should return instances of |
|
202 |
ExternalAddress. See more info there. Also, have a look at ExternalFunction |
|
203 |
which is another similar class, but specialized to represent callable C-functions. |
|
8908 | 204 |
|
6459 | 205 |
Since the memory address of an instance stays fixed (once allocated), |
8908 | 206 |
it can also be used to share data with external C-parts |
6459 | 207 |
(which are not prepared for objects to change their address). |
208 |
||
8908 | 209 |
Use with great care - access is not always checked for out-of-bounds |
6459 | 210 |
or valid addresses. |
211 |
||
212 |
Since the data is allocated outside the garbage collected smalltalk space, |
|
213 |
its address stays fix. Thus, it can be passed to external C-functions without |
|
214 |
any danger. However, you have to take care for freeing the memory yourself. |
|
215 |
||
8908 | 216 |
To help in avoiding memory bugs, instances created with #new: are |
6459 | 217 |
registered in a local classvar and deregistered when the underlying memory |
218 |
is explicitely freed. Since a life reference (from that classvar) exists, |
|
219 |
the garbage collector will never find these to be reclaimable, and the |
|
220 |
underlying memory stays allocated (at a fix address) forever. |
|
221 |
To release the memory, either #free it or #unprotect it. |
|
222 |
The first will immediately release the memory, while the second will delay |
|
223 |
freeing until the next garbage collect occurs. |
|
224 |
||
225 |
If you need memory which is automatically freed, create |
|
226 |
the instance via #unprotectedNew: right away; the underlying malloced-memory |
|
227 |
will be released as soon as no smalltalk reference to the ExtBytes object |
|
228 |
exists any more (however, you have to know for sure, that no C-references |
|
229 |
exist to this memory). |
|
230 |
||
8908 | 231 |
To release all memory call #releaseAllMemory which simply sets the |
6459 | 232 |
AllocatedInstances class variable to nil (thus releasing those refs). |
233 |
||
234 |
Example (automatic freeing as soon as ref to buffer is gone): |
|
235 |
|buffer| |
|
236 |
||
237 |
buffer := ExternalBytes unprotectedNew:100. |
|
238 |
... |
|
239 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
240 |
|
6459 | 241 |
Example (manual freeing - never freed, if ref to buffer is gone): |
242 |
|buffer| |
|
243 |
||
244 |
buffer := ExternalBytes new:100. |
|
245 |
... |
|
246 |
buffer free |
|
247 |
||
248 |
||
249 |
Example (delayed automatic freeing as soon as ref to buffer is gone): |
|
250 |
|buffer| |
|
251 |
||
252 |
buffer := ExternalBytes new:100. |
|
253 |
... |
|
254 |
buffer unregister |
|
255 |
||
8908 | 256 |
This class only supports unstructured external data |
6459 | 257 |
- see the companion class ExternalStructure for more. |
258 |
||
259 |
Notice: support for external data is still being developed - |
|
260 |
a parser for C structure syntax and typedefs is on the way, |
|
261 |
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
|
262 |
|
6459 | 263 |
Also notice, that this class may not be available or behave different |
264 |
in other smalltalk systems, making code using it very unportable. |
|
265 |
It is provided for C interfacing only. |
|
266 |
||
267 |
Finally note, that ST/X's memory system is much faster than malloc/free |
|
268 |
in the normal case - especially for short term temporary objects, |
|
269 |
automatically reclaimed object memory is about 5-10 times faster than |
|
270 |
malloc/free. |
|
271 |
Things may be different for huge byte-valued objects, which are to be |
|
8908 | 272 |
reclaimed by the oldspace colletor. |
273 |
Anyway, for portability, we strongly warn from using this as a substitute |
|
6459 | 274 |
for byteArrays; it is meant for shared data with external C-functions ONLY. |
275 |
||
8908 | 276 |
Debugging: |
6459 | 277 |
since all manual memory systems are subject of obscure errors, |
278 |
you may want to turn malloc-tracing on; this traces all allocations/frees |
|
279 |
done here. To do this, evaluate: 'ExternalBytes mallocTrace:true'. |
|
280 |
||
281 |
In addition, you may turn on full debugging (with 'ExternalBytes mallocDebug:true'); |
|
282 |
if turned on, all malloc/realloc requests are remembered and later free / realloc |
|
283 |
requests validated against this list (i.e. to detect freeing unallocated chunks). |
|
284 |
||
285 |
To benefit from this in C-code, we recommend you use __stx_malloc() / __stx_free() |
|
286 |
instead of malloc() / free(). To do so, redefine them in a header file (or cc comand line) |
|
6242 | 287 |
and recompile your external c-libraries with this. |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
288 |
|
6242 | 289 |
I used this here to find memory leaks in the Xt libraries (there are still some in |
290 |
the HTML widget ...). If mallocDebug is on, #dumpMallocChunks will print out what is |
|
291 |
leftOver. This may help to find trouble spots in your C-code. |
|
1286 | 292 |
|
293 |
[author:] |
|
6242 | 294 |
Claus Gittinger |
1317 | 295 |
|
296 |
[see also:] |
|
6242 | 297 |
ExternalAddress ExternalFunction |
298 |
ByteArray |
|
299 |
( how to write primitive code :html: programming/primitive.html ) |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
300 |
" |
6459 | 301 |
! |
302 |
||
8908 | 303 |
examples |
6459 | 304 |
" |
305 |
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
|
306 |
some require primitive code to be compiled, or are simply given as sceletton. |
6459 | 307 |
Notice, that in C, indexing is 0-based, while in Smalltalk, indices start |
308 |
at 1. |
|
309 |
||
310 |
allocating memory in ST, passing it to C: |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
311 |
|
6459 | 312 |
in smalltalk: |
8908 | 313 |
... |
314 |
bytes := ExternalBytes new:100. |
|
315 |
... |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
316 |
|
6459 | 317 |
in C (assuming that the bytes-object has been passed): |
318 |
||
8908 | 319 |
... |
320 |
char *bytePtr; |
|
6459 | 321 |
|
8908 | 322 |
bytePtr = (char *)(__externalBytesAddress(bytes)); |
323 |
if (bytePtr) { |
|
324 |
... do something with bytes at bytePtr ... |
|
325 |
} |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
326 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
327 |
freeing (in ST): |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
328 |
|
8908 | 329 |
... |
330 |
bytes free. |
|
331 |
... |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
332 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
333 |
allocating memory in C, passing it to ST: |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
334 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
335 |
in C: |
8908 | 336 |
... |
337 |
char *bytePtr; |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
338 |
|
8908 | 339 |
bytePtr = (char *)(malloc(100)); |
340 |
... |
|
341 |
RETURN (__MKEXTERNALBYTES(bytePtr)); |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
342 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
343 |
in Smalltalk (extracting bytes, integers or strings): |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
344 |
|
8908 | 345 |
byteVal := bytes byteAt:1. |
346 |
... |
|
347 |
intVal := bytes doubleWordAt:1 MSB:true. |
|
348 |
... |
|
349 |
string := bytes stringAt:20. |
|
350 |
... |
|
7191
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 |
|data bytes2| |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
354 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
355 |
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
|
356 |
bytes2 := ExternalBytes new:30. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
357 |
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
|
358 |
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
|
359 |
bytes2 |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
360 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
361 |
|data bytes1 bytes2| |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
362 |
|
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
363 |
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
|
364 |
bytes1 := ExternalBytes new:30. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
365 |
bytes2 := ExternalBytes new:30. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
366 |
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
|
367 |
bytes2 atAllPut:99. |
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
368 |
bytes2 replaceBytesFrom:2 to:21 with:bytes1 startingAt:1. |
8908 | 369 |
bytes2 asByteArray |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
370 |
|
7192
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
371 |
|data1 bytes1 data2| |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
372 |
|
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
373 |
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
|
374 |
bytes1 := ExternalBytes new:30. |
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
375 |
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
|
376 |
|
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
377 |
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
|
378 |
data2 replaceBytesFrom:2 to:21 with:bytes1 startingAt:1. |
8908 | 379 |
data2 |
7192
3a388e746946
tuned the replaceBytes to/from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7191
diff
changeset
|
380 |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
381 |
" |
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 |
|
6459 | 384 |
!ExternalBytes class methodsFor:'initialization'! |
385 |
||
386 |
initialize |
|
387 |
Lobby isNil ifTrue:[ |
|
11854 | 388 |
Lobby := Registry new. |
6459 | 389 |
] |
390 |
! ! |
|
391 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
392 |
!ExternalBytes class methodsFor:'instance creation'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
393 |
|
19512 | 394 |
address:anAddressInteger |
395 |
"return a new ExternalBytes object to access bytes starting at anAddressInteger. |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
396 |
The memory at anAddressInteger has been allocated elsewhere. |
19512 | 397 |
The size is not known, therefore byte accesses will NOT be checked for valid index. |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
398 |
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
|
399 |
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
|
400 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
401 |
DANGER ALERT: this method allows very bad things to be done to the |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
402 |
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
|
403 |
|
19512 | 404 |
^ self basicNew setAddress:anAddressInteger size:nil |
405 |
||
406 |
"Modified (comment): / 31-03-2016 / 11:05:07 / cg" |
|
848
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 |
|
19512 | 409 |
address:anAddressInteger size:size |
410 |
"return a new ExternalBytes object to access bytes starting at anAddressInteger. |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
411 |
The memory at anAddressInteger has been allocated elsewhere. |
19512 | 412 |
The size is known, which allows byte accesses to be checked for valid index. |
8908 | 413 |
Use this, if you get a pointer to a structure from some external source |
848
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. |
24043 | 415 |
The pointer is protected from GC |
22805 | 416 |
(i.e. I will not free the heap memory, |
417 |
once the returned reference is no longer in use). |
|
418 |
Be careful to avoid memory leaks, when getting malloc'd memory from an external function. |
|
24043 | 419 |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
420 |
DANGER ALERT: this method allows very bad things to be done to the |
24043 | 421 |
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
|
422 |
|
19512 | 423 |
^ self basicNew setAddress:anAddressInteger size:size |
424 |
||
425 |
"Modified (comment): / 31-03-2016 / 11:04:27 / cg" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
426 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
427 |
|
6459 | 428 |
new:numberOfBytes |
429 |
"allocate some memory usable for data; |
|
15398 | 430 |
the memory safe from being finalized by the garbage collector. |
6459 | 431 |
Return a corresponding ExternalBytes object or raise MallocFailure (if malloc fails). |
432 |
||
8908 | 433 |
Use this, if you have to pass a block of bytes to some |
6459 | 434 |
external destination (such as a C function) which does not copy the |
435 |
data, but instead keeps a reference to it. For example, many functions |
|
436 |
which expect strings simply keep a ref to the passed string - for those, |
|
437 |
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
|
438 |
may change their address. |
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 |
DANGER ALERT: the memory is NOT automatically freed until it is either |
24043 | 441 |
MANUALLY freed (see #free) or the returned externalBytes object |
442 |
is unprotected or the classes releaseAllMemory method is called." |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
443 |
|
22224 | 444 |
"/ ^ self protectedNew:numberOfBytes. |
445 |
^ self unprotectedNew:numberOfBytes. |
|
848
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 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
448 |
|bytes| |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
449 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
450 |
bytes := ExternalBytes new:100. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
451 |
bytes wordAt:1 put:1. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
452 |
bytes doubleWordAt:3 put:16r12345678. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
453 |
bytes inspect |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
454 |
" |
22224 | 455 |
|
456 |
"Modified: / 29-08-2017 / 16:52:31 / cg" |
|
6459 | 457 |
! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
458 |
|
10925 | 459 |
newNullTerminatedFromString:aString |
19422 | 460 |
"allocate a null terminated string containing the chars of aString" |
461 |
||
462 |
|nChars extBytes| |
|
463 |
||
464 |
nChars := aString size. |
|
465 |
self assert:(aString bitsPerCharacter == 8). |
|
466 |
||
467 |
extBytes := self new:nChars+1. |
|
468 |
extBytes replaceBytesFrom:1 to:nChars with:aString startingAt:1. |
|
469 |
extBytes at:nChars+1 put:0. |
|
470 |
^ extBytes |
|
471 |
! |
|
472 |
||
473 |
newNullTerminatedFromWideString:aString |
|
19512 | 474 |
"allocate a null terminated wide string containing the U16-chars of aString" |
19422 | 475 |
|
476 |
|nChars extBytes| |
|
477 |
||
478 |
nChars := aString size. |
|
479 |
self assert:(aString bitsPerCharacter <= 16). |
|
480 |
||
481 |
extBytes := self new:((nChars+1)*2). |
|
482 |
1 to:nChars do:[:i | |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
483 |
extBytes unsignedInt16At:(i*2) put:(aString at:i) codePoint. |
19422 | 484 |
]. |
485 |
extBytes unsignedInt16At:((nChars+1)*2) put:0. |
|
486 |
^ extBytes |
|
19512 | 487 |
|
488 |
"Modified (comment): / 31-03-2016 / 11:05:37 / cg" |
|
10925 | 489 |
! |
490 |
||
22224 | 491 |
protectedNew:numberOfBytes |
492 |
"allocate some memory usable for data; |
|
493 |
the memory safe from being finalized by the garbage collector. |
|
494 |
Return a corresponding ExternalBytes object or raise MallocFailure (if malloc fails). |
|
495 |
||
496 |
Use this, if you have to pass a block of bytes to some |
|
497 |
external destination (such as a C function) which does not copy the |
|
498 |
data, but instead keeps a reference to it. For example, many functions |
|
499 |
which expect strings simply keep a ref to the passed string - for those, |
|
500 |
an ST/X string-pointer is not the right thing to pass, since ST/X objects |
|
501 |
may change their address. |
|
502 |
||
503 |
DANGER ALERT: the memory is NOT automatically freed until it is either |
|
24043 | 504 |
MANUALLY freed (see #free) or the returned externalBytes object |
505 |
is unprotected or the classes releaseAllMemory method is called." |
|
22224 | 506 |
|
507 |
|newInst| |
|
508 |
||
509 |
newInst := self unprotectedNew:numberOfBytes. |
|
510 |
newInst protectFromGC. |
|
511 |
^ newInst |
|
512 |
||
513 |
" |
|
514 |
|bytes| |
|
515 |
||
516 |
bytes := ExternalBytes new:100. |
|
517 |
bytes wordAt:1 put:1. |
|
518 |
bytes doubleWordAt:3 put:16r12345678. |
|
519 |
bytes inspect |
|
520 |
" |
|
521 |
||
522 |
"Created: / 29-08-2017 / 16:52:14 / cg" |
|
523 |
! |
|
524 |
||
6459 | 525 |
unprotectedNew:numberOfBytes |
8908 | 526 |
"allocate some memory usable for data; |
15398 | 527 |
the memory is under the control of the garbage collector (i.e. the instance will |
528 |
be finalized and the malloc'd memory will be freed, if the instance goes away). |
|
6459 | 529 |
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
|
530 |
|
6459 | 531 |
DANGER ALERT: the memory block as allocated will be automatically freed |
18653 | 532 |
as soon as the reference to the returned externalBytes object |
533 |
is gone (by the next garbage collect). |
|
534 |
If the memory has been passed to a C-function which |
|
535 |
remembers this pointer, bad things may happen ...." |
|
848
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 |
|newInst| |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
538 |
|
6444 | 539 |
newInst := self basicNew allocateBytes:numberOfBytes. |
9388 | 540 |
newInst registerForFinalization. |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
541 |
^ newInst |
6444 | 542 |
|
543 |
" |
|
544 |
|bytes| |
|
545 |
||
546 |
bytes := ExternalBytes unprotectedNew:100. |
|
547 |
bytes wordAt:1 put:1. |
|
548 |
bytes doubleWordAt:3 put:16r12345678. |
|
549 |
bytes inspect |
|
550 |
" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
551 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
552 |
|
6459 | 553 |
!ExternalBytes class methodsFor:'instance release'! |
554 |
||
555 |
releaseAllMemory |
|
556 |
AllocatedInstances := nil |
|
557 |
" |
|
558 |
... the next GC will get 'em |
|
559 |
" |
|
560 |
! ! |
|
561 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
562 |
!ExternalBytes class methodsFor:'malloc debug'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
563 |
|
6459 | 564 |
dumpMallocChunks |
565 |
%{ /* NOCONTEXT */ |
|
566 |
struct mallocList *entry; |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
567 |
|
6459 | 568 |
for (entry = mallocList; entry; entry=entry->next) { |
24043 | 569 |
console_printf(" %p (%ld)\n", (entry->chunk), (long)(entry->size)); |
6459 | 570 |
} |
571 |
%} |
|
3321 | 572 |
" |
6459 | 573 |
self dumpMallocChunks |
3321 | 574 |
" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
575 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
576 |
|
6459 | 577 |
freeAllMallocChunks |
578 |
"free all stx_malloc'd memory. Be careful, this does no validation at all; |
|
579 |
It simply walks through all chunks and frees them unconditionally. |
|
580 |
This may be helpful during debugging memory-leaks, to release memory which |
|
581 |
was not correctly freed by C-code. Howeve, only memory which was allocated |
|
582 |
by __stx_malloc() is freed here - so you better compile your primitive code with |
|
583 |
malloc redefined to stx_malloc. |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
584 |
Also, mallocDebug has to be on to do this." |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
585 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
586 |
"first free my own memory ..." |
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 |
self releaseAllMemory. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
589 |
ObjectMemory garbageCollect. |
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 |
struct mallocList *entry; |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
592 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
593 |
while ((entry = mallocList) != (struct mallocList *)0) { |
13704 | 594 |
if (@global(TraceMalloc) == true ) { |
24043 | 595 |
console_printf("ExternalBytes [info]: **** forced free of %p (%ld)\n", entry->chunk, (long)(entry->size)); |
13704 | 596 |
} |
597 |
__stx_free(entry->chunk); |
|
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 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
600 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
601 |
|
6459 | 602 |
mallocDebug:aBoolean |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
603 |
DebugMalloc := aBoolean |
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 |
ExternalBytes mallocDebug:true |
8908 | 607 |
ExternalBytes mallocDebug:false |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
608 |
" |
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 |
|
6459 | 611 |
mallocStatistics |
612 |
%{ |
|
613 |
__stx_mallocStatistics(); |
|
614 |
%} |
|
615 |
" |
|
616 |
self mallocStatistics |
|
3486 | 617 |
" |
618 |
! |
|
619 |
||
6459 | 620 |
mallocTrace:aBoolean |
621 |
TraceMalloc := aBoolean |
|
622 |
||
623 |
" |
|
624 |
ExternalBytes mallocTrace:true |
|
625 |
ExternalBytes mallocTrace:false |
|
626 |
" |
|
627 |
! |
|
628 |
||
629 |
numberOfAllocatedChunks |
|
630 |
%{ /* NOCONTEXT */ |
|
8913 | 631 |
RETURN ( __mkSmallInteger(mallocCount) ); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
632 |
%} |
3321 | 633 |
" |
634 |
self numberOfAllocatedChunks |
|
635 |
" |
|
6459 | 636 |
! ! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
637 |
|
6459 | 638 |
!ExternalBytes class methodsFor:'queries'! |
639 |
||
21053 | 640 |
charTypeIsSigned |
641 |
"return true, if the machine's native chars are signed" |
|
642 |
||
643 |
%{ /* NOCONTEXT */ |
|
644 |
char c; |
|
645 |
||
646 |
c = (char)128; |
|
647 |
RETURN ( (int)c < 0 ? true : false ); |
|
648 |
%} |
|
649 |
" |
|
650 |
ExternalBytes charTypeIsSigned |
|
651 |
" |
|
652 |
! |
|
653 |
||
18580 | 654 |
doubleAlignment |
655 |
"return the alignement of longs in structs and unions" |
|
656 |
||
657 |
%{ /* NOCONTEXT */ |
|
658 |
struct { |
|
18653 | 659 |
char c; |
660 |
double d; |
|
18580 | 661 |
} dummy; |
18582 | 662 |
RETURN (__mkSmallInteger( (char *)&dummy.d - (char *)&dummy.c )); |
663 |
%} |
|
664 |
" |
|
665 |
ExternalBytes doubleAlignment |
|
666 |
" |
|
667 |
! |
|
668 |
||
24784 | 669 |
elementByteSize |
670 |
"for bit-like containers, return the number of bytes stored per element. |
|
671 |
For pointer indexed classes, 0 is returned" |
|
672 |
||
673 |
^ 1 |
|
674 |
! |
|
675 |
||
18607 | 676 |
isBuiltInClass |
677 |
"return true if this class is known by the run-time-system. |
|
678 |
Here, true is returned." |
|
679 |
||
680 |
^ self == ExternalBytes |
|
681 |
||
682 |
"Modified: / 11.6.1998 / 17:12:51 / cg" |
|
683 |
! |
|
684 |
||
18580 | 685 |
longAlignment |
686 |
"return the alignement of longs in structs and unions" |
|
687 |
||
688 |
%{ /* NOCONTEXT */ |
|
689 |
struct { |
|
18653 | 690 |
char c; |
691 |
long l; |
|
18580 | 692 |
} dummy; |
18582 | 693 |
RETURN (__mkSmallInteger( (char *)&dummy.l - (char *)&dummy.c )); |
18580 | 694 |
%} |
695 |
" |
|
696 |
ExternalBytes longAlignment |
|
697 |
" |
|
698 |
! |
|
699 |
||
22872 | 700 |
pointerAlignment |
701 |
"return the alignement of pointers in structs and unions" |
|
702 |
||
703 |
%{ /* NOCONTEXT */ |
|
704 |
struct { |
|
24043 | 705 |
char c; |
706 |
void* p; |
|
22872 | 707 |
} dummy; |
708 |
RETURN (__mkSmallInteger( (char *)&dummy.p - (char *)&dummy.c )); |
|
709 |
%} |
|
710 |
" |
|
711 |
ExternalBytes pointerAlignment |
|
712 |
" |
|
713 |
! |
|
714 |
||
6459 | 715 |
sizeofDouble |
716 |
"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
|
717 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
718 |
%{ /* NOCONTEXT */ |
8913 | 719 |
RETURN (__mkSmallInteger( sizeof(double))); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
720 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
721 |
" |
8908 | 722 |
ExternalBytes sizeofDouble |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
723 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
724 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
725 |
|
20489 | 726 |
sizeofEnums |
727 |
"return the number of bytes used by the machine's native enums. |
|
728 |
Be aware, that this can be adjusted in some compilers via the __packed__ attribute; |
|
729 |
So better double check..." |
|
730 |
||
731 |
%{ /* NOCONTEXT */ |
|
732 |
enum foo { bla1, bla2 } foo; |
|
733 |
RETURN (__mkSmallInteger( sizeof(foo))); |
|
734 |
%} |
|
735 |
" |
|
736 |
ExternalBytes sizeofEnums |
|
737 |
" |
|
738 |
! |
|
739 |
||
6459 | 740 |
sizeofFloat |
17627 | 741 |
"return the number of bytes used by the machine's native floats" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
742 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
743 |
%{ /* NOCONTEXT */ |
8913 | 744 |
RETURN (__mkSmallInteger( sizeof(float))); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
745 |
%} |
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 |
ExternalBytes sizeofFloat |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
748 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
749 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
750 |
|
6459 | 751 |
sizeofInt |
17627 | 752 |
"return the number of bytes used by the machine's native integer" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
753 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
754 |
%{ /* NOCONTEXT */ |
8913 | 755 |
RETURN (__mkSmallInteger( sizeof(int))); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
756 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
757 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
758 |
ExternalBytes sizeofInt |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
759 |
" |
6459 | 760 |
! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
761 |
|
6459 | 762 |
sizeofLong |
17627 | 763 |
"return the number of bytes used by the machine's native longs" |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
764 |
|
6459 | 765 |
%{ /* NOCONTEXT */ |
8913 | 766 |
RETURN (__mkSmallInteger( sizeof(long))); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
767 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
768 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
769 |
ExternalBytes sizeofLong |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
770 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
771 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
772 |
|
17627 | 773 |
sizeofLongDouble |
774 |
"return the number of bytes used by the machine's native longdouble. |
|
775 |
If the machine does not support them, return nil." |
|
776 |
||
777 |
%{ /* NOCONTEXT */ |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
778 |
#if defined(__GNUC__) || defined(__CLANG__) || defined(__win32__) |
17627 | 779 |
RETURN (__mkSmallInteger( sizeof(long double))); |
780 |
#endif |
|
781 |
%}. |
|
782 |
^ nil |
|
783 |
||
784 |
" |
|
18653 | 785 |
ExternalBytes sizeofLongDouble |
17627 | 786 |
" |
787 |
! |
|
788 |
||
789 |
sizeofLongLong |
|
790 |
"return the number of bytes used by the machine's native longlongs. |
|
791 |
If the machine does not support them, return nil." |
|
792 |
||
793 |
%{ /* NOCONTEXT */ |
|
794 |
#ifdef HAS_LONGLONG |
|
795 |
RETURN (__mkSmallInteger( sizeof(long long))); |
|
796 |
#endif |
|
797 |
%}. |
|
798 |
^ nil |
|
799 |
||
800 |
" |
|
801 |
ExternalBytes sizeofLongLong |
|
802 |
" |
|
803 |
! |
|
804 |
||
18878 | 805 |
sizeofNativeInt |
806 |
"return the number of bytes used by the machine's SmallInteger native values" |
|
807 |
||
808 |
%{ /* NOCONTEXT */ |
|
809 |
RETURN (__mkSmallInteger( sizeof(INT))); |
|
810 |
%} |
|
811 |
" |
|
812 |
ExternalBytes sizeofNativeInt |
|
813 |
" |
|
814 |
! |
|
815 |
||
6459 | 816 |
sizeofPointer |
22898 | 817 |
"return the number of bytes used by the machine's native pointer. |
818 |
Notice: this is inlined by the compiler(s) as a constant, |
|
24043 | 819 |
therefore, queries like |
820 |
'ExternalAddress pointerSize == 8' |
|
821 |
cost nothing; they are compiled in as a constant |
|
22898 | 822 |
(and even conditionals are eliminated)." |
6459 | 823 |
|
824 |
%{ /* NOCONTEXT */ |
|
8913 | 825 |
RETURN (__mkSmallInteger( sizeof(char *))); |
6459 | 826 |
%} |
827 |
" |
|
828 |
ExternalBytes sizeofPointer |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
829 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
830 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
831 |
|
6459 | 832 |
sizeofShort |
17627 | 833 |
"return the number of bytes used by the machine's native short" |
6459 | 834 |
|
835 |
%{ /* NOCONTEXT */ |
|
8913 | 836 |
RETURN (__mkSmallInteger( sizeof(short))); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
837 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
838 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
839 |
ExternalBytes sizeofShort |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
840 |
" |
6459 | 841 |
! ! |
842 |
||
843 |
!ExternalBytes methodsFor:'accessing'! |
|
844 |
||
845 |
address |
|
846 |
"return the start address as an integer" |
|
847 |
||
848 |
%{ /* NOCONTEXT */ |
|
849 |
||
11629 | 850 |
if (__INST(address_) != nil) { |
11854 | 851 |
unsigned INT addr; |
6459 | 852 |
|
11854 | 853 |
addr = (unsigned INT)__INST(address_); |
854 |
RETURN ( __MKUINT(addr)); |
|
6459 | 855 |
} |
856 |
%}. |
|
857 |
^ nil |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
858 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
859 |
|
6459 | 860 |
basicAt:index |
861 |
"return the byte at index, anInteger; |
|
862 |
Indices are 1-based, therefore |
|
863 |
this is the byte at (address + index - 1)" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
864 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
865 |
%{ /* NOCONTEXT */ |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
866 |
|
1822 | 867 |
unsigned char *cp = (unsigned char *)(__INST(address_)); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
868 |
int idx; |
1997 | 869 |
OBJ sz; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
870 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
871 |
if (cp && __isSmallInteger(index)) { |
6242 | 872 |
idx = __intVal(index); |
873 |
if (idx > 0) { |
|
874 |
if (((sz = __INST(size)) == nil) |
|
875 |
|| (__intVal(sz) >= idx)) { |
|
876 |
cp = cp + idx - 1; |
|
8913 | 877 |
RETURN ( __mkSmallInteger((*cp)) ); |
6242 | 878 |
} |
879 |
} |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
880 |
} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
881 |
%}. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
882 |
(size notNil and:[self address notNil]) ifTrue:[ |
6242 | 883 |
^ self subscriptBoundsError:index |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
884 |
]. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
885 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
886 |
invalid index or unallocated |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
887 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
888 |
self primitiveFailed |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
889 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
890 |
|
6459 | 891 |
basicAt:index put:value |
892 |
"set the byte at index, anInteger to value which must be 0..255. |
|
893 |
Returns value (sigh). |
|
894 |
Indices are 1-based, therefore |
|
895 |
this is the byte at (address + index - 1)" |
|
896 |
||
897 |
%{ /* NOCONTEXT */ |
|
898 |
||
899 |
unsigned char *cp = (unsigned char *)(__INST(address_)); |
|
900 |
int val; |
|
901 |
int idx; |
|
902 |
OBJ sz; |
|
903 |
||
904 |
if (__isSmallInteger(value)) { |
|
905 |
val = __smallIntegerVal(value); |
|
8908 | 906 |
} else if (__isCharacter(value)) { |
15262
5047292c9107
all stx macros begin with double underline (eg. __qClass instead of _qClass)
Claus Gittinger <cg@exept.de>
parents:
15003
diff
changeset
|
907 |
val = __smallIntegerVal(__characterVal(value)); |
6459 | 908 |
} else |
909 |
goto badArg; |
|
910 |
||
911 |
if (cp && __isSmallInteger(index)) { |
|
912 |
idx = __intVal(index); |
|
913 |
if (idx > 0) { |
|
6445 | 914 |
if (((sz = __INST(size)) == nil) |
915 |
|| (__intVal(sz) >= idx)) { |
|
916 |
if ((val & ~0xFF) == 0) /* i.e. (val >= 0) && (val <= 255) */ { |
|
917 |
cp[idx-1] = val; |
|
918 |
RETURN ( value ); |
|
919 |
} |
|
920 |
} |
|
921 |
} |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
922 |
} |
6302
32ede83e77e5
allow for character arg in #at:put:
Claus Gittinger <cg@exept.de>
parents:
6242
diff
changeset
|
923 |
|
32ede83e77e5
allow for character arg in #at:put:
Claus Gittinger <cg@exept.de>
parents:
6242
diff
changeset
|
924 |
badArg: ; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
925 |
%}. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
926 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
927 |
(size notNil and:[self address notNil]) ifTrue:[ |
6445 | 928 |
(index between:1 and:size) ifTrue:[ |
929 |
^ ElementOutOfBoundsSignal raise |
|
930 |
]. |
|
931 |
^ self subscriptBoundsError:index |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
932 |
]. |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
933 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
934 |
invalid index, invalid value or unallocated |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
935 |
" |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
936 |
self primitiveFailed |
1220 | 937 |
|
938 |
"Modified: 19.4.1996 / 11:15:05 / cg" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
939 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
940 |
|
25005 | 941 |
byteAt:idx |
942 |
"return the byte at index, anInteger; |
|
943 |
Indices are 1-based, therefore |
|
944 |
this is the byte at (address + index - 1)" |
|
945 |
||
946 |
^ self basicAt:idx |
|
947 |
||
948 |
! |
|
949 |
||
950 |
byteAt:idx put:value |
|
951 |
"set the byte at index, anInteger to value which must be 0..255. |
|
952 |
Returns value (sigh). |
|
953 |
Indices are 1-based, therefore |
|
954 |
this is the byte at (address + index - 1)" |
|
955 |
||
956 |
^ self basicAt:idx put:value |
|
957 |
! |
|
958 |
||
13196
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
959 |
copyCStringFromHeap |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
960 |
"fetch a 0-terminated string from my pointed-to address" |
6459 | 961 |
|
12594
d7267a747c2f
changed: #copyCStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
11854
diff
changeset
|
962 |
|idx byte s| |
11739 | 963 |
|
12594
d7267a747c2f
changed: #copyCStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
11854
diff
changeset
|
964 |
idx := 1. |
24056 | 965 |
s := WriteStream on:(String new:10). |
12594
d7267a747c2f
changed: #copyCStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
11854
diff
changeset
|
966 |
[(byte := self at:idx) ~~ 0] whileTrue:[ |
24056 | 967 |
s nextPut:(Character value:byte). |
968 |
idx := idx + 1. |
|
11739 | 969 |
]. |
13196
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
970 |
^ s contents |
24056 | 971 |
|
972 |
"Modified: / 11-04-2019 / 08:49:50 / Claus Gittinger" |
|
13196
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
973 |
! |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
974 |
|
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
975 |
copyUnicodeStringFromHeap |
24056 | 976 |
"fetch a 0-terminated wide-string (16bit) from my pointed-to address" |
13196
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
977 |
|
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
978 |
|idx word s| |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
979 |
|
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
980 |
idx := 1. |
24056 | 981 |
s := WriteStream on:(Unicode16String new:10). |
19419 | 982 |
[(word := self unsignedInt16At:idx) ~~ 0] whileTrue:[ |
24056 | 983 |
s nextPut:(Character value:word). |
984 |
idx := idx + 2. |
|
13196
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
985 |
]. |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
986 |
^ s contents |
24056 | 987 |
|
988 |
"Modified (comment): / 11-04-2019 / 08:55:29 / Claus Gittinger" |
|
13196
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
989 |
! |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
990 |
|
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
991 |
instVarAt:index |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
992 |
"redefined to suppress direct access to my address, which is a non-object" |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
993 |
|
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
994 |
index == 1 ifTrue:[^ self address]. |
a8e595628fb5
added: #copyUnicodeStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
13076
diff
changeset
|
995 |
^ super instVarAt:index |
11739 | 996 |
! ! |
997 |
||
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
998 |
!ExternalBytes methodsFor:'converting'! |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
999 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1000 |
asExternalAddress |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1001 |
"return the start address as an external address" |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1002 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1003 |
%{ /* NOCONTEXT */ |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1004 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1005 |
RETURN(__MKEXTERNALADDRESS(__INST(address_))); |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1006 |
%}. |
19419 | 1007 |
self primitiveFailed |
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1008 |
! |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1009 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1010 |
asExternalBytes |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1011 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1012 |
^ self |
20138 | 1013 |
! |
1014 |
||
1015 |
asString |
|
1016 |
"speed up string conversions" |
|
1017 |
||
1018 |
|size| |
|
1019 |
||
1020 |
self class == ExternalBytes ifTrue:[ |
|
24043 | 1021 |
size := self size. |
1022 |
^ (String uninitializedNew:size) replaceBytesFrom:1 to:size with:self startingAt:1. |
|
20138 | 1023 |
]. |
1024 |
^ super asString. |
|
1025 |
||
1026 |
" |
|
1027 |
#[16r41 16r42 16r43] asExternalBytes asString |
|
1028 |
" |
|
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1029 |
! ! |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1030 |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1031 |
!ExternalBytes methodsFor:'filling & replacing'! |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1032 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1033 |
replaceBytesFrom:start to:stop with:aCollection startingAt:repStart |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1034 |
"replace elements from another collection, which must be a ByteArray- |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1035 |
like collection. |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1036 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1037 |
Notice: This operation modifies the receiver, NOT a copy; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1038 |
therefore the change may affect all others referencing the receiver." |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1039 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1040 |
%{ /* NOCONTEXT */ |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1041 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1042 |
int nIndex, repNIndex; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1043 |
int startIndex, stopIndex; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1044 |
REGISTER unsigned char *src; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1045 |
REGISTER int repStartIndex; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1046 |
int repStopIndex, count; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1047 |
REGISTER unsigned char *dst; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1048 |
OBJ cls; |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1049 |
|
14076
5f68cf5ece9c
changed: #replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
13704
diff
changeset
|
1050 |
if ((__isBytes(aCollection) || __isWords(aCollection) || __isExternalBytesLike(aCollection)) |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1051 |
&& __bothSmallInteger(start, stop) |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1052 |
&& __isSmallInteger(repStart)) { |
14632 | 1053 |
startIndex = __intVal(start) - 1; |
1054 |
if (startIndex >= 0) { |
|
1055 |
dst = (unsigned char *)__INST(address_) + startIndex; |
|
1056 |
nIndex = __smallIntegerVal(__INST(size)); |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1057 |
|
14632 | 1058 |
stopIndex = __intVal(stop) - 1; |
1059 |
count = stopIndex - startIndex + 1; |
|
1060 |
if (count == 0) { |
|
1061 |
RETURN ( self ); |
|
1062 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1063 |
|
14632 | 1064 |
if ((count > 0) && (stopIndex < nIndex)) { |
1065 |
repStartIndex = __intVal(repStart) - 1; |
|
1066 |
if (repStartIndex >= 0) { |
|
1067 |
if (__isExternalBytesLike(aCollection)) { |
|
1068 |
OBJ sz; |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
1069 |
|
14632 | 1070 |
src = __externalBytesVal(aCollection); |
1071 |
if (src == 0) goto fallBack; |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1072 |
|
14632 | 1073 |
sz = __externalBytesSize(aCollection); |
1074 |
if (__isSmallInteger(sz)) { |
|
1075 |
repNIndex = __smallIntegerVal(sz); |
|
1076 |
} else { |
|
1077 |
repNIndex = -1; /* unknown */ |
|
1078 |
} |
|
1079 |
src = src + repStartIndex; |
|
1080 |
} else { |
|
1081 |
repNIndex = __qSize(aCollection) - OHDR_SIZE; |
|
1082 |
src = __byteArrayVal(aCollection) + repStartIndex; |
|
1083 |
if ((cls = __qClass(aCollection)) != @global(ByteArray)) { |
|
1084 |
int nInst; |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1085 |
|
14632 | 1086 |
nInst = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars)); |
1087 |
src += nInst; |
|
1088 |
repNIndex -= nInst; |
|
1089 |
} |
|
1090 |
} |
|
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
1091 |
|
14632 | 1092 |
repStopIndex = repStartIndex + (stopIndex - startIndex); |
1093 |
if (repStopIndex < repNIndex) { |
|
1094 |
if (aCollection == self) { |
|
1095 |
/* take care of overlapping copy */ |
|
1096 |
if (src < dst) { |
|
1097 |
/* must do a reverse copy */ |
|
1098 |
src += count; |
|
1099 |
dst += count; |
|
1100 |
while (count-- > 0) { |
|
1101 |
*--dst = *--src; |
|
1102 |
} |
|
1103 |
RETURN ( self ); |
|
1104 |
} |
|
1105 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1106 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1107 |
#ifdef memcpy4 |
14632 | 1108 |
if (((unsigned INT)src & 3) == ((unsigned INT)dst & 3)) { |
1109 |
int nW; |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1110 |
|
14632 | 1111 |
/* copy unaligned part */ |
1112 |
while (count && ((unsigned INT)src & 3)) { |
|
1113 |
*dst++ = *src++; |
|
1114 |
count--; |
|
1115 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1116 |
|
14632 | 1117 |
if (count > 0) { |
1118 |
/* copy aligned part */ |
|
1119 |
nW = count >> 2; |
|
1120 |
memcpy4(dst, src, nW); |
|
1121 |
if ((count = count & 3) != 0) { |
|
1122 |
/* copy any remaining part */ |
|
1123 |
src += (nW<<2); |
|
1124 |
dst += (nW<<2); |
|
1125 |
while (count--) { |
|
1126 |
*dst++ = *src++; |
|
1127 |
} |
|
1128 |
} |
|
1129 |
} |
|
1130 |
RETURN ( self ); |
|
1131 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1132 |
#else |
8901
824a89d0b5c7
alpha64 vs. POINTER_SIZE cleanup
Claus Gittinger <cg@exept.de>
parents:
8288
diff
changeset
|
1133 |
# if __POINTER_SIZE__ == 8 |
14632 | 1134 |
if (((unsigned INT)src & 7) == ((unsigned INT)dst & 7)) { |
1135 |
/* copy unaligned part */ |
|
1136 |
while (count && ((unsigned INT)src & 7)) { |
|
1137 |
*dst++ = *src++; |
|
1138 |
count--; |
|
1139 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1140 |
|
14632 | 1141 |
/* copy aligned part */ |
1142 |
while (count >= 8) { |
|
1143 |
((unsigned INT *)dst)[0] = ((unsigned INT *)src)[0]; |
|
1144 |
dst += 8; |
|
1145 |
src += 8; |
|
1146 |
count -= 8; |
|
1147 |
} |
|
1148 |
while (count--) { |
|
1149 |
*dst++ = *src++; |
|
1150 |
} |
|
1151 |
RETURN ( self ); |
|
1152 |
} |
|
8908 | 1153 |
# endif /* 64bit */ |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1154 |
#endif /* memcpy4 */ |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1155 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1156 |
#ifdef FAST_MEMCPY |
14632 | 1157 |
memcpy(dst, src, count); |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1158 |
#else |
8919 | 1159 |
# ifdef __UNROLL_LOOPS__ |
14632 | 1160 |
while (count >= 8) { |
1161 |
dst[0] = src[0]; dst[1] = src[1]; |
|
1162 |
dst[2] = src[2]; dst[3] = src[3]; |
|
1163 |
dst[4] = src[4]; dst[5] = src[5]; |
|
1164 |
dst[6] = src[6]; dst[7] = src[7]; |
|
1165 |
dst += 8; src += 8; |
|
1166 |
count -= 8; |
|
1167 |
} |
|
8919 | 1168 |
# endif /* __UNROLL_LOOPS__ */ |
14632 | 1169 |
while (count-- > 0) { |
1170 |
*dst++ = *src++; |
|
1171 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1172 |
#endif |
14632 | 1173 |
RETURN ( self ); |
1174 |
} |
|
1175 |
} |
|
1176 |
} |
|
1177 |
} |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1178 |
} |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
1179 |
fallBack: ; |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1180 |
%}. |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1181 |
" |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1182 |
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
|
1183 |
" |
7191
82bddba980b6
tuned the replaceBytes from another externalBytes object case.
Claus Gittinger <cg@exept.de>
parents:
7184
diff
changeset
|
1184 |
^ super replaceBytesFrom:start to:stop with:aCollection startingAt:repStart |
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1185 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1186 |
" |
14125
6aec556d2bbf
comment changed: #replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
14080
diff
changeset
|
1187 |
((ExternalBytes unprotectedNew:16) |
14632 | 1188 |
replaceBytesFrom:1 to:8 |
1189 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
|
1190 |
startingAt:1) copy |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1191 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1192 |
(ExternalBytes unprotectedNew:16) |
14632 | 1193 |
replaceBytesFrom:3 to:10 |
1194 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
|
1195 |
startingAt:4 |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1196 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1197 |
(ExternalBytes unprotectedNew:16) |
14632 | 1198 |
replaceBytesFrom:3 to:4 |
1199 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
|
1200 |
startingAt:1 |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1201 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1202 |
(ExternalBytes unprotectedNew:16) |
14632 | 1203 |
replaceBytesFrom:0 to:9 |
1204 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
|
1205 |
startingAt:1 |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1206 |
|
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1207 |
(ExternalBytes unprotectedNew:16) |
14632 | 1208 |
replaceBytesFrom:1 to:10 |
1209 |
with:#[10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160] |
|
1210 |
startingAt:0 |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1211 |
" |
19168 | 1212 |
! |
1213 |
||
1214 |
replaceNullTerminatedFromString:aString |
|
1215 |
"replace elements from aString, and add a 0-byte at the end" |
|
1216 |
||
19169 | 1217 |
|nChars| |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1218 |
|
19169 | 1219 |
nChars := aString size. |
1220 |
self replaceBytesFrom:1 to:nChars with:aString startingAt:1. |
|
1221 |
self at:nChars+1 put:0. |
|
6483
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1222 |
! ! |
ec599166f169
replaceBytesFrom:to:with:startingAt:
Stefan Vogel <sv@exept.de>
parents:
6471
diff
changeset
|
1223 |
|
6444 | 1224 |
!ExternalBytes methodsFor:'finalization'! |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1225 |
|
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
1226 |
executor |
8908 | 1227 |
"redefined to return a lightweight copy |
7184 | 1228 |
- 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
|
1229 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1230 |
%{ /* NOCONTEXT */ |
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
1231 |
|
7386
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
1232 |
OBJ theCopy, cls; |
7184 | 1233 |
|
7855
27f64d1beaa1
Have to protect self, otherwise bad things happen in the VM.
Stefan Vogel <sv@exept.de>
parents:
7386
diff
changeset
|
1234 |
__PROTECT__(self); |
7184 | 1235 |
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
|
1236 |
__UNPROTECT__(self); |
7386
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
1237 |
__InstPtr(theCopy)->o_class = cls = __InstPtr(self)->o_class; |
0996b933cbf1
Need __STORE() when assigning class
Stefan Vogel <sv@exept.de>
parents:
7257
diff
changeset
|
1238 |
__STORE(theCopy, cls); |
7184 | 1239 |
RETURN (theCopy); |
6491
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1240 |
%} |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1241 |
|
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1242 |
" |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1243 |
(ExternalBytes unprotectedNew:10) executor |
6976d9b69e01
Conversion between ExternalBytes and ExternalAddress
Stefan Vogel <sv@exept.de>
parents:
6484
diff
changeset
|
1244 |
" |
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
1245 |
! |
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
1246 |
|
6462
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1247 |
finalizationLobby |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1248 |
"answer the registry used for finalization. |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1249 |
ExternalBytes have their own Registry" |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1250 |
|
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1251 |
^ Lobby |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1252 |
! |
245e99c09df0
Allow #registerForFinalization for classes defining their own Lobby.
Stefan Vogel <sv@exept.de>
parents:
6459
diff
changeset
|
1253 |
|
6440
eb9cdc352a7c
Use #finalize instead of #disposed
Stefan Vogel <sv@exept.de>
parents:
6425
diff
changeset
|
1254 |
finalize |
2779 | 1255 |
"some ExternalBytes object was finalized; |
1256 |
free the associated heap memory with it" |
|
1257 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1258 |
%{ /* NOCONTEXT */ |
19376 | 1259 |
char *mem = (char *)__INST(address_); |
6457 | 1260 |
if (mem && (OBJ)mem != nil) { |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1261 |
__stx_free(mem); |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1262 |
} |
1133 | 1263 |
__INST(address_) = __INST(size) = nil; |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1264 |
%} |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1265 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1266 |
|
6444 | 1267 |
!ExternalBytes methodsFor:'freeing'! |
1268 |
||
6459 | 1269 |
free |
1270 |
"free a previously allocated piece of memory - be very careful, there |
|
1271 |
are no checks done here. All dangers you usually have with malloc/free |
|
1272 |
are present here ..." |
|
1273 |
||
1274 |
"at least, we check for double freeing the same chunk" |
|
1275 |
self address isNil ifTrue:[ |
|
1276 |
self error:'freeing memory twice'. |
|
1277 |
^ self |
|
1278 |
]. |
|
1279 |
Lobby unregister:self. |
|
1280 |
self finalize. "/ does what we need here .. |
|
1281 |
self unprotectFromGC |
|
7184 | 1282 |
! |
1283 |
||
1284 |
register |
|
1285 |
"register the receiver to be automatically finalized by the GC" |
|
1286 |
||
1287 |
Lobby register:self. |
|
6444 | 1288 |
! ! |
1289 |
||
20188 | 1290 |
!ExternalBytes methodsFor:'pointer arithmetic'! |
6443 | 1291 |
|
6502
87f587d1542e
rename #from:to to #referenceToBytesFrom:to
Stefan Vogel <sv@exept.de>
parents:
6491
diff
changeset
|
1292 |
referenceToBytesFrom:start to:stop |
6459 | 1293 |
"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
|
1294 |
BE CAREFUL: after the receiver has been freed, the new ExternalBytes |
6459 | 1295 |
contents is undefined" |
1296 |
||
8908 | 1297 |
%{ /* NOCONTEXT */ |
6459 | 1298 |
|
6471 | 1299 |
char *addr; |
6459 | 1300 |
int size; |
1301 |
int __start, __stop; |
|
1302 |
||
1303 |
if (__bothSmallInteger(start, stop) && __INST(address_) != nil) { |
|
6503 | 1304 |
__start = __smallIntegerVal(start); |
1305 |
__stop = __smallIntegerVal(stop); |
|
1306 |
if (__start > 0 && __start <= __stop && __stop <= __smallIntegerVal(__INST(size))) { |
|
1307 |
addr = (char *)(__INST(address_)) + (__start - 1); |
|
1308 |
size = __stop - __start + 1; |
|
1309 |
RETURN( __MKEXTERNALBYTES_N(addr, size) ); |
|
1310 |
} |
|
6459 | 1311 |
} |
1312 |
%}. |
|
1313 |
^ self primitiveFailed |
|
6458 | 1314 |
! ! |
6443 | 1315 |
|
6458 | 1316 |
!ExternalBytes methodsFor:'printing & storing'! |
6443 | 1317 |
|
13076
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1318 |
displayOn:aGCOrStream |
6459 | 1319 |
"return a printed representation of the receiver for displaying" |
1320 |
||
13076
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1321 |
|addr| |
6443 | 1322 |
|
13076
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1323 |
"/ what a kludge - Dolphin and Squeak mean: printOn: a stream; |
21548 | 1324 |
"/ old ST80 means: draw-yourself on a GC. |
16739 | 1325 |
(aGCOrStream isStream) ifFalse:[ |
24043 | 1326 |
^ super displayOn:aGCOrStream |
13076
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1327 |
]. |
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1328 |
|
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1329 |
aGCOrStream nextPutAll:self className. |
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1330 |
addr := self address. |
29b8a558bcf2
Implement display with #displayOn: instead of #displayString
Stefan Vogel <sv@exept.de>
parents:
12864
diff
changeset
|
1331 |
addr isNil ifTrue:[ |
24043 | 1332 |
aGCOrStream nextPutAll:'[free]'. |
6459 | 1333 |
] ifFalse:[ |
24043 | 1334 |
size notNil ifTrue:[ |
1335 |
aGCOrStream nextPutAll:'[sz:'. |
|
1336 |
size printOn:aGCOrStream. |
|
1337 |
aGCOrStream space. |
|
1338 |
] ifFalse:[ |
|
1339 |
aGCOrStream nextPut:$[. |
|
1340 |
]. |
|
1341 |
aGCOrStream nextPutAll:'@'. |
|
1342 |
addr printOn:aGCOrStream base:16. |
|
1343 |
aGCOrStream nextPut:$]. |
|
6459 | 1344 |
]. |
1345 |
||
18829 | 1346 |
" |
24043 | 1347 |
self new printString |
1348 |
(self new:5) displayString |
|
18829 | 1349 |
" |
1350 |
||
21548 | 1351 |
"Modified: / 24-02-2000 / 19:02:19 / cg" |
1352 |
"Modified (comment): / 22-02-2017 / 16:54:08 / cg" |
|
6458 | 1353 |
! ! |
1354 |
||
7257 | 1355 |
!ExternalBytes methodsFor:'private-accessing'! |
6458 | 1356 |
|
9388 | 1357 |
invalidateReference |
1358 |
"clear the start address and size" |
|
1359 |
||
1360 |
%{ /* NOCONTEXT */ |
|
1361 |
__INST(address_) = nil; |
|
1362 |
__INST(size) = nil; |
|
1363 |
%} |
|
1364 |
! |
|
1365 |
||
21406 | 1366 |
setAddress:aNumberOrExternalAddress size:sz |
6459 | 1367 |
"set the start address and size" |
1368 |
||
1369 |
%{ /* NOCONTEXT */ |
|
1370 |
if (__INST(address_) == nil) { |
|
24043 | 1371 |
if (aNumberOrExternalAddress == nil) { |
1372 |
__INST(address_) = nil; |
|
1373 |
} else { |
|
1374 |
if (__isSmallInteger(aNumberOrExternalAddress)) { |
|
1375 |
__INST(address_) = (OBJ) __intVal(aNumberOrExternalAddress); |
|
1376 |
} else if(__isInteger(aNumberOrExternalAddress)) { |
|
1377 |
__INST(address_) = (OBJ) __unsignedLongIntVal(aNumberOrExternalAddress); |
|
1378 |
} else if(__isExternalAddressLike(aNumberOrExternalAddress)) { |
|
1379 |
__INST(address_) = __externalAddressVal(aNumberOrExternalAddress); |
|
1380 |
} |
|
1381 |
} |
|
1382 |
__INST(size) = sz; |
|
1383 |
RETURN (self); |
|
6443 | 1384 |
} |
1385 |
%}. |
|
6459 | 1386 |
^ self error:'cannot change address' |
21406 | 1387 |
|
1388 |
"Modified: / 12-02-2017 / 16:22:47 / cg" |
|
8288 | 1389 |
! |
1390 |
||
8908 | 1391 |
setSize:sz |
8288 | 1392 |
"set the size - warning: dangerous if wrong" |
1393 |
||
1394 |
size := sz |
|
6443 | 1395 |
! ! |
1396 |
||
7257 | 1397 |
!ExternalBytes methodsFor:'private-allocation'! |
6444 | 1398 |
|
1399 |
allocateBytes:numberOfBytes |
|
11854 | 1400 |
"allocate (malloc) numberOfBytes; if doClear is true, the allocated memory is cleared. |
1401 |
Fail if already allocated. |
|
1402 |
Raise MallocFailure if malloc fails to allocate enough memory" |
|
1403 |
||
1404 |
^ self allocateBytes:numberOfBytes clear:true |
|
1405 |
! |
|
1406 |
||
1407 |
allocateBytes:numberOfBytes clear:doClear |
|
1408 |
"allocate (malloc) numberOfBytes; if doClear is true, the allocated memory is cleared. |
|
6444 | 1409 |
Fail if already allocated. |
1410 |
Raise MallocFailure if malloc fails to allocate enough memory" |
|
1411 |
||
1412 |
|mallocFailure| |
|
1413 |
||
6457 | 1414 |
%{ |
6444 | 1415 |
/* |
8908 | 1416 |
* Fail if already allocated |
6444 | 1417 |
*/ |
1418 |
if (__INST(address_) == nil && __isSmallInteger(numberOfBytes)) { |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1419 |
INT nBytes = __smallIntegerVal(numberOfBytes); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1420 |
if (nBytes > 0) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1421 |
char *space = __stx_malloc(nBytes); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1422 |
if (space) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1423 |
if (doClear == true) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1424 |
bzero(space, nBytes); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1425 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1426 |
__INST(address_) = (OBJ)space; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1427 |
__INST(size) = numberOfBytes; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1428 |
RETURN(self); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1429 |
} else { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1430 |
mallocFailure = true; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1431 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1432 |
} |
6444 | 1433 |
} |
1434 |
%}. |
|
1435 |
mallocFailure == true ifTrue:[ |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1436 |
^ MallocFailure raiseRequestWith:numberOfBytes. |
6444 | 1437 |
] ifFalse:[ |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1438 |
self primitiveFailed. |
6444 | 1439 |
]. |
1440 |
! ! |
|
1441 |
||
5557 | 1442 |
!ExternalBytes methodsFor:'queries'! |
1443 |
||
6459 | 1444 |
basicSize |
1445 |
"we do not know how many bytes are valid" |
|
5557 | 1446 |
|
6459 | 1447 |
size isNil ifTrue:[^ 0]. |
1448 |
^ size |
|
6443 | 1449 |
! |
1450 |
||
18607 | 1451 |
containsNon7BitAscii |
1452 |
"return true, if any byte in the receiver has the 7th bit on. |
|
1453 |
This my look as a too specific operation to be put here, |
|
1454 |
put it is very helpful for UTF8 string reading (Java class reader), |
|
1455 |
to quickly determine, if UTF8 decoding is needed or not. |
|
1456 |
As most strings in a class file are in fact only containing 7bit ascii, |
|
1457 |
this should speedup class file reading considerably" |
|
1458 |
||
1459 |
%{ /* NOCONTEXT */ |
|
18653 | 1460 |
unsigned char *cp = (unsigned char *)(__INST(address_)); |
18607 | 1461 |
unsigned int size = __intVal(__INST(size)); |
1462 |
unsigned char *endP; |
|
1463 |
||
19328 | 1464 |
if (cp == NULL || size == 0) { |
18653 | 1465 |
RETURN(false); |
18607 | 1466 |
} |
1467 |
||
1468 |
endP = cp + size; |
|
1469 |
#if __POINTER_SIZE__ == 8 |
|
1470 |
while (cp+8 < endP) { |
|
18653 | 1471 |
if ( ((unsigned INT *)cp)[0] & 0x8080808080808080) RETURN( true ); |
1472 |
cp += 8; |
|
18607 | 1473 |
} |
1474 |
#endif |
|
1475 |
while (cp+4 < endP) { |
|
18653 | 1476 |
if ( ((unsigned int *)cp)[0] & 0x80808080) RETURN( true ); |
1477 |
cp += 4; |
|
18607 | 1478 |
} |
1479 |
while (cp < endP) { |
|
18653 | 1480 |
if (*cp++ & 0x80) RETURN( true ); |
18607 | 1481 |
} |
1482 |
RETURN ( false ); |
|
1483 |
%} |
|
1484 |
. |
|
1485 |
^ self contains:[:b | b bitTest:16r80]. |
|
1486 |
||
1487 |
" |
|
1488 |
#[1 2 3 1 2 3 1 2 127 ] asExternalBytes containsNon7BitAscii |
|
1489 |
#[1 2 3 1 2 3 1 2 250 251 250 251 255] asExternalBytes containsNon7BitAscii |
|
1490 |
" |
|
1491 |
! |
|
1492 |
||
22159 | 1493 |
isNull |
1494 |
^ self address == 0 |
|
1495 |
||
1496 |
"Created: / 03-08-2017 / 15:12:32 / cg" |
|
1497 |
! |
|
1498 |
||
9389 | 1499 |
isValid |
19495 | 1500 |
"true if I have an address" |
9389 | 1501 |
|
1502 |
%{ /* NOCONTEXT */ |
|
19495 | 1503 |
RETURN ((__INST(address_) == 0) ? false : true ); |
9389 | 1504 |
%} |
1505 |
! |
|
1506 |
||
6459 | 1507 |
species |
1508 |
"when copying, or concatenating, return instances of this class" |
|
1509 |
||
1510 |
^ ByteArray |
|
5557 | 1511 |
! ! |
1512 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1513 |
!ExternalBytes methodsFor:'registration'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1514 |
|
22110 | 1515 |
forgetMemory |
1516 |
"forget the underlying memory - i.e. it will NOT be freed by me, |
|
1517 |
and actually no reference to the underlying memory is kept. |
|
1518 |
Warning: |
|
24043 | 1519 |
Unless freed by someone else (typically a C-program/client), |
1520 |
this leads to a memory leak. |
|
1521 |
Use this only, if memory which was allocated by me |
|
1522 |
is given to a C-program which frees the memory." |
|
22110 | 1523 |
|
1524 |
Lobby unregister:self. "/ prevents finalization |
|
1525 |
self unprotectFromGC. "/ no longer remembered |
|
22335 | 1526 |
self setAddress:0 size:0. "/ no longer accessible |
22110 | 1527 |
|
1528 |
"Created: / 26-07-2017 / 11:20:41 / cg" |
|
22335 | 1529 |
"Modified (comment): / 09-11-2017 / 09:13:34 / mawalch" |
22110 | 1530 |
! |
1531 |
||
8908 | 1532 |
protectFromGC |
6459 | 1533 |
"enter a reference to the receiver into the AllocatedInstances |
1534 |
class variable - this prevents it from ever being finalized by |
|
1535 |
the garbage collector, thus protecting the underlying memory." |
|
1536 |
||
10137
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1537 |
|wasBlocked| |
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1538 |
|
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1539 |
|
11854 | 1540 |
"using a Semaphore can cause a deadlock, since unprotectFromGC may be called by |
10137
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1541 |
a finalization method" |
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1542 |
|
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1543 |
wasBlocked := OperatingSystem blockInterrupts. |
22110 | 1544 |
"/ AccessLock critical:[ |
24043 | 1545 |
AllocatedInstances isNil ifTrue:[ |
1546 |
AllocatedInstances := IdentitySet new |
|
1547 |
]. |
|
1548 |
AllocatedInstances add:self. |
|
22110 | 1549 |
"/ ] |
10137
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1550 |
wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
22110 | 1551 |
|
1552 |
"Modified (format): / 26-07-2017 / 11:21:46 / cg" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1553 |
! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1554 |
|
8908 | 1555 |
unprotectFromGC |
6459 | 1556 |
"remove the receiver from the AllocatedInstances |
1557 |
class variable - if there is no other reference to the receiver, |
|
15398 | 1558 |
and this was ever allocated by me (i.e. not by the outside world), |
6459 | 1559 |
the next garbage collect will finalize the receiver and the underlying |
1560 |
memory be freed." |
|
1561 |
||
10137
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1562 |
|wasBlocked| |
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1563 |
|
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1564 |
"using a Semaphore can cause a deadlock, since protectFromGC may be interrupted by me |
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1565 |
being called by a finalization method" |
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1566 |
|
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1567 |
wasBlocked := OperatingSystem blockInterrupts. |
22110 | 1568 |
"/ AccessLock critical:[ |
24043 | 1569 |
AllocatedInstances notNil ifTrue:[ |
1570 |
AllocatedInstances remove:self ifAbsent:nil. |
|
1571 |
]. |
|
22110 | 1572 |
"/ ] |
10137
7bfdc51fcb65
Avoid deadlock when free is called by finalization code (Stefan Vogel)
Michael Beyl <mb@exept.de>
parents:
9895
diff
changeset
|
1573 |
wasBlocked ifFalse:[OperatingSystem unblockInterrupts]. |
22110 | 1574 |
|
1575 |
"Modified (format): / 26-07-2017 / 11:21:59 / cg" |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1576 |
! ! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1577 |
|
6457 | 1578 |
!ExternalBytes methodsFor:'resizing'! |
1579 |
||
1580 |
grow:numberOfBytes |
|
1581 |
"reallocate (realloc) numberOfBytes. |
|
1582 |
Raise MallocFailure if realloc fails to allocate enough memory" |
|
1583 |
||
1584 |
|mallocStatus| |
|
1585 |
||
16705 | 1586 |
size == numberOfBytes ifTrue:[^ self]. |
1587 |
||
6457 | 1588 |
%{ |
19376 | 1589 |
if (__isSmallInteger(numberOfBytes)) { |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1590 |
INT nBytes = __smallIntegerVal(numberOfBytes); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1591 |
if (nBytes > 0) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1592 |
char *space; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1593 |
char *prevSpace = (char *)__INST(address_); |
6457 | 1594 |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1595 |
if (prevSpace == (char *)nil) |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1596 |
prevSpace = 0; /* allocate from scratch */ |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1597 |
space = __stx_realloc(prevSpace, nBytes); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1598 |
if (space) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1599 |
__INST(address_) = (OBJ)space; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1600 |
__INST(size) = numberOfBytes; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1601 |
if (space == prevSpace) { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1602 |
/* same address, no re-registration */ |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1603 |
RETURN(self); |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1604 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1605 |
mallocStatus = true; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1606 |
} else { |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1607 |
mallocStatus = false; |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1608 |
} |
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1609 |
} |
6457 | 1610 |
} |
1611 |
%}. |
|
1612 |
mallocStatus == true ifTrue:[ |
|
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1613 |
Lobby registerChange:self. |
6457 | 1614 |
] ifFalse:[mallocStatus == false ifTrue:[ |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1615 |
^ MallocFailure raiseRequestWith:numberOfBytes. |
6457 | 1616 |
] ifFalse:[ |
19860
324edacff5cc
unified cpu and os defines;
Claus Gittinger <cg@exept.de>
parents:
19512
diff
changeset
|
1617 |
self primitiveFailed. |
6457 | 1618 |
]]. |
1619 |
! ! |
|
1620 |
||
14080 | 1621 |
!ExternalBytes methodsFor:'testing'! |
1622 |
||
1623 |
isExternalBytes |
|
1624 |
^ true |
|
1625 |
! ! |
|
1626 |
||
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1627 |
!ExternalBytes class methodsFor:'documentation'! |
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1628 |
|
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1629 |
version |
18580 | 1630 |
^ '$Header$' |
12594
d7267a747c2f
changed: #copyCStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
11854
diff
changeset
|
1631 |
! |
d7267a747c2f
changed: #copyCStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
11854
diff
changeset
|
1632 |
|
d7267a747c2f
changed: #copyCStringFromHeap
Claus Gittinger <cg@exept.de>
parents:
11854
diff
changeset
|
1633 |
version_CVS |
18580 | 1634 |
^ '$Header$' |
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1635 |
! ! |
7184 | 1636 |
|
14749 | 1637 |
|
848
76a83f34c26a
moved ExtBytes & ExtFunc from libbasic2
Claus Gittinger <cg@exept.de>
parents:
diff
changeset
|
1638 |
ExternalBytes initialize! |