1 /********************************************************************/
2 /* */
3 /* s7 Seed7 interpreter */
4 /* Copyright (C) 1990 - 2019 Thomas Mertes */
5 /* */
6 /* This program is free software; you can redistribute it and/or */
7 /* modify it under the terms of the GNU General Public License as */
8 /* published by the Free Software Foundation; either version 2 of */
9 /* the License, or (at your option) any later version. */
10 /* */
11 /* This program is distributed in the hope that it will be useful, */
12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */
14 /* GNU General Public License for more details. */
15 /* */
16 /* You should have received a copy of the GNU General Public */
17 /* License along with this program; if not, write to the */
18 /* Free Software Foundation, Inc., 51 Franklin Street, */
19 /* Fifth Floor, Boston, MA 02110-1301, USA. */
20 /* */
21 /* Module: Library */
22 /* File: seed7/src/bstlib.c */
23 /* Changes: 2007, 2010, 2013, 2015, 2016, 2018 Thomas Mertes */
24 /* Content: All primitive actions for the byte string type. */
25 /* */
26 /********************************************************************/
27
28 #define LOG_FUNCTIONS 0
29 #define VERBOSE_EXCEPTIONS 0
30
31 #include "version.h"
32
33 #include "stdlib.h"
34 #include "stdio.h"
35 #include "string.h"
36 #include "ctype.h"
37
38 #include "common.h"
39 #include "data.h"
40 #include "heaputl.h"
41 #include "flistutl.h"
42 #include "chclsutl.h"
43 #include "syvarutl.h"
44 #include "striutl.h"
45 #include "objutl.h"
46 #include "runerr.h"
47 #include "bst_rtl.h"
48
49 #undef EXTERN
50 #define EXTERN
51 #include "bstlib.h"
52
53
54
55 /**
56 * Append the bstring extension/arg_3 to destination/arg_1.
57 * @exception MEMORY_ERROR Not enough memory for the concatenated
58 * bstring.
59 */
bst_append(listType arguments)60 objectType bst_append (listType arguments)
61
62 {
63 objectType bstr_variable;
64 bstriType bstr_to;
65 bstriType bstr_from;
66 bstriType new_bstr;
67 memSizeType new_size;
68 memSizeType bstr_to_size;
69
70 /* bst_append */
71 bstr_variable = arg_1(arguments);
72 isit_bstri(bstr_variable);
73 is_variable(bstr_variable);
74 bstr_to = take_bstri(bstr_variable);
75 isit_bstri(arg_3(arguments));
76 bstr_from = take_bstri(arg_3(arguments));
77 if (bstr_from->size != 0) {
78 bstr_to_size = bstr_to->size;
79 if (unlikely(bstr_to_size > MAX_BSTRI_LEN - bstr_from->size)) {
80 /* number of bytes does not fit into memSizeType */
81 return raise_exception(SYS_MEM_EXCEPTION);
82 } else {
83 new_size = bstr_to_size + bstr_from->size;
84 REALLOC_BSTRI_SIZE_OK(new_bstr, bstr_to, bstr_to_size, new_size);
85 if (unlikely(new_bstr == NULL)) {
86 return raise_exception(SYS_MEM_EXCEPTION);
87 } else {
88 if (bstr_to == bstr_from) {
89 /* It is possible that bstr_to == bstr_from holds. */
90 /* In this case 'bstr_from' must be corrected */
91 /* after realloc() enlarged 'bstr_to'. */
92 bstr_from = new_bstr;
93 } /* if */
94 COUNT3_BSTRI(bstr_to_size, new_size);
95 memcpy(&new_bstr->mem[bstr_to_size], bstr_from->mem,
96 bstr_from->size);
97 new_bstr->size = new_size;
98 bstr_variable->value.bstriValue = new_bstr;
99 } /* if */
100 } /* if */
101 } /* if */
102 return SYS_EMPTY_OBJECT;
103 } /* bst_append */
104
105
106
107 /**
108 * Concatenate two bstrings.
109 * @return the result of the concatenation.
110 * @exception MEMORY_ERROR Not enough memory for the concatenated
111 * bstring.
112 */
bst_cat(listType arguments)113 objectType bst_cat (listType arguments)
114
115 {
116 bstriType bstri1;
117 bstriType bstri2;
118 memSizeType bstri1_size;
119 memSizeType result_size;
120 bstriType result;
121
122 /* bst_cat */
123 isit_bstri(arg_1(arguments));
124 isit_bstri(arg_3(arguments));
125 bstri1 = take_bstri(arg_1(arguments));
126 bstri2 = take_bstri(arg_3(arguments));
127 bstri1_size = bstri1->size;
128 if (unlikely(bstri1_size > MAX_BSTRI_LEN - bstri2->size)) {
129 /* number of bytes does not fit into memSizeType */
130 return raise_exception(SYS_MEM_EXCEPTION);
131 } else {
132 result_size = bstri1_size + bstri2->size;
133 if (TEMP_OBJECT(arg_1(arguments))) {
134 REALLOC_BSTRI_SIZE_OK(result, bstri1, bstri1_size, result_size);
135 if (unlikely(result == NULL)) {
136 return raise_exception(SYS_MEM_EXCEPTION);
137 } else {
138 COUNT3_STRI(bstri1_size, result_size);
139 result->size = result_size;
140 memcpy(&result->mem[bstri1_size], bstri2->mem,
141 bstri2->size);
142 arg_1(arguments)->value.bstriValue = NULL;
143 return bld_bstri_temp(result);
144 } /* if */
145 } else {
146 if (unlikely(!ALLOC_BSTRI_SIZE_OK(result, result_size))) {
147 return raise_exception(SYS_MEM_EXCEPTION);
148 } else {
149 result->size = result_size;
150 memcpy(result->mem, bstri1->mem, bstri1_size);
151 memcpy(&result->mem[bstri1_size], bstri2->mem, bstri2->size);
152 return bld_bstri_temp(result);
153 } /* if */
154 } /* if */
155 } /* if */
156 } /* bst_cat */
157
158
159
160 /**
161 * Compare two bstrings.
162 * @return -1, 0 or 1 if the first argument is considered to be
163 * respectively less than, equal to, or greater than the
164 * second.
165 */
bst_cmp(listType arguments)166 objectType bst_cmp (listType arguments)
167
168 { /* bst_cmp */
169 isit_bstri(arg_1(arguments));
170 isit_bstri(arg_2(arguments));
171 return bld_int_temp(
172 bstCmp(take_bstri(arg_1(arguments)),
173 take_bstri(arg_2(arguments))));
174 } /* bst_cmp */
175
176
177
178 /**
179 * Assign source/arg_3 to dest/arg_1.
180 * A copy function assumes that dest/arg_1 contains a legal value.
181 * @exception MEMORY_ERROR Not enough memory to create dest.
182 */
bst_cpy(listType arguments)183 objectType bst_cpy (listType arguments)
184
185 {
186 objectType dest;
187 objectType source;
188 memSizeType new_size;
189 bstriType bstri_dest;
190
191 /* bst_cpy */
192 dest = arg_1(arguments);
193 source = arg_3(arguments);
194 isit_bstri(dest);
195 isit_bstri(source);
196 is_variable(dest);
197 bstri_dest = take_bstri(dest);
198 if (TEMP_OBJECT(source)) {
199 FREE_BSTRI(bstri_dest, bstri_dest->size);
200 dest->value.bstriValue = take_bstri(source);
201 source->value.bstriValue = NULL;
202 } else {
203 new_size = take_bstri(source)->size;
204 if (bstri_dest->size == new_size) {
205 if (bstri_dest != take_bstri(source)) {
206 /* It is possible that dest == source holds. The */
207 /* behavior of memcpy() is undefined if source and */
208 /* destination areas overlap (or are identical). */
209 /* Therefore a check for this case is necessary. */
210 memcpy(bstri_dest->mem, take_bstri(source)->mem, new_size);
211 } /* if */
212 } else {
213 if (unlikely(!ALLOC_BSTRI_SIZE_OK(bstri_dest, new_size))) {
214 return raise_exception(SYS_MEM_EXCEPTION);
215 } else {
216 FREE_BSTRI(take_bstri(dest), take_bstri(dest)->size);
217 dest->value.bstriValue = bstri_dest;
218 bstri_dest->size = new_size;
219 } /* if */
220 memcpy(bstri_dest->mem, take_bstri(source)->mem, new_size);
221 } /* if */
222 } /* if */
223 return SYS_EMPTY_OBJECT;
224 } /* bst_cpy */
225
226
227
228 /**
229 * Initialize dest/arg_1 and assign source/arg_3 to it.
230 * A create function assumes that the contents of dest/arg_1
231 * is undefined. Create functions can be used to initialize
232 * constants.
233 * @exception MEMORY_ERROR Not enough memory to represent the result.
234 */
bst_create(listType arguments)235 objectType bst_create (listType arguments)
236
237 {
238 objectType dest;
239 objectType source;
240 memSizeType new_size;
241 bstriType new_bstri;
242
243 /* bst_create */
244 dest = arg_1(arguments);
245 source = arg_3(arguments);
246 isit_bstri(source);
247 SET_CATEGORY_OF_OBJ(dest, BSTRIOBJECT);
248 if (TEMP_OBJECT(source)) {
249 dest->value.bstriValue = take_bstri(source);
250 source->value.bstriValue = NULL;
251 } else {
252 /* printf("bstri_create %d !!!\n", in_file.line); */
253 new_size = take_bstri(source)->size;
254 if (unlikely(!ALLOC_BSTRI_SIZE_OK(new_bstri, new_size))) {
255 dest->value.bstriValue = NULL;
256 return raise_exception(SYS_MEM_EXCEPTION);
257 } /* if */
258 dest->value.bstriValue = new_bstri;
259 new_bstri->size = new_size;
260 memcpy(new_bstri->mem, take_bstri(source)->mem, new_size);
261 } /* if */
262 return SYS_EMPTY_OBJECT;
263 } /* bst_create */
264
265
266
267 /**
268 * Free the memory referred by 'old_bstring/arg_1'.
269 * After bst_destr is left 'old_bstring/arg_1' is NULL.
270 * The memory where 'old_bstring/arg_1' is stored can be
271 * freed afterwards.
272 */
bst_destr(listType arguments)273 objectType bst_destr (listType arguments)
274
275 {
276 bstriType old_bstring;
277
278 /* bst_destr */
279 isit_bstri(arg_1(arguments));
280 old_bstring = take_bstri(arg_1(arguments));
281 if (old_bstring != NULL) {
282 FREE_BSTRI(old_bstring, old_bstring->size);
283 arg_1(arguments)->value.bstriValue = NULL;
284 } /* if */
285 SET_UNUSED_FLAG(arg_1(arguments));
286 return SYS_EMPTY_OBJECT;
287 } /* bst_destr */
288
289
290
291 /**
292 * Get an empty bstring.
293 * @return an empty bstring.
294 * @exception MEMORY_ERROR Not enough memory to represent the result.
295 */
bst_empty(listType arguments)296 objectType bst_empty (listType arguments)
297
298 {
299 bstriType result;
300
301 /* bst_empty */
302 if (unlikely(!ALLOC_BSTRI_SIZE_OK(result, 0))) {
303 return raise_exception(SYS_MEM_EXCEPTION);
304 } else {
305 /* Note that the size of the allocated memory is smaller, */
306 /* than the struct. But this is okay, because the element */
307 /* 'mem' respectively 'mem1' is not used. */
308 result->size = 0;
309 return bld_bstri_temp(result);
310 } /* if */
311 } /* bst_empty */
312
313
314
315 /**
316 * Check if two bstrings are equal.
317 * @return TRUE if both bstrings are equal,
318 * FALSE otherwise.
319 */
bst_eq(listType arguments)320 objectType bst_eq (listType arguments)
321
322 {
323 bstriType bstri1;
324 bstriType bstri2;
325
326 /* bst_eq */
327 isit_bstri(arg_1(arguments));
328 isit_bstri(arg_3(arguments));
329 bstri1 = take_bstri(arg_1(arguments));
330 bstri2 = take_bstri(arg_3(arguments));
331 if (bstri1->size == bstri2->size && memcmp(bstri1->mem, bstri2->mem,
332 bstri1->size) == 0) {
333 return SYS_TRUE_OBJECT;
334 } else {
335 return SYS_FALSE_OBJECT;
336 } /* if */
337 } /* bst_eq */
338
339
340
341 /**
342 * Compute the hash value of a 'bstring'.
343 * @return the hash value.
344 */
bst_hashcode(listType arguments)345 objectType bst_hashcode (listType arguments)
346
347 {
348 bstriType bstri1;
349 intType result;
350
351 /* bst_hashcode */
352 isit_bstri(arg_1(arguments));
353 bstri1 = take_bstri(arg_1(arguments));
354 if (bstri1->size == 0) {
355 result = 0;
356 } else {
357 result = (intType) ((memSizeType) bstri1->mem[0] << 5 ^
358 bstri1->size << 3 ^ bstri1->mem[bstri1->size - 1]);
359 } /* if */
360 return bld_int_temp(result);
361 } /* bst_hashcode */
362
363
364
365 /**
366 * Get a character, identified by an index, from a 'bstring'.
367 * The first character has the index 1.
368 * @return the character specified with the index.
369 * @exception INDEX_ERROR If the index is less than 1 or
370 * greater than the length of the 'bstring'.
371 */
bst_idx(listType arguments)372 objectType bst_idx (listType arguments)
373
374 {
375 bstriType bstri;
376 intType position;
377
378 /* bst_idx */
379 isit_bstri(arg_1(arguments));
380 isit_int(arg_3(arguments));
381 bstri = take_bstri(arg_1(arguments));
382 position = take_int(arg_3(arguments));
383 if (unlikely(position < 1 || (uintType) position > bstri->size)) {
384 logError(printf("bst_idx(\"%s\", " FMT_D "): Position %s.\n",
385 bstriAsUnquotedCStri(bstri), position,
386 position <= 0 ? "<= 0" : "> length(string)"););
387 return raise_exception(SYS_IDX_EXCEPTION);
388 } else {
389 return bld_char_temp((charType) bstri->mem[position - 1]);
390 } /* if */
391 } /* bst_idx */
392
393
394
395 /**
396 * Determine the length of a 'bstring'.
397 * @return the length of the 'bstring'.
398 */
bst_lng(listType arguments)399 objectType bst_lng (listType arguments)
400
401 {
402 bstriType bstri;
403
404 /* bst_lng */
405 isit_bstri(arg_1(arguments));
406 bstri = take_bstri(arg_1(arguments));
407 #if POINTER_SIZE > INTTYPE_SIZE
408 if (unlikely(bstri->size > MAX_MEM_INDEX)) {
409 logError(printf("bst_lng(\"%s\"): Length does not fit into integer.\n",
410 bstriAsUnquotedCStri(bstri)););
411 return raise_exception(SYS_RNG_EXCEPTION);
412 } /* if */
413 #endif
414 return bld_int_temp((intType) bstri->size);
415 } /* bst_lng */
416
417
418
419 /**
420 * Check if two bstrings are not equal.
421 * @return FALSE if both bstrings are equal,
422 * TRUE otherwise.
423 */
bst_ne(listType arguments)424 objectType bst_ne (listType arguments)
425
426 {
427 bstriType bstri1;
428 bstriType bstri2;
429
430 /* bst_ne */
431 isit_bstri(arg_1(arguments));
432 isit_bstri(arg_3(arguments));
433 bstri1 = take_bstri(arg_1(arguments));
434 bstri2 = take_bstri(arg_3(arguments));
435 if (bstri1->size != bstri2->size || memcmp(bstri1->mem, bstri2->mem,
436 bstri1->size) != 0) {
437 return SYS_TRUE_OBJECT;
438 } else {
439 return SYS_FALSE_OBJECT;
440 } /* if */
441 } /* bst_ne */
442
443
444
445 /**
446 * Convert a string to a 'bstring' value.
447 * @return the 'bstring' result of the conversion.
448 * @exception RANGE_ERROR If characters beyond '\255;' are present.
449 * @exception MEMORY_ERROR Not enough memory to represent the result.
450 */
bst_parse1(listType arguments)451 objectType bst_parse1 (listType arguments)
452
453 { /* bst_parse1 */
454 isit_stri(arg_1(arguments));
455 return bld_bstri_temp(
456 bstParse(take_stri(arg_1(arguments))));
457 } /* bst_parse1 */
458
459
460
461 /**
462 * Convert a 'bstring' value to a string.
463 * @return the string result of the conversion.
464 * @exception MEMORY_ERROR Not enough memory to represent the result.
465 */
bst_str(listType arguments)466 objectType bst_str (listType arguments)
467
468 { /* bst_str */
469 isit_bstri(arg_1(arguments));
470 return bld_stri_temp(
471 bstStr(take_bstri(arg_1(arguments))));
472 } /* bst_str */
473
474
475
476 /**
477 * Get 'bstring' value of the object referenced by 'aReference/arg_1'.
478 * @return the 'bstring' value of the referenced object.
479 * @exception RANGE_ERROR If 'aReference/arg_1' is NIL or
480 * category(aReference) <> BSTRIOBJECT holds.
481 */
bst_value(listType arguments)482 objectType bst_value (listType arguments)
483
484 {
485 objectType aReference;
486 bstriType bstri;
487 bstriType result;
488
489 /* bst_value */
490 isit_reference(arg_1(arguments));
491 aReference = take_reference(arg_1(arguments));
492 if (unlikely(aReference == NULL ||
493 CATEGORY_OF_OBJ(aReference) != BSTRIOBJECT ||
494 take_bstri(aReference) == NULL)) {
495 logError(printf("bst_value(");
496 trace1(aReference);
497 printf("): Category is not BSTRIOBJECT.\n"););
498 return raise_exception(SYS_RNG_EXCEPTION);
499 } else {
500 bstri = take_bstri(aReference);
501 if (unlikely(!ALLOC_BSTRI_SIZE_OK(result, bstri->size))) {
502 return raise_exception(SYS_MEM_EXCEPTION);
503 } else {
504 result->size = bstri->size;
505 memcpy(result->mem, bstri->mem, result->size);
506 return bld_bstri_temp(result);
507 } /* if */
508 } /* if */
509 } /* bst_value */
510