1 /*
2 * %CopyrightBegin%
3 *
4 * Copyright Ericsson AB 1996-2020. All Rights Reserved.
5 *
6 * Licensed under the Apache License, Version 2.0 (the "License");
7 * you may not use this file except in compliance with the License.
8 * You may obtain a copy of the License at
9 *
10 * http://www.apache.org/licenses/LICENSE-2.0
11 *
12 * Unless required by applicable law or agreed to in writing, software
13 * distributed under the License is distributed on an "AS IS" BASIS,
14 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15 * See the License for the specific language governing permissions and
16 * limitations under the License.
17 *
18 * %CopyrightEnd%
19 */
20
21 #ifdef HAVE_CONFIG_H
22 # include "config.h"
23 #endif
24
25 #define ERTS_DO_INCL_GLB_INLINE_FUNC_DEF
26
27 #include "sys.h"
28 #include "erl_vm.h"
29 #include "global.h"
30 #include "erl_process.h"
31 #include "beam_file.h"
32 #include "big.h"
33 #include "bif.h"
34 #include "erl_binary.h"
35 #include "erl_bits.h"
36 #include "erl_map.h"
37 #include "packet_parser.h"
38 #include "erl_gc.h"
39 #define ERTS_WANT_DB_INTERNAL__
40 #include "erl_db.h"
41 #include "erl_threads.h"
42 #include "register.h"
43 #include "dist.h"
44 #include "erl_printf.h"
45 #include "erl_threads.h"
46 #include "erl_lock_count.h"
47 #include "erl_time.h"
48 #include "erl_thr_progress.h"
49 #include "erl_thr_queue.h"
50 #include "erl_sched_spec_pre_alloc.h"
51 #include "beam_bp.h"
52 #include "erl_ptab.h"
53 #include "erl_check_io.h"
54 #include "erl_bif_unique.h"
55 #include "erl_io_queue.h"
56 #define ERTS_WANT_TIMER_WHEEL_API
57 #include "erl_time.h"
58 #include "atom.h"
59 #define ERTS_WANT_NFUNC_SCHED_INTERNALS__
60 #include "erl_nfunc_sched.h"
61 #include "erl_proc_sig_queue.h"
62 #include "erl_unicode.h"
63
64 /* *******************************
65 * ** Yielding C Fun (YCF) Note **
66 * *******************************
67 *
68 * Yielding versions of some of the functions in this file are
69 * generated by YCF. These generated functions are placed in the file
70 * "utils.ycf.h" by the ERTS build system. The generation of "utils.ycf.h"
71 * is defined in "$ERL_TOP/erts/emulator/Makefile.in".
72 *
73 * See "$ERL_TOP/erts/emulator/internal_doc/AutomaticYieldingOfCCode.md"
74 * and "$ERL_TOP/erts/lib_src/yielding_c_fun/README.md" for more
75 * information about YCF and the limitation that YCF imposes on the
76 * code that it transforms.
77 *
78 */
79 /* Forward declarations of things needed by utis.ycf.h: */
80 #define YCF_CONSUME_REDS(x)
81 typedef struct
82 {
83 byte* pivot_part_start;
84 byte* pivot_part_end;
85 } erts_qsort_partion_array_result;
86
87 static void erts_qsort_swap(size_t item_size, void* ivp, void* jvp);
88 static void erts_qsort_insertion_sort(byte *base,
89 size_t nr_of_items,
90 size_t item_size,
91 erts_void_ptr_cmp_t compare);
92 #if defined(DEBUG) && defined(ARCH_64)
93 erts_tsd_key_t erts_ycf_debug_stack_start_tsd_key;
ycf_debug_set_stack_start(void * start)94 void ycf_debug_set_stack_start(void * start) {
95 erts_tsd_set(erts_ycf_debug_stack_start_tsd_key, start);
96 }
ycf_debug_reset_stack_start(void)97 void ycf_debug_reset_stack_start(void) {
98 erts_tsd_set(erts_ycf_debug_stack_start_tsd_key, NULL);
99 }
ycf_debug_get_stack_start(void)100 void *ycf_debug_get_stack_start(void) {
101 return erts_tsd_get(erts_ycf_debug_stack_start_tsd_key);
102 }
103 #include "utils.debug.ycf.h"
104 #else
105 #include "utils.ycf.h"
106 #endif
107
108 #if defined(DEBUG)
109 # define DBG_RANDOM_REDS(REDS, SEED) \
110 ((REDS) * 0.01 * erts_sched_local_random_float(SEED))
111 #else
112 # define DBG_RANDOM_REDS(REDS, SEED) (REDS)
113 #endif
114
115 #undef M_TRIM_THRESHOLD
116 #undef M_TOP_PAD
117 #undef M_MMAP_THRESHOLD
118 #undef M_MMAP_MAX
119
120 #if (defined(__GLIBC__) || defined(_AIX)) && defined(HAVE_MALLOC_H)
121 #include <malloc.h>
122 #endif
123
124 #if !defined(HAVE_MALLOPT)
125 #undef HAVE_MALLOPT
126 #define HAVE_MALLOPT 0
127 #endif
128
129 Eterm*
erts_heap_alloc(Process * p,Uint need,Uint xtra)130 erts_heap_alloc(Process* p, Uint need, Uint xtra)
131 {
132 ErlHeapFragment* bp;
133 Uint n;
134 #if defined(DEBUG) || defined(CHECK_FOR_HOLES)
135 Uint i;
136 #endif
137
138 #ifdef FORCE_HEAP_FRAGS
139 if (p->space_verified && p->space_verified_from!=NULL
140 && HEAP_TOP(p) >= p->space_verified_from
141 && HEAP_TOP(p) + need <= p->space_verified_from + p->space_verified
142 && HeapWordsLeft(p) >= need) {
143
144 Uint consumed = need + (HEAP_TOP(p) - p->space_verified_from);
145 ASSERT(consumed <= p->space_verified);
146 p->space_verified -= consumed;
147 p->space_verified_from += consumed;
148 HEAP_TOP(p) = p->space_verified_from;
149 return HEAP_TOP(p) - need;
150 }
151 p->space_verified = 0;
152 p->space_verified_from = NULL;
153 #endif /* FORCE_HEAP_FRAGS */
154
155 n = need + xtra;
156 bp = MBUF(p);
157 if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) {
158 Eterm* ret = bp->mem + bp->used_size;
159 bp->used_size += need;
160 p->mbuf_sz += need;
161 return ret;
162 }
163 #ifdef DEBUG
164 n++;
165 #endif
166 bp = (ErlHeapFragment*)
167 ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, ERTS_HEAP_FRAG_SIZE(n));
168
169 #if defined(DEBUG) || defined(CHECK_FOR_HOLES)
170 for (i = 0; i < n; i++) {
171 bp->mem[i] = ERTS_HOLE_MARKER;
172 }
173 #endif
174
175 #ifdef DEBUG
176 n--;
177 #endif
178
179 bp->next = MBUF(p);
180 MBUF(p) = bp;
181 bp->alloc_size = n;
182 bp->used_size = need;
183 MBUF_SIZE(p) += need;
184 bp->off_heap.first = NULL;
185 bp->off_heap.overhead = 0;
186 return bp->mem;
187 }
188
189 #ifdef CHECK_FOR_HOLES
190 Eterm*
erts_set_hole_marker(Eterm * ptr,Uint sz)191 erts_set_hole_marker(Eterm* ptr, Uint sz)
192 {
193 Eterm* p = ptr;
194 Uint i;
195
196 for (i = 0; i < sz; i++) {
197 *p++ = ERTS_HOLE_MARKER;
198 }
199 return ptr;
200 }
201 #endif
202
203 /*
204 * Helper function for the ESTACK macros defined in global.h.
205 */
206 void
erl_grow_estack(ErtsEStack * s,Uint need)207 erl_grow_estack(ErtsEStack* s, Uint need)
208 {
209 Uint old_size = (s->end - s->start);
210 Uint new_size;
211 Uint sp_offs = s->sp - s->start;
212
213 if (need < old_size)
214 new_size = 2*old_size;
215 else
216 new_size = ((need / old_size) + 2) * old_size;
217
218 if (s->start != s->edefault) {
219 s->start = erts_realloc(s->alloc_type, s->start,
220 new_size*sizeof(Eterm));
221 } else {
222 Eterm* new_ptr = erts_alloc(s->alloc_type, new_size*sizeof(Eterm));
223 sys_memcpy(new_ptr, s->start, old_size*sizeof(Eterm));
224 s->start = new_ptr;
225 }
226 s->end = s->start + new_size;
227 s->sp = s->start + sp_offs;
228 }
229 /*
230 * Helper function for the WSTACK macros defined in global.h.
231 */
232 void
erl_grow_wstack(ErtsWStack * s,Uint need)233 erl_grow_wstack(ErtsWStack* s, Uint need)
234 {
235 Uint old_size = (s->wend - s->wstart);
236 Uint new_size;
237 Uint sp_offs = s->wsp - s->wstart;
238
239 if (need < old_size)
240 new_size = 2 * old_size;
241 else
242 new_size = ((need / old_size) + 2) * old_size;
243
244 if (s->wstart != s->wdefault) {
245 s->wstart = erts_realloc(s->alloc_type, s->wstart,
246 new_size*sizeof(UWord));
247 } else {
248 UWord* new_ptr = erts_alloc(s->alloc_type, new_size*sizeof(UWord));
249 sys_memcpy(new_ptr, s->wstart, old_size*sizeof(UWord));
250 s->wstart = new_ptr;
251 }
252 s->wend = s->wstart + new_size;
253 s->wsp = s->wstart + sp_offs;
254 }
255
256 /*
257 * Helper function for the PSTACK macros defined in global.h.
258 */
259 void
erl_grow_pstack(ErtsPStack * s,void * default_pstack,unsigned need_bytes)260 erl_grow_pstack(ErtsPStack* s, void* default_pstack, unsigned need_bytes)
261 {
262 Uint old_size = s->size;
263 Uint new_size;
264
265 if (need_bytes < old_size)
266 new_size = 2 * old_size;
267 else
268 new_size = ((need_bytes / old_size) + 2) * old_size;
269
270 if (s->pstart != default_pstack) {
271 s->pstart = erts_realloc(s->alloc_type, s->pstart, new_size);
272 } else {
273 byte* new_ptr = erts_alloc(s->alloc_type, new_size);
274 sys_memcpy(new_ptr, s->pstart, old_size);
275 s->pstart = new_ptr;
276 }
277 s->size = new_size;
278 }
279
280 /*
281 * Helper function for the EQUEUE macros defined in global.h.
282 */
283
284 void
erl_grow_equeue(ErtsEQueue * q,Eterm * default_equeue)285 erl_grow_equeue(ErtsEQueue* q, Eterm* default_equeue)
286 {
287 Uint old_size = (q->end - q->start);
288 Uint new_size = old_size * 2;
289 Uint first_part = (q->end - q->front);
290 Uint second_part = (q->back - q->start);
291 Eterm* new_ptr = erts_alloc(q->alloc_type, new_size*sizeof(Eterm));
292 ASSERT(q->back == q->front); // of course the queue is full now!
293 if (first_part > 0)
294 sys_memcpy(new_ptr, q->front, first_part*sizeof(Eterm));
295 if (second_part > 0)
296 sys_memcpy(new_ptr+first_part, q->start, second_part*sizeof(Eterm));
297 if (q->start != default_equeue)
298 erts_free(q->alloc_type, q->start);
299 q->start = new_ptr;
300 q->end = q->start + new_size;
301 q->front = q->start;
302 q->back = q->start + old_size;
303 }
304
305 /* CTYPE macros */
306
307 #define LATIN1
308
309 #define IS_DIGIT(c) ((c) >= '0' && (c) <= '9')
310 #ifdef LATIN1
311 #define IS_LOWER(c) (((c) >= 'a' && (c) <= 'z') \
312 || ((c) >= 128+95 && (c) <= 255 && (c) != 247))
313 #define IS_UPPER(c) (((c) >= 'A' && (c) <= 'Z') \
314 || ((c) >= 128+64 && (c) <= 128+94 && (c) != 247-32))
315 #else
316 #define IS_LOWER(c) ((c) >= 'a' && (c) <= 'z')
317 #define IS_UPPER(c) ((c) >= 'A' && (c) <= 'Z')
318 #endif
319
320 #define IS_ALNUM(c) (IS_DIGIT(c) || IS_LOWER(c) || IS_UPPER(c))
321
322 /* We don't include 160 (non-breaking space). */
323 #define IS_SPACE(c) (c == ' ' || c == '\n' || c == '\t' || c == '\r')
324
325 #ifdef LATIN1
326 #define IS_CNTRL(c) ((c) < ' ' || (c) == 127 \
327 || ((c) >= 128 && (c) < 128+32))
328 #else
329 /* Treat all non-ASCII as control characters */
330 #define IS_CNTRL(c) ((c) < ' ' || (c) >= 127)
331 #endif
332
333 #define IS_PRINT(c) (!IS_CNTRL(c))
334
335 /*
336 * Calculate length of a list.
337 * Returns -1 if not a proper list (i.e. not terminated with NIL)
338 */
339 Sint
erts_list_length(Eterm list)340 erts_list_length(Eterm list)
341 {
342 Sint i = 0;
343
344 while(is_list(list)) {
345 i++;
346 list = CDR(list_val(list));
347 }
348 if (is_not_nil(list)) {
349 return -1;
350 }
351 return i;
352 }
353
354 static const struct {
355 Sint64 mask;
356 int bits;
357 } fib_data[] = {{ERTS_I64_LITERAL(0x2), 1},
358 {ERTS_I64_LITERAL(0xc), 2},
359 {ERTS_I64_LITERAL(0xf0), 4},
360 {ERTS_I64_LITERAL(0xff00), 8},
361 {ERTS_I64_LITERAL(0xffff0000), 16},
362 {ERTS_I64_LITERAL(0xffffffff00000000), 32}};
363
364 static ERTS_INLINE int
fit_in_bits(Sint64 value,int start)365 fit_in_bits(Sint64 value, int start)
366 {
367 int bits = 0;
368 int i;
369
370 for (i = start; i >= 0; i--) {
371 if (value & fib_data[i].mask) {
372 value >>= fib_data[i].bits;
373 bits |= fib_data[i].bits;
374 }
375 }
376
377 bits++;
378
379 return bits;
380 }
381
erts_fit_in_bits_int64(Sint64 value)382 int erts_fit_in_bits_int64(Sint64 value)
383 {
384 return fit_in_bits(value, 5);
385 }
386
erts_fit_in_bits_int32(Sint32 value)387 int erts_fit_in_bits_int32(Sint32 value)
388 {
389 return fit_in_bits((Sint64) (Uint32) value, 4);
390 }
391
erts_fit_in_bits_uint(Uint value)392 int erts_fit_in_bits_uint(Uint value)
393 {
394 #if ERTS_SIZEOF_ETERM == 4
395 return fit_in_bits((Sint64) (Uint32) value, 4);
396 #elif ERTS_SIZEOF_ETERM == 8
397 return fit_in_bits(value, 5);
398 #else
399 # error "No way, Jose"
400 #endif
401 }
402
403 int
erts_print(fmtfn_t to,void * arg,char * format,...)404 erts_print(fmtfn_t to, void *arg, char *format, ...)
405 {
406 int res;
407 va_list arg_list;
408 va_start(arg_list, format);
409
410 {
411 switch ((UWord)to) {
412 case (UWord)ERTS_PRINT_STDOUT:
413 res = erts_vprintf(format, arg_list);
414 break;
415 case (UWord)ERTS_PRINT_STDERR:
416 res = erts_vfprintf(stderr, format, arg_list);
417 break;
418 case (UWord)ERTS_PRINT_FILE:
419 res = erts_vfprintf((FILE *) arg, format, arg_list);
420 break;
421 case (UWord)ERTS_PRINT_SBUF:
422 res = erts_vsprintf((char *) arg, format, arg_list);
423 break;
424 case (UWord)ERTS_PRINT_SNBUF:
425 res = erts_vsnprintf(((erts_print_sn_buf *) arg)->buf,
426 ((erts_print_sn_buf *) arg)->size,
427 format,
428 arg_list);
429 break;
430 case (UWord)ERTS_PRINT_DSBUF:
431 res = erts_vdsprintf((erts_dsprintf_buf_t *) arg, format, arg_list);
432 break;
433 case (UWord)ERTS_PRINT_FD:
434 res = erts_vfdprintf((int)(SWord) arg, format, arg_list);
435 break;
436 default:
437 res = erts_vcbprintf(to, arg, format, arg_list);
438 break;
439 }
440 }
441
442 va_end(arg_list);
443 return res;
444 }
445
446 int
erts_putc(fmtfn_t to,void * arg,char c)447 erts_putc(fmtfn_t to, void *arg, char c)
448 {
449 return erts_print(to, arg, "%c", c);
450 }
451
452 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\
453 * Some Erlang term building utility functions (to be used when performance *
454 * isn't critical). *
455 * *
456 * Add more functions like these here (and function prototypes in global.h) *
457 * when needed. *
458 * *
459 \* */
460
461 Eterm
erts_bld_atom(Uint ** hpp,Uint * szp,char * str)462 erts_bld_atom(Uint **hpp, Uint *szp, char *str)
463 {
464 if (hpp)
465 return erts_atom_put((byte *) str, sys_strlen(str), ERTS_ATOM_ENC_LATIN1, 1);
466 else
467 return THE_NON_VALUE;
468 }
469
470 Eterm
erts_bld_uint(Uint ** hpp,Uint * szp,Uint ui)471 erts_bld_uint(Uint **hpp, Uint *szp, Uint ui)
472 {
473 Eterm res = THE_NON_VALUE;
474 if (IS_USMALL(0, ui)) {
475 if (hpp)
476 res = make_small(ui);
477 }
478 else {
479 if (szp)
480 *szp += BIG_UINT_HEAP_SIZE;
481 if (hpp) {
482 res = uint_to_big(ui, *hpp);
483 *hpp += BIG_UINT_HEAP_SIZE;
484 }
485 }
486 return res;
487 }
488
489 /*
490 * Erts_bld_uword is more or less similar to erts_bld_uint, but a pointer
491 * can safely be passed.
492 */
493
494 Eterm
erts_bld_uword(Uint ** hpp,Uint * szp,UWord uw)495 erts_bld_uword(Uint **hpp, Uint *szp, UWord uw)
496 {
497 Eterm res = THE_NON_VALUE;
498 if (IS_USMALL(0, uw)) {
499 if (hpp)
500 res = make_small((Uint) uw);
501 }
502 else {
503 if (szp)
504 *szp += BIG_UWORD_HEAP_SIZE(uw);
505 if (hpp) {
506 res = uword_to_big(uw, *hpp);
507 *hpp += BIG_UWORD_HEAP_SIZE(uw);
508 }
509 }
510 return res;
511 }
512
513
514 Eterm
erts_bld_uint64(Uint ** hpp,Uint * szp,Uint64 ui64)515 erts_bld_uint64(Uint **hpp, Uint *szp, Uint64 ui64)
516 {
517 Eterm res = THE_NON_VALUE;
518 if (IS_USMALL(0, ui64)) {
519 if (hpp)
520 res = make_small((Uint) ui64);
521 }
522 else {
523 if (szp)
524 *szp += ERTS_UINT64_HEAP_SIZE(ui64);
525 if (hpp)
526 res = erts_uint64_to_big(ui64, hpp);
527 }
528 return res;
529 }
530
531 Eterm
erts_bld_sint64(Uint ** hpp,Uint * szp,Sint64 si64)532 erts_bld_sint64(Uint **hpp, Uint *szp, Sint64 si64)
533 {
534 Eterm res = THE_NON_VALUE;
535 if (IS_SSMALL(si64)) {
536 if (hpp)
537 res = make_small((Sint) si64);
538 }
539 else {
540 if (szp)
541 *szp += ERTS_SINT64_HEAP_SIZE(si64);
542 if (hpp)
543 res = erts_sint64_to_big(si64, hpp);
544 }
545 return res;
546 }
547
548
549 Eterm
erts_bld_cons(Uint ** hpp,Uint * szp,Eterm car,Eterm cdr)550 erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr)
551 {
552 Eterm res = THE_NON_VALUE;
553 if (szp)
554 *szp += 2;
555 if (hpp) {
556 res = CONS(*hpp, car, cdr);
557 *hpp += 2;
558 }
559 return res;
560 }
561
562 Eterm
erts_bld_tuple(Uint ** hpp,Uint * szp,Uint arity,...)563 erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...)
564 {
565 Eterm res = THE_NON_VALUE;
566
567 ASSERT(arity < (((Uint)1) << (sizeof(Uint)*8 - _HEADER_ARITY_OFFS)));
568
569 if (szp)
570 *szp += arity + 1;
571 if (hpp) {
572 res = make_tuple(*hpp);
573 *((*hpp)++) = make_arityval(arity);
574
575 if (arity > 0) {
576 Uint i;
577 va_list argp;
578
579 va_start(argp, arity);
580 for (i = 0; i < arity; i++) {
581 *((*hpp)++) = va_arg(argp, Eterm);
582 }
583 va_end(argp);
584 }
585 }
586 return res;
587 }
588
589
erts_bld_tuplev(Uint ** hpp,Uint * szp,Uint arity,Eterm terms[])590 Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[])
591 {
592 Eterm res = THE_NON_VALUE;
593 /*
594 * Note callers expect that 'terms' is *not* accessed if hpp == NULL.
595 */
596
597 ASSERT(arity < (((Uint)1) << (sizeof(Uint)*8 - _HEADER_ARITY_OFFS)));
598
599 if (szp)
600 *szp += arity + 1;
601 if (hpp) {
602
603 res = make_tuple(*hpp);
604 *((*hpp)++) = make_arityval(arity);
605
606 if (arity > 0) {
607 Uint i;
608 for (i = 0; i < arity; i++)
609 *((*hpp)++) = terms[i];
610 }
611 }
612 return res;
613 }
614
615 Eterm
erts_bld_string_n(Uint ** hpp,Uint * szp,const char * str,Sint len)616 erts_bld_string_n(Uint **hpp, Uint *szp, const char *str, Sint len)
617 {
618 Eterm res = THE_NON_VALUE;
619 Sint i = len;
620 if (szp)
621 *szp += len*2;
622 if (hpp) {
623 res = NIL;
624 while (--i >= 0) {
625 res = CONS(*hpp, make_small((byte) str[i]), res);
626 *hpp += 2;
627 }
628 }
629 return res;
630 }
631
632 Eterm
erts_bld_list(Uint ** hpp,Uint * szp,Sint length,Eterm terms[])633 erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[])
634 {
635 Eterm list = THE_NON_VALUE;
636 if (szp)
637 *szp += 2*length;
638 if (hpp) {
639 Sint i = length;
640 list = NIL;
641
642 while (--i >= 0) {
643 list = CONS(*hpp, terms[i], list);
644 *hpp += 2;
645 }
646 }
647 return list;
648 }
649
650 Eterm
erts_bld_2tup_list(Uint ** hpp,Uint * szp,Sint length,Eterm terms1[],Uint terms2[])651 erts_bld_2tup_list(Uint **hpp, Uint *szp,
652 Sint length, Eterm terms1[], Uint terms2[])
653 {
654 Eterm res = THE_NON_VALUE;
655 if (szp)
656 *szp += 5*length;
657 if (hpp) {
658 Sint i = length;
659 res = NIL;
660
661 while (--i >= 0) {
662 res = CONS(*hpp+3, TUPLE2(*hpp, terms1[i], terms2[i]), res);
663 *hpp += 5;
664 }
665 }
666 return res;
667 }
668
669 Eterm
erts_bld_atom_uword_2tup_list(Uint ** hpp,Uint * szp,Sint length,Eterm atoms[],UWord uints[])670 erts_bld_atom_uword_2tup_list(Uint **hpp, Uint *szp,
671 Sint length, Eterm atoms[], UWord uints[])
672 {
673 Sint i;
674 Eterm res = THE_NON_VALUE;
675 if (szp) {
676 *szp += 5*length;
677 i = length;
678 while (--i >= 0) {
679 if (!IS_USMALL(0, uints[i]))
680 *szp += BIG_UINT_HEAP_SIZE;
681 }
682 }
683 if (hpp) {
684 i = length;
685 res = NIL;
686
687 while (--i >= 0) {
688 Eterm ui;
689
690 if (IS_USMALL(0, uints[i]))
691 ui = make_small(uints[i]);
692 else {
693 ui = uint_to_big(uints[i], *hpp);
694 *hpp += BIG_UINT_HEAP_SIZE;
695 }
696
697 res = CONS(*hpp+3, TUPLE2(*hpp, atoms[i], ui), res);
698 *hpp += 5;
699 }
700 }
701 return res;
702 }
703
704 Eterm
erts_bld_atom_2uint_3tup_list(Uint ** hpp,Uint * szp,Sint length,Eterm atoms[],Uint uints1[],Uint uints2[])705 erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length,
706 Eterm atoms[], Uint uints1[], Uint uints2[])
707 {
708 Sint i;
709 Eterm res = THE_NON_VALUE;
710 if (szp) {
711 *szp += 6*length;
712 i = length;
713 while (--i >= 0) {
714 if (!IS_USMALL(0, uints1[i]))
715 *szp += BIG_UINT_HEAP_SIZE;
716 if (!IS_USMALL(0, uints2[i]))
717 *szp += BIG_UINT_HEAP_SIZE;
718 }
719 }
720 if (hpp) {
721 i = length;
722 res = NIL;
723
724 while (--i >= 0) {
725 Eterm ui1;
726 Eterm ui2;
727
728 if (IS_USMALL(0, uints1[i]))
729 ui1 = make_small(uints1[i]);
730 else {
731 ui1 = uint_to_big(uints1[i], *hpp);
732 *hpp += BIG_UINT_HEAP_SIZE;
733 }
734
735 if (IS_USMALL(0, uints2[i]))
736 ui2 = make_small(uints2[i]);
737 else {
738 ui2 = uint_to_big(uints2[i], *hpp);
739 *hpp += BIG_UINT_HEAP_SIZE;
740 }
741
742 res = CONS(*hpp+4, TUPLE3(*hpp, atoms[i], ui1, ui2), res);
743 *hpp += 6;
744 }
745 }
746 return res;
747 }
748
749 /* *\
750 * *
751 \* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
752
753 /* make a hash index from an erlang term */
754
755 /*
756 ** There are two hash functions.
757 **
758 ** make_hash: A hash function that will give the same values for the same
759 ** terms regardless of the internal representation. Small integers are
760 ** hashed using the same algorithm as bignums and bignums are hashed
761 ** independent of the CPU endianess.
762 ** Make_hash also hashes pids, ports and references like 32 bit numbers
763 ** (but with different constants).
764 ** make_hash() is called from the bif erlang:phash/2
765 **
766 ** The idea behind the hash algorithm is to produce values suitable for
767 ** linear dynamic hashing. We cannot choose the range at all while hashing
768 ** (it's not even supplied to the hashing functions). The good old algorithm
769 ** [H = H*C+X mod M, where H is the hash value, C is a "random" constant(or M),
770 ** M is the range, preferably a prime, and X is each byte value] is therefore
771 ** modified to:
772 ** H = H*C+X mod 2^32, where C is a large prime. This gives acceptable
773 ** "spreading" of the hashes, so that later modulo calculations also will give
774 ** acceptable "spreading" in the range.
775 ** We really need to hash on bytes, otherwise the
776 ** upper bytes of a word will be less significant than the lower ones. That's
777 ** not acceptable at all. For internal use one could maybe optimize by using
778 ** another hash function, that is less strict but faster. That is, however, not
779 ** implemented.
780 **
781 ** Short semi-formal description of make_hash:
782 **
783 ** In make_hash, the number N is treated like this:
784 ** Abs(N) is hashed bytewise with the least significant byte, B(0), first.
785 ** The number of bytes (J) to calculate hash on in N is
786 ** (the number of _32_ bit words needed to store the unsigned
787 ** value of abs(N)) * 4.
788 ** X = FUNNY_NUMBER2
789 ** If N < 0, Y = FUNNY_NUMBER4 else Y = FUNNY_NUMBER3.
790 ** The hash value is Y*h(J) mod 2^32 where h(J) is calculated like
791 ** h(0) = <initial hash>
792 ** h(i) = h(i-1)*X + B(i-1)
793 ** The above should hold regardless of internal representation.
794 ** Pids are hashed like small numbers but with differrent constants, as are
795 ** ports.
796 ** References are hashed like ports but only on the least significant byte.
797 ** Binaries are hashed on all bytes (not on the 15 first as in
798 ** make_broken_hash()).
799 ** Bytes in lists (possibly text strings) use a simpler multiplication inlined
800 ** in the handling of lists, that is an optimization.
801 ** Everything else is like in the old hash (make_broken_hash()).
802 **
803 ** make_hash2() is faster than make_hash, in particular for bignums
804 ** and binaries, and produces better hash values.
805 */
806
807 /* some prime numbers just above 2 ^ 28 */
808
809 #define FUNNY_NUMBER1 268440163
810 #define FUNNY_NUMBER2 268439161
811 #define FUNNY_NUMBER3 268435459
812 #define FUNNY_NUMBER4 268436141
813 #define FUNNY_NUMBER5 268438633
814 #define FUNNY_NUMBER6 268437017
815 #define FUNNY_NUMBER7 268438039
816 #define FUNNY_NUMBER8 268437511
817 #define FUNNY_NUMBER9 268439627
818 #define FUNNY_NUMBER10 268440479
819 #define FUNNY_NUMBER11 268440577
820 #define FUNNY_NUMBER12 268440581
821 #define FUNNY_NUMBER13 268440593
822 #define FUNNY_NUMBER14 268440611
823
824 static Uint32
hash_binary_bytes(Eterm bin,Uint sz,Uint32 hash)825 hash_binary_bytes(Eterm bin, Uint sz, Uint32 hash)
826 {
827 byte* ptr;
828 Uint bitoffs;
829 Uint bitsize;
830
831 ERTS_GET_BINARY_BYTES(bin, ptr, bitoffs, bitsize);
832 if (bitoffs == 0) {
833 while (sz--) {
834 hash = hash*FUNNY_NUMBER1 + *ptr++;
835 }
836 if (bitsize > 0) {
837 byte b = *ptr;
838
839 b >>= 8 - bitsize;
840 hash = (hash*FUNNY_NUMBER1 + b) * FUNNY_NUMBER12 + bitsize;
841 }
842 } else {
843 Uint previous = *ptr++;
844 Uint b;
845 Uint lshift = bitoffs;
846 Uint rshift = 8 - lshift;
847
848 while (sz--) {
849 b = (previous << lshift) & 0xFF;
850 previous = *ptr++;
851 b |= previous >> rshift;
852 hash = hash*FUNNY_NUMBER1 + b;
853 }
854 if (bitsize > 0) {
855 b = (previous << lshift) & 0xFF;
856 previous = *ptr++;
857 b |= previous >> rshift;
858
859 b >>= 8 - bitsize;
860 hash = (hash*FUNNY_NUMBER1 + b) * FUNNY_NUMBER12 + bitsize;
861 }
862 }
863 return hash;
864 }
865
make_hash(Eterm term_arg)866 Uint32 make_hash(Eterm term_arg)
867 {
868 DECLARE_WSTACK(stack);
869 Eterm term = term_arg;
870 Eterm hash = 0;
871 unsigned op;
872
873 #define MAKE_HASH_TUPLE_OP (FIRST_VACANT_TAG_DEF)
874 #define MAKE_HASH_TERM_ARRAY_OP (FIRST_VACANT_TAG_DEF+1)
875 #define MAKE_HASH_CDR_PRE_OP (FIRST_VACANT_TAG_DEF+2)
876 #define MAKE_HASH_CDR_POST_OP (FIRST_VACANT_TAG_DEF+3)
877
878 /*
879 ** Convenience macro for calculating a bytewise hash on an unsigned 32 bit
880 ** integer.
881 ** If the endianess is known, we could be smarter here,
882 ** but that gives no significant speedup (on a sparc at least)
883 */
884 #define UINT32_HASH_STEP(Expr, Prime1) \
885 do { \
886 Uint32 x = (Uint32) (Expr); \
887 hash = \
888 (((((hash)*(Prime1) + (x & 0xFF)) * (Prime1) + \
889 ((x >> 8) & 0xFF)) * (Prime1) + \
890 ((x >> 16) & 0xFF)) * (Prime1) + \
891 (x >> 24)); \
892 } while(0)
893
894 #define UINT32_HASH_RET(Expr, Prime1, Prime2) \
895 UINT32_HASH_STEP(Expr, Prime1); \
896 hash = hash * (Prime2); \
897 break
898
899
900 /*
901 * Significant additions needed for real 64 bit port with larger fixnums.
902 */
903
904 /*
905 * Note, for the simple 64bit port, not utilizing the
906 * larger word size this function will work without modification.
907 */
908 tail_recur:
909 op = tag_val_def(term);
910
911 for (;;) {
912 switch (op) {
913 case NIL_DEF:
914 hash = hash*FUNNY_NUMBER3 + 1;
915 break;
916 case ATOM_DEF:
917 hash = hash*FUNNY_NUMBER1 +
918 (atom_tab(atom_val(term))->slot.bucket.hvalue);
919 break;
920 case SMALL_DEF:
921 {
922 Sint y1 = signed_val(term);
923 Uint y2 = y1 < 0 ? -(Uint)y1 : y1;
924
925 UINT32_HASH_STEP(y2, FUNNY_NUMBER2);
926 #if defined(ARCH_64)
927 if (y2 >> 32)
928 UINT32_HASH_STEP(y2 >> 32, FUNNY_NUMBER2);
929 #endif
930 hash *= (y1 < 0 ? FUNNY_NUMBER4 : FUNNY_NUMBER3);
931 break;
932 }
933 case BINARY_DEF:
934 {
935 Uint sz = binary_size(term);
936
937 hash = hash_binary_bytes(term, sz, hash);
938 hash = hash*FUNNY_NUMBER4 + sz;
939 break;
940 }
941 case EXPORT_DEF:
942 {
943 Export* ep = *((Export **) (export_val(term) + 1));
944
945 hash = hash * FUNNY_NUMBER11 + ep->info.mfa.arity;
946 hash = hash*FUNNY_NUMBER1 +
947 (atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue);
948 hash = hash*FUNNY_NUMBER1 +
949 (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue);
950 break;
951 }
952
953 case FUN_DEF:
954 {
955 ErlFunThing* funp = (ErlFunThing *) fun_val(term);
956 Uint num_free = funp->num_free;
957
958 hash = hash * FUNNY_NUMBER10 + num_free;
959 hash = hash*FUNNY_NUMBER1 +
960 (atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue);
961 hash = hash*FUNNY_NUMBER2 + funp->fe->index;
962 hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq;
963 if (num_free > 0) {
964 if (num_free > 1) {
965 WSTACK_PUSH3(stack, (UWord) &funp->env[1], (num_free-1), MAKE_HASH_TERM_ARRAY_OP);
966 }
967 term = funp->env[0];
968 goto tail_recur;
969 }
970 break;
971 }
972 case PID_DEF:
973 /* only 15 bits... */
974 UINT32_HASH_RET(internal_pid_number(term),FUNNY_NUMBER5,FUNNY_NUMBER6);
975 case EXTERNAL_PID_DEF:
976 /* only 15 bits... */
977 UINT32_HASH_RET(external_pid_number(term),FUNNY_NUMBER5,FUNNY_NUMBER6);
978 case PORT_DEF:
979 case EXTERNAL_PORT_DEF: {
980 Uint64 number = port_number(term);
981 Uint32 low = (Uint32) (number & 0xffffffff);
982 Uint32 high = (Uint32) ((number >> 32) & 0xffffffff);
983 if (high)
984 UINT32_HASH_STEP(high, FUNNY_NUMBER11);
985 UINT32_HASH_RET(low,FUNNY_NUMBER9,FUNNY_NUMBER10);
986 }
987 case REF_DEF:
988 UINT32_HASH_RET(internal_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10);
989 case EXTERNAL_REF_DEF:
990 UINT32_HASH_RET(external_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10);
991 case FLOAT_DEF:
992 {
993 FloatDef ff;
994 GET_DOUBLE(term, ff);
995 if (ff.fd == 0.0f) {
996 /* ensure positive 0.0 */
997 ff.fd = erts_get_positive_zero_float();
998 }
999 hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]);
1000 break;
1001 }
1002 case MAKE_HASH_CDR_PRE_OP:
1003 term = (Eterm) WSTACK_POP(stack);
1004 if (is_not_list(term)) {
1005 WSTACK_PUSH(stack, (UWord) MAKE_HASH_CDR_POST_OP);
1006 goto tail_recur;
1007 }
1008 /* fall through */
1009 case LIST_DEF:
1010 {
1011 Eterm* list = list_val(term);
1012 while(is_byte(*list)) {
1013 /* Optimization for strings.
1014 ** Note that this hash is different from a 'small' hash,
1015 ** as multiplications on a Sparc is so slow.
1016 */
1017 hash = hash*FUNNY_NUMBER2 + unsigned_val(*list);
1018
1019 if (is_not_list(CDR(list))) {
1020 WSTACK_PUSH(stack, MAKE_HASH_CDR_POST_OP);
1021 term = CDR(list);
1022 goto tail_recur;
1023 }
1024 list = list_val(CDR(list));
1025 }
1026 WSTACK_PUSH2(stack, CDR(list), MAKE_HASH_CDR_PRE_OP);
1027 term = CAR(list);
1028 goto tail_recur;
1029 }
1030 case MAKE_HASH_CDR_POST_OP:
1031 hash *= FUNNY_NUMBER8;
1032 break;
1033
1034 case BIG_DEF:
1035 /* Note that this is the exact same thing as the hashing of smalls.*/
1036 {
1037 Eterm* ptr = big_val(term);
1038 Uint n = BIG_SIZE(ptr);
1039 Uint k = n-1;
1040 ErtsDigit d;
1041 int is_neg = BIG_SIGN(ptr);
1042 Uint i;
1043 int j;
1044
1045 for (i = 0; i < k; i++) {
1046 d = BIG_DIGIT(ptr, i);
1047 for(j = 0; j < sizeof(ErtsDigit); ++j) {
1048 hash = (hash*FUNNY_NUMBER2) + (d & 0xff);
1049 d >>= 8;
1050 }
1051 }
1052 d = BIG_DIGIT(ptr, k);
1053 k = sizeof(ErtsDigit);
1054 #if defined(ARCH_64)
1055 if (!(d >> 32))
1056 k /= 2;
1057 #endif
1058 for(j = 0; j < (int)k; ++j) {
1059 hash = (hash*FUNNY_NUMBER2) + (d & 0xff);
1060 d >>= 8;
1061 }
1062 hash *= is_neg ? FUNNY_NUMBER4 : FUNNY_NUMBER3;
1063 break;
1064 }
1065 case MAP_DEF:
1066 hash = hash*FUNNY_NUMBER13 + FUNNY_NUMBER14 + make_hash2(term);
1067 break;
1068 case TUPLE_DEF:
1069 {
1070 Eterm* ptr = tuple_val(term);
1071 Uint arity = arityval(*ptr);
1072
1073 WSTACK_PUSH3(stack, (UWord) arity, (UWord)(ptr+1), (UWord) arity);
1074 op = MAKE_HASH_TUPLE_OP;
1075 }/*fall through*/
1076 case MAKE_HASH_TUPLE_OP:
1077 case MAKE_HASH_TERM_ARRAY_OP:
1078 {
1079 Uint i = (Uint) WSTACK_POP(stack);
1080 Eterm* ptr = (Eterm*) WSTACK_POP(stack);
1081 if (i != 0) {
1082 term = *ptr;
1083 WSTACK_PUSH3(stack, (UWord)(ptr+1), (UWord) i-1, (UWord) op);
1084 goto tail_recur;
1085 }
1086 if (op == MAKE_HASH_TUPLE_OP) {
1087 Uint32 arity = (Uint32) WSTACK_POP(stack);
1088 hash = hash*FUNNY_NUMBER9 + arity;
1089 }
1090 break;
1091 }
1092
1093 default:
1094 erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash(0x%X,0x%X)\n", term, op);
1095 return 0;
1096 }
1097 if (WSTACK_ISEMPTY(stack)) break;
1098 op = WSTACK_POP(stack);
1099 }
1100 DESTROY_WSTACK(stack);
1101 return hash;
1102
1103 #undef MAKE_HASH_TUPLE_OP
1104 #undef MAKE_HASH_TERM_ARRAY_OP
1105 #undef MAKE_HASH_CDR_PRE_OP
1106 #undef MAKE_HASH_CDR_POST_OP
1107 #undef UINT32_HASH_STEP
1108 #undef UINT32_HASH_RET
1109 }
1110
1111
1112
1113 /* Hash function suggested by Bob Jenkins. */
1114
1115 #define MIX(a,b,c) \
1116 do { \
1117 a -= b; a -= c; a ^= (c>>13); \
1118 b -= c; b -= a; b ^= (a<<8); \
1119 c -= a; c -= b; c ^= (b>>13); \
1120 a -= b; a -= c; a ^= (c>>12); \
1121 b -= c; b -= a; b ^= (a<<16); \
1122 c -= a; c -= b; c ^= (b>>5); \
1123 a -= b; a -= c; a ^= (c>>3); \
1124 b -= c; b -= a; b ^= (a<<10); \
1125 c -= a; c -= b; c ^= (b>>15); \
1126 } while(0)
1127
1128 #define HCONST 0x9e3779b9UL /* the golden ratio; an arbitrary value */
1129
1130 typedef struct {
1131 Uint32 a,b,c;
1132 } ErtsBlockHashHelperCtx;
1133
1134 #define BLOCK_HASH_BYTES_PER_ITER 12
1135
1136 /* The three functions below are separated into different functions even
1137 though they are always used together to make trapping and handling
1138 of unaligned binaries easier. Examples of how they are used can be
1139 found in block_hash and make_hash2_helper.*/
1140 static ERTS_INLINE
block_hash_setup(Uint32 initval,ErtsBlockHashHelperCtx * ctx)1141 void block_hash_setup(Uint32 initval,
1142 ErtsBlockHashHelperCtx* ctx /* out parameter */)
1143 {
1144 ctx->a = ctx->b = HCONST;
1145 ctx->c = initval; /* the previous hash value */
1146 }
1147
1148 static ERTS_INLINE
block_hash_buffer(byte * buf,Uint buf_length,ErtsBlockHashHelperCtx * ctx)1149 void block_hash_buffer(byte *buf,
1150 Uint buf_length,
1151 ErtsBlockHashHelperCtx* ctx /* out parameter */)
1152 {
1153 Uint len = buf_length;
1154 byte *k = buf;
1155 ASSERT(buf_length % BLOCK_HASH_BYTES_PER_ITER == 0);
1156 while (len >= BLOCK_HASH_BYTES_PER_ITER) {
1157 ctx->a += (k[0] +((Uint32)k[1]<<8) +((Uint32)k[2]<<16) +((Uint32)k[3]<<24));
1158 ctx->b += (k[4] +((Uint32)k[5]<<8) +((Uint32)k[6]<<16) +((Uint32)k[7]<<24));
1159 ctx->c += (k[8] +((Uint32)k[9]<<8) +((Uint32)k[10]<<16)+((Uint32)k[11]<<24));
1160 MIX(ctx->a,ctx->b,ctx->c);
1161 k += BLOCK_HASH_BYTES_PER_ITER; len -= BLOCK_HASH_BYTES_PER_ITER;
1162 }
1163 }
1164
1165 static ERTS_INLINE
block_hash_final_bytes(byte * buf,Uint buf_length,Uint full_length,ErtsBlockHashHelperCtx * ctx)1166 Uint32 block_hash_final_bytes(byte *buf,
1167 Uint buf_length,
1168 Uint full_length,
1169 ErtsBlockHashHelperCtx* ctx)
1170 {
1171 Uint len = buf_length;
1172 byte *k = buf;
1173 ctx->c += full_length;
1174 switch(len)
1175 { /* all the case statements fall through */
1176 case 11: ctx->c+=((Uint32)k[10]<<24);
1177 case 10: ctx->c+=((Uint32)k[9]<<16);
1178 case 9 : ctx->c+=((Uint32)k[8]<<8);
1179 /* the first byte of c is reserved for the length */
1180 case 8 : ctx->b+=((Uint32)k[7]<<24);
1181 case 7 : ctx->b+=((Uint32)k[6]<<16);
1182 case 6 : ctx->b+=((Uint32)k[5]<<8);
1183 case 5 : ctx->b+=k[4];
1184 case 4 : ctx->a+=((Uint32)k[3]<<24);
1185 case 3 : ctx->a+=((Uint32)k[2]<<16);
1186 case 2 : ctx->a+=((Uint32)k[1]<<8);
1187 case 1 : ctx->a+=k[0];
1188 /* case 0: nothing left to add */
1189 }
1190 MIX(ctx->a,ctx->b,ctx->c);
1191 return ctx->c;
1192 }
1193
1194 static
1195 Uint32
block_hash(byte * block,Uint block_length,Uint32 initval)1196 block_hash(byte *block, Uint block_length, Uint32 initval)
1197 {
1198 ErtsBlockHashHelperCtx ctx;
1199 Uint no_bytes_not_in_loop =
1200 (block_length % BLOCK_HASH_BYTES_PER_ITER);
1201 Uint no_bytes_to_process_in_loop =
1202 block_length - no_bytes_not_in_loop;
1203 byte *final_bytes = block + no_bytes_to_process_in_loop;
1204 block_hash_setup(initval, &ctx);
1205 block_hash_buffer(block,
1206 no_bytes_to_process_in_loop,
1207 &ctx);
1208 return block_hash_final_bytes(final_bytes,
1209 no_bytes_not_in_loop,
1210 block_length,
1211 &ctx);
1212 }
1213
1214 typedef enum {
1215 tag_primary_list,
1216 arityval_subtag,
1217 hamt_subtag_head_flatmap,
1218 map_subtag,
1219 fun_subtag,
1220 neg_big_subtag,
1221 sub_binary_subtag_1,
1222 sub_binary_subtag_2,
1223 hash2_common_1,
1224 hash2_common_2,
1225 hash2_common_3,
1226 } ErtsMakeHash2TrapLocation;
1227
1228 typedef struct {
1229 int c;
1230 Uint32 sh;
1231 Eterm* ptr;
1232 } ErtsMakeHash2Context_TAG_PRIMARY_LIST;
1233
1234 typedef struct {
1235 int i;
1236 int arity;
1237 Eterm* elem;
1238 } ErtsMakeHash2Context_ARITYVAL_SUBTAG;
1239
1240 typedef struct {
1241 Eterm *ks;
1242 Eterm *vs;
1243 int i;
1244 Uint size;
1245 } ErtsMakeHash2Context_HAMT_SUBTAG_HEAD_FLATMAP;
1246
1247 typedef struct {
1248 Eterm* ptr;
1249 int i;
1250 } ErtsMakeHash2Context_MAP_SUBTAG;
1251
1252 typedef struct {
1253 Uint num_free;
1254 Eterm* bptr;
1255 } ErtsMakeHash2Context_FUN_SUBTAG;
1256
1257 typedef struct {
1258 Eterm* ptr;
1259 Uint i;
1260 Uint n;
1261 Uint32 con;
1262 } ErtsMakeHash2Context_NEG_BIG_SUBTAG;
1263
1264 typedef struct {
1265 byte* bptr;
1266 Uint sz;
1267 Uint bitsize;
1268 Uint bitoffs;
1269 Uint no_bytes_processed;
1270 ErtsBlockHashHelperCtx block_hash_ctx;
1271 /* The following fields are only used when bitoffs != 0 */
1272 byte* buf;
1273 int done;
1274
1275 } ErtsMakeHash2Context_SUB_BINARY_SUBTAG;
1276
1277 typedef struct {
1278 int dummy__; /* Empty structs are not supported on all platforms */
1279 } ErtsMakeHash2Context_EMPTY;
1280
1281 typedef struct {
1282 ErtsMakeHash2TrapLocation trap_location;
1283 /* specific to the trap location: */
1284 union {
1285 ErtsMakeHash2Context_TAG_PRIMARY_LIST tag_primary_list;
1286 ErtsMakeHash2Context_ARITYVAL_SUBTAG arityval_subtag;
1287 ErtsMakeHash2Context_HAMT_SUBTAG_HEAD_FLATMAP hamt_subtag_head_flatmap;
1288 ErtsMakeHash2Context_MAP_SUBTAG map_subtag;
1289 ErtsMakeHash2Context_FUN_SUBTAG fun_subtag;
1290 ErtsMakeHash2Context_NEG_BIG_SUBTAG neg_big_subtag;
1291 ErtsMakeHash2Context_SUB_BINARY_SUBTAG sub_binary_subtag_1;
1292 ErtsMakeHash2Context_SUB_BINARY_SUBTAG sub_binary_subtag_2;
1293 ErtsMakeHash2Context_EMPTY hash2_common_1;
1294 ErtsMakeHash2Context_EMPTY hash2_common_2;
1295 ErtsMakeHash2Context_EMPTY hash2_common_3;
1296 } trap_location_state;
1297 /* same for all trap locations: */
1298 Eterm term;
1299 Uint32 hash;
1300 Uint32 hash_xor_pairs;
1301 ErtsEStack stack;
1302 } ErtsMakeHash2Context;
1303
make_hash2_ctx_bin_dtor(Binary * context_bin)1304 static int make_hash2_ctx_bin_dtor(Binary *context_bin) {
1305 ErtsMakeHash2Context* context = ERTS_MAGIC_BIN_DATA(context_bin);
1306 DESTROY_SAVED_ESTACK(&context->stack);
1307 if (context->trap_location == sub_binary_subtag_2 &&
1308 context->trap_location_state.sub_binary_subtag_2.buf != NULL) {
1309 erts_free(ERTS_ALC_T_PHASH2_TRAP, context->trap_location_state.sub_binary_subtag_2.buf);
1310 }
1311 return 1;
1312 }
1313
1314 /* hash2_save_trap_state is called seldom so we want to avoid inlining */
1315 static ERTS_NOINLINE
hash2_save_trap_state(Eterm state_mref,Uint32 hash_xor_pairs,Uint32 hash,Process * p,Eterm term,Eterm * ESTK_DEF_STACK (s),ErtsEStack s,ErtsMakeHash2TrapLocation trap_location,void * trap_location_state_ptr,size_t trap_location_state_size)1316 Eterm hash2_save_trap_state(Eterm state_mref,
1317 Uint32 hash_xor_pairs,
1318 Uint32 hash,
1319 Process* p,
1320 Eterm term,
1321 Eterm* ESTK_DEF_STACK(s),
1322 ErtsEStack s,
1323 ErtsMakeHash2TrapLocation trap_location,
1324 void* trap_location_state_ptr,
1325 size_t trap_location_state_size) {
1326 Binary* state_bin;
1327 ErtsMakeHash2Context* context;
1328 if (state_mref == THE_NON_VALUE) {
1329 Eterm* hp;
1330 state_bin = erts_create_magic_binary(sizeof(ErtsMakeHash2Context),
1331 make_hash2_ctx_bin_dtor);
1332 hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
1333 state_mref = erts_mk_magic_ref(&hp, &MSO(p), state_bin);
1334 } else {
1335 state_bin = erts_magic_ref2bin(state_mref);
1336 }
1337 context = ERTS_MAGIC_BIN_DATA(state_bin);
1338 context->term = term;
1339 context->hash = hash;
1340 context->hash_xor_pairs = hash_xor_pairs;
1341 ESTACK_SAVE(s, &context->stack);
1342 context->trap_location = trap_location;
1343 sys_memcpy(&context->trap_location_state,
1344 trap_location_state_ptr,
1345 trap_location_state_size);
1346 erts_set_gc_state(p, 0);
1347 BUMP_ALL_REDS(p);
1348 return state_mref;
1349 }
1350 #undef NOINLINE_HASH2_SAVE_TRAP_STATE
1351
1352 /* Writes back a magic reference to *state_mref_write_back when the
1353 function traps */
1354 static ERTS_INLINE Uint32
make_hash2_helper(Eterm term_param,const int can_trap,Eterm * state_mref_write_back,Process * p)1355 make_hash2_helper(Eterm term_param, const int can_trap, Eterm* state_mref_write_back, Process* p)
1356 {
1357 static const Uint ITERATIONS_PER_RED = 64;
1358 Uint32 hash;
1359 Uint32 hash_xor_pairs;
1360 Eterm term = term_param;
1361 ERTS_UNDEF(hash_xor_pairs, 0);
1362
1363 /* (HCONST * {2, ..., 22}) mod 2^32 */
1364 #define HCONST_2 0x3c6ef372UL
1365 #define HCONST_3 0xdaa66d2bUL
1366 #define HCONST_4 0x78dde6e4UL
1367 #define HCONST_5 0x1715609dUL
1368 #define HCONST_6 0xb54cda56UL
1369 #define HCONST_7 0x5384540fUL
1370 #define HCONST_8 0xf1bbcdc8UL
1371 #define HCONST_9 0x8ff34781UL
1372 #define HCONST_10 0x2e2ac13aUL
1373 #define HCONST_11 0xcc623af3UL
1374 #define HCONST_12 0x6a99b4acUL
1375 #define HCONST_13 0x08d12e65UL
1376 #define HCONST_14 0xa708a81eUL
1377 #define HCONST_15 0x454021d7UL
1378 #define HCONST_16 0xe3779b90UL
1379 #define HCONST_17 0x81af1549UL
1380 #define HCONST_18 0x1fe68f02UL
1381 #define HCONST_19 0xbe1e08bbUL
1382 #define HCONST_20 0x5c558274UL
1383 #define HCONST_21 0xfa8cfc2dUL
1384 #define HCONST_22 0x98c475e6UL
1385
1386 #define HASH_MAP_TAIL (_make_header(1,_TAG_HEADER_REF))
1387 #define HASH_MAP_PAIR (_make_header(2,_TAG_HEADER_REF))
1388 #define HASH_CDR (_make_header(3,_TAG_HEADER_REF))
1389
1390 #define UINT32_HASH_2(Expr1, Expr2, AConst) \
1391 do { \
1392 Uint32 a,b; \
1393 a = AConst + (Uint32) (Expr1); \
1394 b = AConst + (Uint32) (Expr2); \
1395 MIX(a,b,hash); \
1396 } while(0)
1397
1398 #define UINT32_HASH(Expr, AConst) UINT32_HASH_2(Expr, 0, AConst)
1399
1400 #define SINT32_HASH(Expr, AConst) \
1401 do { \
1402 Sint32 y = (Sint32) (Expr); \
1403 if (y < 0) { \
1404 UINT32_HASH(-y, AConst); \
1405 /* Negative numbers are unnecessarily mixed twice. */ \
1406 } \
1407 UINT32_HASH(y, AConst); \
1408 } while(0)
1409
1410 #define IS_SSMALL28(x) (((Uint) (((x) >> (28-1)) + 1)) < 2)
1411
1412 #define NOT_SSMALL28_HASH(SMALL) \
1413 do { \
1414 Uint64 t; \
1415 Uint32 x, y; \
1416 Uint32 con; \
1417 if (SMALL < 0) { \
1418 con = HCONST_10; \
1419 t = (Uint64)(SMALL * (-1)); \
1420 } else { \
1421 con = HCONST_11; \
1422 t = SMALL; \
1423 } \
1424 x = t & 0xffffffff; \
1425 y = t >> 32; \
1426 UINT32_HASH_2(x, y, con); \
1427 } while(0)
1428
1429 #ifdef ARCH_64
1430 # define POINTER_HASH(Ptr, AConst) UINT32_HASH_2((Uint32)(UWord)(Ptr), (((UWord)(Ptr)) >> 32), AConst)
1431 #else
1432 # define POINTER_HASH(Ptr, AConst) UINT32_HASH(Ptr, AConst)
1433 #endif
1434
1435 #define TRAP_LOCATION_NO_RED(location_name) \
1436 do { \
1437 if(can_trap && iterations_until_trap <= 0) { \
1438 *state_mref_write_back = \
1439 hash2_save_trap_state(state_mref, \
1440 hash_xor_pairs, \
1441 hash, \
1442 p, \
1443 term, \
1444 ESTK_DEF_STACK(s), \
1445 s, \
1446 location_name, \
1447 &ctx, \
1448 sizeof(ctx)); \
1449 return 0; \
1450 L_##location_name: \
1451 ctx = context->trap_location_state. location_name; \
1452 } \
1453 } while(0)
1454
1455 #define TRAP_LOCATION(location_name) \
1456 do { \
1457 if (can_trap) { \
1458 iterations_until_trap--; \
1459 TRAP_LOCATION_NO_RED(location_name); \
1460 } \
1461 } while(0)
1462
1463 #define TRAP_LOCATION_NO_CTX(location_name) \
1464 do { \
1465 ErtsMakeHash2Context_EMPTY ctx; \
1466 TRAP_LOCATION(location_name); \
1467 } while(0)
1468
1469 /* Optimization. Simple cases before declaration of estack. */
1470 if (primary_tag(term) == TAG_PRIMARY_IMMED1) {
1471 switch (term & _TAG_IMMED1_MASK) {
1472 case _TAG_IMMED1_IMMED2:
1473 switch (term & _TAG_IMMED2_MASK) {
1474 case _TAG_IMMED2_ATOM:
1475 /* Fast, but the poor hash value should be mixed. */
1476 return atom_tab(atom_val(term))->slot.bucket.hvalue;
1477 }
1478 break;
1479 case _TAG_IMMED1_SMALL:
1480 {
1481 Sint small = signed_val(term);
1482 if (SMALL_BITS > 28 && !IS_SSMALL28(small)) {
1483 hash = 0;
1484 NOT_SSMALL28_HASH(small);
1485 return hash;
1486 }
1487 hash = 0;
1488 SINT32_HASH(small, HCONST);
1489 return hash;
1490 }
1491 }
1492 };
1493 {
1494 Eterm tmp;
1495 long max_iterations = 0;
1496 long iterations_until_trap = 0;
1497 Eterm state_mref = THE_NON_VALUE;
1498 ErtsMakeHash2Context* context = NULL;
1499 DECLARE_ESTACK(s);
1500 ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
1501 if(can_trap){
1502 #ifdef DEBUG
1503 (void)ITERATIONS_PER_RED;
1504 iterations_until_trap = max_iterations =
1505 (1103515245 * (ERTS_BIF_REDS_LEFT(p)) + 12345) % 227;
1506 #else
1507 iterations_until_trap = max_iterations =
1508 ITERATIONS_PER_RED * ERTS_BIF_REDS_LEFT(p);
1509 #endif
1510 }
1511 if (can_trap && is_internal_magic_ref(term)) {
1512 Binary* state_bin;
1513 state_mref = term;
1514 state_bin = erts_magic_ref2bin(state_mref);
1515 if (ERTS_MAGIC_BIN_DESTRUCTOR(state_bin) == make_hash2_ctx_bin_dtor) {
1516 /* Restore state after a trap */
1517 context = ERTS_MAGIC_BIN_DATA(state_bin);
1518 term = context->term;
1519 hash = context->hash;
1520 hash_xor_pairs = context->hash_xor_pairs;
1521 ESTACK_RESTORE(s, &context->stack);
1522 ASSERT(p->flags & F_DISABLE_GC);
1523 erts_set_gc_state(p, 1);
1524 switch (context->trap_location) {
1525 case hash2_common_3: goto L_hash2_common_3;
1526 case tag_primary_list: goto L_tag_primary_list;
1527 case arityval_subtag: goto L_arityval_subtag;
1528 case hamt_subtag_head_flatmap: goto L_hamt_subtag_head_flatmap;
1529 case map_subtag: goto L_map_subtag;
1530 case fun_subtag: goto L_fun_subtag;
1531 case neg_big_subtag: goto L_neg_big_subtag;
1532 case sub_binary_subtag_1: goto L_sub_binary_subtag_1;
1533 case sub_binary_subtag_2: goto L_sub_binary_subtag_2;
1534 case hash2_common_1: goto L_hash2_common_1;
1535 case hash2_common_2: goto L_hash2_common_2;
1536 }
1537 }
1538 }
1539 hash = 0;
1540 for (;;) {
1541 switch (primary_tag(term)) {
1542 case TAG_PRIMARY_LIST:
1543 {
1544 ErtsMakeHash2Context_TAG_PRIMARY_LIST ctx = {
1545 .c = 0,
1546 .sh = 0,
1547 .ptr = list_val(term)};
1548 while (is_byte(*ctx.ptr)) {
1549 /* Optimization for strings. */
1550 ctx.sh = (ctx.sh << 8) + unsigned_val(*ctx.ptr);
1551 if (ctx.c == 3) {
1552 UINT32_HASH(ctx.sh, HCONST_4);
1553 ctx.c = ctx.sh = 0;
1554 } else {
1555 ctx.c++;
1556 }
1557 term = CDR(ctx.ptr);
1558 if (is_not_list(term))
1559 break;
1560 ctx.ptr = list_val(term);
1561 TRAP_LOCATION(tag_primary_list);
1562 }
1563 if (ctx.c > 0)
1564 UINT32_HASH(ctx.sh, HCONST_4);
1565 if (is_list(term)) {
1566 tmp = CDR(ctx.ptr);
1567 ESTACK_PUSH(s, tmp);
1568 term = CAR(ctx.ptr);
1569 }
1570 }
1571 break;
1572 case TAG_PRIMARY_BOXED:
1573 {
1574 Eterm hdr = *boxed_val(term);
1575 ASSERT(is_header(hdr));
1576 switch (hdr & _TAG_HEADER_MASK) {
1577 case ARITYVAL_SUBTAG:
1578 {
1579 ErtsMakeHash2Context_ARITYVAL_SUBTAG ctx = {
1580 .i = 0,
1581 .arity = header_arity(hdr),
1582 .elem = tuple_val(term)};
1583 UINT32_HASH(ctx.arity, HCONST_9);
1584 if (ctx.arity == 0) /* Empty tuple */
1585 goto hash2_common;
1586 for (ctx.i = ctx.arity; ; ctx.i--) {
1587 term = ctx.elem[ctx.i];
1588 if (ctx.i == 1)
1589 break;
1590 ESTACK_PUSH(s, term);
1591 TRAP_LOCATION(arityval_subtag);
1592 }
1593 }
1594 break;
1595 case MAP_SUBTAG:
1596 {
1597 Uint size;
1598 ErtsMakeHash2Context_MAP_SUBTAG ctx = {
1599 .ptr = boxed_val(term) + 1,
1600 .i = 0};
1601 switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
1602 case HAMT_SUBTAG_HEAD_FLATMAP:
1603 {
1604 flatmap_t *mp = (flatmap_t *)flatmap_val(term);
1605 ErtsMakeHash2Context_HAMT_SUBTAG_HEAD_FLATMAP ctx = {
1606 .ks = flatmap_get_keys(mp),
1607 .vs = flatmap_get_values(mp),
1608 .i = 0,
1609 .size = flatmap_get_size(mp)};
1610 UINT32_HASH(ctx.size, HCONST_16);
1611 if (ctx.size == 0)
1612 goto hash2_common;
1613
1614 /* We want a portable hash function that is *independent* of
1615 * the order in which keys and values are encountered.
1616 * We therefore calculate context independent hashes for all .
1617 * key-value pairs and then xor them together.
1618 */
1619 ESTACK_PUSH(s, hash_xor_pairs);
1620 ESTACK_PUSH(s, hash);
1621 ESTACK_PUSH(s, HASH_MAP_TAIL);
1622 hash = 0;
1623 hash_xor_pairs = 0;
1624 for (ctx.i = ctx.size - 1; ctx.i >= 0; ctx.i--) {
1625 ESTACK_PUSH(s, HASH_MAP_PAIR);
1626 ESTACK_PUSH(s, ctx.vs[ctx.i]);
1627 ESTACK_PUSH(s, ctx.ks[ctx.i]);
1628 TRAP_LOCATION(hamt_subtag_head_flatmap);
1629 }
1630 goto hash2_common;
1631 }
1632
1633 case HAMT_SUBTAG_HEAD_ARRAY:
1634 case HAMT_SUBTAG_HEAD_BITMAP:
1635 size = *ctx.ptr++;
1636 UINT32_HASH(size, HCONST_16);
1637 if (size == 0)
1638 goto hash2_common;
1639 ESTACK_PUSH(s, hash_xor_pairs);
1640 ESTACK_PUSH(s, hash);
1641 ESTACK_PUSH(s, HASH_MAP_TAIL);
1642 hash = 0;
1643 hash_xor_pairs = 0;
1644 }
1645 switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
1646 case HAMT_SUBTAG_HEAD_ARRAY:
1647 ctx.i = 16;
1648 break;
1649 case HAMT_SUBTAG_HEAD_BITMAP:
1650 case HAMT_SUBTAG_NODE_BITMAP:
1651 ctx.i = hashmap_bitcount(MAP_HEADER_VAL(hdr));
1652 break;
1653 default:
1654 erts_exit(ERTS_ERROR_EXIT, "bad header");
1655 }
1656 while (ctx.i) {
1657 if (is_list(*ctx.ptr)) {
1658 Eterm* cons = list_val(*ctx.ptr);
1659 ESTACK_PUSH(s, HASH_MAP_PAIR);
1660 ESTACK_PUSH(s, CDR(cons));
1661 ESTACK_PUSH(s, CAR(cons));
1662 }
1663 else {
1664 ASSERT(is_boxed(*ctx.ptr));
1665 ESTACK_PUSH(s, *ctx.ptr);
1666 }
1667 ctx.i--; ctx.ptr++;
1668 TRAP_LOCATION(map_subtag);
1669 }
1670 goto hash2_common;
1671 }
1672 break;
1673 case EXPORT_SUBTAG:
1674 {
1675 Export* ep = *((Export **) (export_val(term) + 1));
1676 UINT32_HASH_2
1677 (ep->info.mfa.arity,
1678 atom_tab(atom_val(ep->info.mfa.module))->slot.bucket.hvalue,
1679 HCONST);
1680 UINT32_HASH
1681 (atom_tab(atom_val(ep->info.mfa.function))->slot.bucket.hvalue,
1682 HCONST_14);
1683 goto hash2_common;
1684 }
1685
1686 case FUN_SUBTAG:
1687 {
1688 ErlFunThing* funp = (ErlFunThing *) fun_val(term);
1689 ErtsMakeHash2Context_FUN_SUBTAG ctx = {
1690 .num_free = funp->num_free,
1691 .bptr = NULL};
1692 UINT32_HASH_2
1693 (ctx.num_free,
1694 atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue,
1695 HCONST);
1696 UINT32_HASH_2
1697 (funp->fe->index, funp->fe->old_uniq, HCONST);
1698 if (ctx.num_free == 0) {
1699 goto hash2_common;
1700 } else {
1701 ctx.bptr = funp->env + ctx.num_free - 1;
1702 while (ctx.num_free-- > 1) {
1703 term = *ctx.bptr--;
1704 ESTACK_PUSH(s, term);
1705 TRAP_LOCATION(fun_subtag);
1706 }
1707 term = *ctx.bptr;
1708 }
1709 }
1710 break;
1711 case REFC_BINARY_SUBTAG:
1712 case HEAP_BINARY_SUBTAG:
1713 case SUB_BINARY_SUBTAG:
1714 {
1715 #define BYTE_BITS 8
1716 ErtsMakeHash2Context_SUB_BINARY_SUBTAG ctx = {
1717 .bptr = 0,
1718 /* !!!!!!!!!!!!!!!!!!!! OBS !!!!!!!!!!!!!!!!!!!!
1719 *
1720 * The size is truncated to 32 bits on the line
1721 * below so that the code is compatible with old
1722 * versions of the code. This means that hash
1723 * values for binaries with a size greater than
1724 * 4GB do not take all bytes in consideration.
1725 *
1726 * !!!!!!!!!!!!!!!!!!!! OBS !!!!!!!!!!!!!!!!!!!!
1727 */
1728 .sz = (0xFFFFFFFF & binary_size(term)),
1729 .bitsize = 0,
1730 .bitoffs = 0,
1731 .no_bytes_processed = 0
1732 };
1733 Uint32 con = HCONST_13 + hash;
1734 Uint iters_for_bin = MAX(1, ctx.sz / BLOCK_HASH_BYTES_PER_ITER);
1735 ERTS_GET_BINARY_BYTES(term, ctx.bptr, ctx.bitoffs, ctx.bitsize);
1736 if (ctx.sz == 0 && ctx.bitsize == 0) {
1737 hash = con;
1738 } else if (ctx.bitoffs == 0 &&
1739 (!can_trap ||
1740 (iterations_until_trap - iters_for_bin) > 0)) {
1741 /* No need to trap while hashing binary */
1742 if (can_trap) iterations_until_trap -= iters_for_bin;
1743 hash = block_hash(ctx.bptr, ctx.sz, con);
1744 if (ctx.bitsize > 0) {
1745 UINT32_HASH_2(ctx.bitsize,
1746 (ctx.bptr[ctx.sz] >> (BYTE_BITS - ctx.bitsize)),
1747 HCONST_15);
1748 }
1749 } else if (ctx.bitoffs == 0) {
1750 /* Need to trap while hashing binary */
1751 ErtsBlockHashHelperCtx* block_hash_ctx = &ctx.block_hash_ctx;
1752 block_hash_setup(con, block_hash_ctx);
1753 do {
1754 Uint max_bytes_to_process =
1755 iterations_until_trap <= 0 ? BLOCK_HASH_BYTES_PER_ITER :
1756 iterations_until_trap * BLOCK_HASH_BYTES_PER_ITER;
1757 Uint bytes_left = ctx.sz - ctx.no_bytes_processed;
1758 Uint even_bytes_left =
1759 bytes_left - (bytes_left % BLOCK_HASH_BYTES_PER_ITER);
1760 Uint bytes_to_process =
1761 MIN(max_bytes_to_process, even_bytes_left);
1762 block_hash_buffer(&ctx.bptr[ctx.no_bytes_processed],
1763 bytes_to_process,
1764 block_hash_ctx);
1765 ctx.no_bytes_processed += bytes_to_process;
1766 iterations_until_trap -=
1767 MAX(1, bytes_to_process / BLOCK_HASH_BYTES_PER_ITER);
1768 TRAP_LOCATION_NO_RED(sub_binary_subtag_1);
1769 block_hash_ctx = &ctx.block_hash_ctx; /* Restore after trap */
1770 } while ((ctx.sz - ctx.no_bytes_processed) >=
1771 BLOCK_HASH_BYTES_PER_ITER);
1772 hash = block_hash_final_bytes(ctx.bptr +
1773 ctx.no_bytes_processed,
1774 ctx.sz - ctx.no_bytes_processed,
1775 ctx.sz,
1776 block_hash_ctx);
1777 if (ctx.bitsize > 0) {
1778 UINT32_HASH_2(ctx.bitsize,
1779 (ctx.bptr[ctx.sz] >> (BYTE_BITS - ctx.bitsize)),
1780 HCONST_15);
1781 }
1782 } else if (/* ctx.bitoffs != 0 && */
1783 (!can_trap ||
1784 (iterations_until_trap - iters_for_bin) > 0)) {
1785 /* No need to trap while hashing binary */
1786 Uint nr_of_bytes = ctx.sz + (ctx.bitsize != 0);
1787 byte *buf = erts_alloc(ERTS_ALC_T_TMP, nr_of_bytes);
1788 Uint nr_of_bits_to_copy = ctx.sz*BYTE_BITS+ctx.bitsize;
1789 if (can_trap) iterations_until_trap -= iters_for_bin;
1790 erts_copy_bits(ctx.bptr,
1791 ctx.bitoffs, 1, buf, 0, 1, nr_of_bits_to_copy);
1792 hash = block_hash(buf, ctx.sz, con);
1793 if (ctx.bitsize > 0) {
1794 UINT32_HASH_2(ctx.bitsize,
1795 (buf[ctx.sz] >> (BYTE_BITS - ctx.bitsize)),
1796 HCONST_15);
1797 }
1798 erts_free(ERTS_ALC_T_TMP, buf);
1799 } else /* ctx.bitoffs != 0 && */ {
1800 #ifdef DEBUG
1801 #define BINARY_BUF_SIZE (BLOCK_HASH_BYTES_PER_ITER * 3)
1802 #else
1803 #define BINARY_BUF_SIZE (BLOCK_HASH_BYTES_PER_ITER * 256)
1804 #endif
1805 #define BINARY_BUF_SIZE_BITS (BINARY_BUF_SIZE*BYTE_BITS)
1806 /* Need to trap while hashing binary */
1807 ErtsBlockHashHelperCtx* block_hash_ctx = &ctx.block_hash_ctx;
1808 Uint nr_of_bytes = ctx.sz + (ctx.bitsize != 0);
1809 ERTS_CT_ASSERT(BINARY_BUF_SIZE % BLOCK_HASH_BYTES_PER_ITER == 0);
1810 ctx.buf = erts_alloc(ERTS_ALC_T_PHASH2_TRAP,
1811 MIN(nr_of_bytes, BINARY_BUF_SIZE));
1812 block_hash_setup(con, block_hash_ctx);
1813 do {
1814 Uint bytes_left =
1815 ctx.sz - ctx.no_bytes_processed;
1816 Uint even_bytes_left =
1817 bytes_left - (bytes_left % BLOCK_HASH_BYTES_PER_ITER);
1818 Uint bytes_to_process =
1819 MIN(BINARY_BUF_SIZE, even_bytes_left);
1820 Uint nr_of_bits_left =
1821 (ctx.sz*BYTE_BITS+ctx.bitsize) -
1822 ctx.no_bytes_processed*BYTE_BITS;
1823 Uint nr_of_bits_to_copy =
1824 MIN(nr_of_bits_left, BINARY_BUF_SIZE_BITS);
1825 ctx.done = nr_of_bits_left == nr_of_bits_to_copy;
1826 erts_copy_bits(ctx.bptr + ctx.no_bytes_processed,
1827 ctx.bitoffs, 1, ctx.buf, 0, 1,
1828 nr_of_bits_to_copy);
1829 block_hash_buffer(ctx.buf,
1830 bytes_to_process,
1831 block_hash_ctx);
1832 ctx.no_bytes_processed += bytes_to_process;
1833 iterations_until_trap -=
1834 MAX(1, bytes_to_process / BLOCK_HASH_BYTES_PER_ITER);
1835 TRAP_LOCATION_NO_RED(sub_binary_subtag_2);
1836 block_hash_ctx = &ctx.block_hash_ctx; /* Restore after trap */
1837 } while (!ctx.done);
1838 nr_of_bytes = ctx.sz + (ctx.bitsize != 0);
1839 hash = block_hash_final_bytes(ctx.buf +
1840 (ctx.no_bytes_processed -
1841 ((nr_of_bytes-1) / BINARY_BUF_SIZE) * BINARY_BUF_SIZE),
1842 ctx.sz - ctx.no_bytes_processed,
1843 ctx.sz,
1844 block_hash_ctx);
1845 if (ctx.bitsize > 0) {
1846 Uint last_byte_index =
1847 nr_of_bytes - (((nr_of_bytes-1) / BINARY_BUF_SIZE) * BINARY_BUF_SIZE) -1;
1848 UINT32_HASH_2(ctx.bitsize,
1849 (ctx.buf[last_byte_index] >> (BYTE_BITS - ctx.bitsize)),
1850 HCONST_15);
1851 }
1852 erts_free(ERTS_ALC_T_PHASH2_TRAP, ctx.buf);
1853 context->trap_location_state.sub_binary_subtag_2.buf = NULL;
1854 }
1855 goto hash2_common;
1856 #undef BYTE_BITS
1857 #undef BINARY_BUF_SIZE
1858 #undef BINARY_BUF_SIZE_BITS
1859 }
1860 break;
1861 case POS_BIG_SUBTAG:
1862 case NEG_BIG_SUBTAG:
1863 {
1864 Eterm* big_val_ptr = big_val(term);
1865 ErtsMakeHash2Context_NEG_BIG_SUBTAG ctx = {
1866 .ptr = big_val_ptr,
1867 .i = 0,
1868 .n = BIG_SIZE(big_val_ptr),
1869 .con = BIG_SIGN(big_val_ptr) ? HCONST_10 : HCONST_11};
1870 #if D_EXP == 16
1871 do {
1872 Uint32 x, y;
1873 x = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0;
1874 x += (Uint32)(ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0) << 16;
1875 y = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0;
1876 y += (Uint32)(ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0) << 16;
1877 UINT32_HASH_2(x, y, ctx.con);
1878 TRAP_LOCATION(neg_big_subtag);
1879 } while (ctx.i < ctx.n);
1880 #elif D_EXP == 32
1881 do {
1882 Uint32 x, y;
1883 x = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0;
1884 y = ctx.i < ctx.n ? BIG_DIGIT(ctx.ptr, ctx.i++) : 0;
1885 UINT32_HASH_2(x, y, ctx.con);
1886 TRAP_LOCATION(neg_big_subtag);
1887 } while (ctx.i < ctx.n);
1888 #elif D_EXP == 64
1889 do {
1890 Uint t;
1891 Uint32 x, y;
1892 ASSERT(ctx.i < ctx.n);
1893 t = BIG_DIGIT(ctx.ptr, ctx.i++);
1894 x = t & 0xffffffff;
1895 y = t >> 32;
1896 UINT32_HASH_2(x, y, ctx.con);
1897 TRAP_LOCATION(neg_big_subtag);
1898 } while (ctx.i < ctx.n);
1899 #else
1900 #error "unsupported D_EXP size"
1901 #endif
1902 goto hash2_common;
1903 }
1904 break;
1905 case REF_SUBTAG:
1906 /* All parts of the ref should be hashed. */
1907 UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7);
1908 goto hash2_common;
1909 break;
1910 case EXTERNAL_REF_SUBTAG:
1911 /* All parts of the ref should be hashed. */
1912 UINT32_HASH(external_ref_numbers(term)[0], HCONST_7);
1913 goto hash2_common;
1914 break;
1915 case EXTERNAL_PID_SUBTAG:
1916 /* Only 15 bits are hashed. */
1917 UINT32_HASH(external_pid_number(term), HCONST_5);
1918 goto hash2_common;
1919 case EXTERNAL_PORT_SUBTAG: {
1920 Uint64 number = external_port_number(term);
1921 Uint32 low = (Uint32) (number & 0xffffffff);
1922 Uint32 high = (Uint32) ((number >> 32) & 0xffffffff);
1923 UINT32_HASH_2(low, high, HCONST_6);
1924 goto hash2_common;
1925 }
1926 case FLOAT_SUBTAG:
1927 {
1928 FloatDef ff;
1929 GET_DOUBLE(term, ff);
1930 if (ff.fd == 0.0f) {
1931 /* ensure positive 0.0 */
1932 ff.fd = erts_get_positive_zero_float();
1933 }
1934 #if defined(WORDS_BIGENDIAN) || defined(DOUBLE_MIDDLE_ENDIAN)
1935 UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12);
1936 #else
1937 UINT32_HASH_2(ff.fw[1], ff.fw[0], HCONST_12);
1938 #endif
1939 goto hash2_common;
1940 }
1941 break;
1942
1943 default:
1944 erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
1945 }
1946 }
1947 break;
1948 case TAG_PRIMARY_IMMED1:
1949 switch (term & _TAG_IMMED1_MASK) {
1950 case _TAG_IMMED1_PID:
1951 /* Only 15 bits are hashed. */
1952 UINT32_HASH(internal_pid_number(term), HCONST_5);
1953 goto hash2_common;
1954 case _TAG_IMMED1_PORT: {
1955 Uint64 number = internal_port_number(term);
1956 Uint32 low = (Uint32) (number & 0xffffffff);
1957 Uint32 high = (Uint32) ((number >> 32) & 0xffffffff);
1958 UINT32_HASH_2(low, high, HCONST_6);
1959 goto hash2_common;
1960 }
1961 case _TAG_IMMED1_IMMED2:
1962 switch (term & _TAG_IMMED2_MASK) {
1963 case _TAG_IMMED2_ATOM:
1964 if (hash == 0)
1965 /* Fast, but the poor hash value should be mixed. */
1966 hash = atom_tab(atom_val(term))->slot.bucket.hvalue;
1967 else
1968 UINT32_HASH(atom_tab(atom_val(term))->slot.bucket.hvalue,
1969 HCONST_3);
1970 goto hash2_common;
1971 case _TAG_IMMED2_NIL:
1972 if (hash == 0)
1973 hash = 3468870702UL;
1974 else
1975 UINT32_HASH(NIL_DEF, HCONST_2);
1976 goto hash2_common;
1977 default:
1978 erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
1979 }
1980 case _TAG_IMMED1_SMALL:
1981 {
1982 Sint small = signed_val(term);
1983 if (SMALL_BITS > 28 && !IS_SSMALL28(small)) {
1984 NOT_SSMALL28_HASH(small);
1985 } else {
1986 SINT32_HASH(small, HCONST);
1987 }
1988
1989 goto hash2_common;
1990 }
1991 }
1992 break;
1993 default:
1994 erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_hash2(0x%X)\n", term);
1995 hash2_common:
1996
1997 /* Uint32 hash always has the hash value of the previous term,
1998 * compounded or otherwise.
1999 */
2000
2001 if (ESTACK_ISEMPTY(s)) {
2002 DESTROY_ESTACK(s);
2003 if (can_trap) {
2004 BUMP_REDS(p, (max_iterations - iterations_until_trap) / ITERATIONS_PER_RED);
2005 ASSERT(!(p->flags & F_DISABLE_GC));
2006 }
2007 return hash;
2008 }
2009
2010 term = ESTACK_POP(s);
2011
2012 switch (term) {
2013 case HASH_MAP_TAIL: {
2014 hash = (Uint32) ESTACK_POP(s);
2015 UINT32_HASH(hash_xor_pairs, HCONST_19);
2016 hash_xor_pairs = (Uint32) ESTACK_POP(s);
2017 TRAP_LOCATION_NO_CTX(hash2_common_1);
2018 goto hash2_common;
2019 }
2020 case HASH_MAP_PAIR:
2021 hash_xor_pairs ^= hash;
2022 hash = 0;
2023 TRAP_LOCATION_NO_CTX(hash2_common_2);
2024 goto hash2_common;
2025 default:
2026 break;
2027 }
2028
2029 }
2030 TRAP_LOCATION_NO_CTX(hash2_common_3);
2031 }
2032 }
2033 #undef TRAP_LOCATION_NO_RED
2034 #undef TRAP_LOCATION
2035 #undef TRAP_LOCATION_NO_CTX
2036 }
2037
2038 Uint32
make_hash2(Eterm term)2039 make_hash2(Eterm term)
2040 {
2041 return make_hash2_helper(term, 0, NULL, NULL);
2042 }
2043
2044 Uint32
trapping_make_hash2(Eterm term,Eterm * state_mref_write_back,Process * p)2045 trapping_make_hash2(Eterm term, Eterm* state_mref_write_back, Process* p)
2046 {
2047 return make_hash2_helper(term, 1, state_mref_write_back, p);
2048 }
2049
2050 /* Term hash function for internal use.
2051 *
2052 * Limitation #1: Is not "portable" in any way between different VM instances.
2053 *
2054 * Limitation #2: The hash value is only valid as long as the term exists
2055 * somewhere in the VM. Why? Because external pids, ports and refs are hashed
2056 * by mixing the node *pointer* value. If a node disappears and later reappears
2057 * with a new ErlNode struct, externals from that node will hash different than
2058 * before.
2059 *
2060 * One IMPORTANT property must hold (for hamt).
2061 * EVERY BIT of the term that is significant for equality (see EQ)
2062 * MUST BE USED AS INPUT FOR THE HASH. Two different terms must always have a
2063 * chance of hashing different when salted.
2064 *
2065 * This is why we cannot use cached hash values for atoms for example.
2066 *
2067 */
2068
2069 #define CONST_HASH(AConst) \
2070 do { /* Lightweight mixing of constant (type info) */ \
2071 hash ^= AConst; \
2072 hash = (hash << 17) ^ (hash >> (32-17)); \
2073 } while (0)
2074
2075 /*
2076 * Start with salt, 32-bit prime number, to avoid getting same hash as phash2
2077 * which can cause bad hashing in distributed ETS tables for example.
2078 */
2079 #define INTERNAL_HASH_SALT 3432918353U
2080
2081 Uint32
make_internal_hash(Eterm term,Uint32 salt)2082 make_internal_hash(Eterm term, Uint32 salt)
2083 {
2084 Uint32 hash = salt ^ INTERNAL_HASH_SALT;
2085
2086 /* Optimization. Simple cases before declaration of estack. */
2087 if (primary_tag(term) == TAG_PRIMARY_IMMED1) {
2088 #if ERTS_SIZEOF_ETERM == 8
2089 UINT32_HASH_2((Uint32)term, (Uint32)(term >> 32), HCONST);
2090 #elif ERTS_SIZEOF_ETERM == 4
2091 UINT32_HASH(term, HCONST);
2092 #else
2093 # error "No you don't"
2094 #endif
2095 return hash;
2096 }
2097 {
2098 Eterm tmp;
2099 DECLARE_ESTACK(s);
2100
2101 for (;;) {
2102 switch (primary_tag(term)) {
2103 case TAG_PRIMARY_LIST:
2104 {
2105 int c = 0;
2106 Uint32 sh = 0;
2107 Eterm* ptr = list_val(term);
2108 while (is_byte(*ptr)) {
2109 /* Optimization for strings. */
2110 sh = (sh << 8) + unsigned_val(*ptr);
2111 if (c == 3) {
2112 UINT32_HASH(sh, HCONST_4);
2113 c = sh = 0;
2114 } else {
2115 c++;
2116 }
2117 term = CDR(ptr);
2118 if (is_not_list(term))
2119 break;
2120 ptr = list_val(term);
2121 }
2122 if (c > 0)
2123 UINT32_HASH_2(sh, (Uint32)c, HCONST_22);
2124
2125 if (is_list(term)) {
2126 tmp = CDR(ptr);
2127 CONST_HASH(HCONST_17); /* Hash CAR in cons cell */
2128 ESTACK_PUSH(s, tmp);
2129 if (is_not_list(tmp)) {
2130 ESTACK_PUSH(s, HASH_CDR);
2131 }
2132 term = CAR(ptr);
2133 }
2134 }
2135 break;
2136 case TAG_PRIMARY_BOXED:
2137 {
2138 Eterm hdr = *boxed_val(term);
2139 ASSERT(is_header(hdr));
2140 switch (hdr & _TAG_HEADER_MASK) {
2141 case ARITYVAL_SUBTAG:
2142 {
2143 int i;
2144 int arity = header_arity(hdr);
2145 Eterm* elem = tuple_val(term);
2146 UINT32_HASH(arity, HCONST_9);
2147 if (arity == 0) /* Empty tuple */
2148 goto pop_next;
2149 for (i = arity; ; i--) {
2150 term = elem[i];
2151 if (i == 1)
2152 break;
2153 ESTACK_PUSH(s, term);
2154 }
2155 }
2156 break;
2157
2158 case MAP_SUBTAG:
2159 {
2160 Eterm* ptr = boxed_val(term) + 1;
2161 Uint size;
2162 int i;
2163
2164 /*
2165 * We rely on key-value iteration order being constant
2166 * for identical maps (in this VM instance).
2167 */
2168 switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
2169 case HAMT_SUBTAG_HEAD_FLATMAP:
2170 {
2171 flatmap_t *mp = (flatmap_t *)flatmap_val(term);
2172 Eterm *ks = flatmap_get_keys(mp);
2173 Eterm *vs = flatmap_get_values(mp);
2174 size = flatmap_get_size(mp);
2175 UINT32_HASH(size, HCONST_16);
2176 if (size == 0)
2177 goto pop_next;
2178
2179 for (i = size - 1; i >= 0; i--) {
2180 ESTACK_PUSH(s, vs[i]);
2181 ESTACK_PUSH(s, ks[i]);
2182 }
2183 goto pop_next;
2184 }
2185 case HAMT_SUBTAG_HEAD_ARRAY:
2186 case HAMT_SUBTAG_HEAD_BITMAP:
2187 size = *ptr++;
2188 UINT32_HASH(size, HCONST_16);
2189 if (size == 0)
2190 goto pop_next;
2191 }
2192 switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
2193 case HAMT_SUBTAG_HEAD_ARRAY:
2194 i = 16;
2195 break;
2196 case HAMT_SUBTAG_HEAD_BITMAP:
2197 case HAMT_SUBTAG_NODE_BITMAP:
2198 i = hashmap_bitcount(MAP_HEADER_VAL(hdr));
2199 break;
2200 default:
2201 erts_exit(ERTS_ERROR_EXIT, "bad header");
2202 }
2203 while (i) {
2204 if (is_list(*ptr)) {
2205 Eterm* cons = list_val(*ptr);
2206 ESTACK_PUSH(s, CDR(cons));
2207 ESTACK_PUSH(s, CAR(cons));
2208 }
2209 else {
2210 ASSERT(is_boxed(*ptr));
2211 ESTACK_PUSH(s, *ptr);
2212 }
2213 i--; ptr++;
2214 }
2215 goto pop_next;
2216 }
2217 break;
2218 case EXPORT_SUBTAG:
2219 {
2220 Export* ep = *((Export **) (export_val(term) + 1));
2221 /* Assumes Export entries never move */
2222 POINTER_HASH(ep, HCONST_14);
2223 goto pop_next;
2224 }
2225
2226 case FUN_SUBTAG:
2227 {
2228 ErlFunThing* funp = (ErlFunThing *) fun_val(term);
2229 Uint num_free = funp->num_free;
2230 UINT32_HASH_2(num_free, funp->fe->module, HCONST_20);
2231 UINT32_HASH_2(funp->fe->index, funp->fe->old_uniq, HCONST_21);
2232 if (num_free == 0) {
2233 goto pop_next;
2234 } else {
2235 Eterm* bptr = funp->env + num_free - 1;
2236 while (num_free-- > 1) {
2237 term = *bptr--;
2238 ESTACK_PUSH(s, term);
2239 }
2240 term = *bptr;
2241 }
2242 }
2243 break;
2244 case REFC_BINARY_SUBTAG:
2245 case HEAP_BINARY_SUBTAG:
2246 case SUB_BINARY_SUBTAG:
2247 {
2248 byte* bptr;
2249 Uint sz = binary_size(term);
2250 Uint32 con = HCONST_13 + hash;
2251 Uint bitoffs;
2252 Uint bitsize;
2253
2254 ERTS_GET_BINARY_BYTES(term, bptr, bitoffs, bitsize);
2255 if (sz == 0 && bitsize == 0) {
2256 hash = con;
2257 } else {
2258 if (bitoffs == 0) {
2259 hash = block_hash(bptr, sz, con);
2260 if (bitsize > 0) {
2261 UINT32_HASH_2(bitsize, (bptr[sz] >> (8 - bitsize)),
2262 HCONST_15);
2263 }
2264 } else {
2265 byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP,
2266 sz + (bitsize != 0));
2267 erts_copy_bits(bptr, bitoffs, 1, buf, 0, 1, sz*8+bitsize);
2268 hash = block_hash(buf, sz, con);
2269 if (bitsize > 0) {
2270 UINT32_HASH_2(bitsize, (buf[sz] >> (8 - bitsize)),
2271 HCONST_15);
2272 }
2273 erts_free(ERTS_ALC_T_TMP, (void *) buf);
2274 }
2275 }
2276 goto pop_next;
2277 }
2278 break;
2279 case POS_BIG_SUBTAG:
2280 case NEG_BIG_SUBTAG:
2281 {
2282 Eterm* ptr = big_val(term);
2283 Uint i = 0;
2284 Uint n = BIG_SIZE(ptr);
2285 Uint32 con = BIG_SIGN(ptr) ? HCONST_10 : HCONST_11;
2286 #if D_EXP == 16
2287 do {
2288 Uint32 x, y;
2289 x = i < n ? BIG_DIGIT(ptr, i++) : 0;
2290 x += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16;
2291 y = i < n ? BIG_DIGIT(ptr, i++) : 0;
2292 y += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16;
2293 UINT32_HASH_2(x, y, con);
2294 } while (i < n);
2295 #elif D_EXP == 32
2296 do {
2297 Uint32 x, y;
2298 x = i < n ? BIG_DIGIT(ptr, i++) : 0;
2299 y = i < n ? BIG_DIGIT(ptr, i++) : 0;
2300 UINT32_HASH_2(x, y, con);
2301 } while (i < n);
2302 #elif D_EXP == 64
2303 do {
2304 Uint t;
2305 Uint32 x, y;
2306 ASSERT(i < n);
2307 t = BIG_DIGIT(ptr, i++);
2308 x = t & 0xffffffff;
2309 y = t >> 32;
2310 UINT32_HASH_2(x, y, con);
2311 } while (i < n);
2312 #else
2313 #error "unsupported D_EXP size"
2314 #endif
2315 goto pop_next;
2316 }
2317 break;
2318 case REF_SUBTAG:
2319 UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7);
2320 ASSERT(internal_ref_no_numbers(term) == 3);
2321 UINT32_HASH_2(internal_ref_numbers(term)[1],
2322 internal_ref_numbers(term)[2], HCONST_8);
2323 goto pop_next;
2324
2325 case EXTERNAL_REF_SUBTAG:
2326 {
2327 ExternalThing* thing = external_thing_ptr(term);
2328
2329 ASSERT(external_thing_ref_no_numbers(thing) == 3);
2330 /* See limitation #2 */
2331 #ifdef ARCH_64
2332 POINTER_HASH(thing->node, HCONST_7);
2333 UINT32_HASH(external_thing_ref_numbers(thing)[0], HCONST_7);
2334 #else
2335 UINT32_HASH_2(thing->node,
2336 external_thing_ref_numbers(thing)[0], HCONST_7);
2337 #endif
2338 UINT32_HASH_2(external_thing_ref_numbers(thing)[1],
2339 external_thing_ref_numbers(thing)[2], HCONST_8);
2340 goto pop_next;
2341 }
2342 case EXTERNAL_PID_SUBTAG: {
2343 ExternalThing* thing = external_thing_ptr(term);
2344 /* See limitation #2 */
2345 POINTER_HASH(thing->node, HCONST_5);
2346 UINT32_HASH_2(thing->data.pid.num, thing->data.pid.ser, HCONST_5);
2347 goto pop_next;
2348 }
2349 case EXTERNAL_PORT_SUBTAG: {
2350 ExternalThing* thing = external_thing_ptr(term);
2351 /* See limitation #2 */
2352 POINTER_HASH(thing->node, HCONST_6);
2353 UINT32_HASH_2(thing->data.ui32[0], thing->data.ui32[1], HCONST_6);
2354 goto pop_next;
2355 }
2356 case FLOAT_SUBTAG:
2357 {
2358 FloatDef ff;
2359 GET_DOUBLE(term, ff);
2360 if (ff.fd == 0.0f) {
2361 /* ensure positive 0.0 */
2362 ff.fd = erts_get_positive_zero_float();
2363 }
2364 UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12);
2365 goto pop_next;
2366 }
2367 default:
2368 erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_internal_hash(0x%X, %lu)\n", term, salt);
2369 }
2370 }
2371 break;
2372 case TAG_PRIMARY_IMMED1:
2373 #if ERTS_SIZEOF_ETERM == 8
2374 UINT32_HASH_2((Uint32)term, (Uint32)(term >> 32), HCONST);
2375 #else
2376 UINT32_HASH(term, HCONST);
2377 #endif
2378 goto pop_next;
2379
2380 default:
2381 erts_exit(ERTS_ERROR_EXIT, "Invalid tag in make_internal_hash(0x%X, %lu)\n", term, salt);
2382
2383 pop_next:
2384 if (ESTACK_ISEMPTY(s)) {
2385 DESTROY_ESTACK(s);
2386
2387 return hash;
2388 }
2389
2390 term = ESTACK_POP(s);
2391
2392 switch (term) {
2393 case HASH_CDR:
2394 CONST_HASH(HCONST_18); /* Hash CDR i cons cell */
2395 goto pop_next;
2396 default:
2397 break;
2398 }
2399 }
2400 }
2401 }
2402
2403 #undef CONST_HASH
2404 #undef HASH_MAP_TAIL
2405 #undef HASH_MAP_PAIR
2406 #undef HASH_CDR
2407
2408 #undef UINT32_HASH_2
2409 #undef UINT32_HASH
2410 #undef SINT32_HASH
2411 }
2412
2413 #undef HCONST
2414 #undef MIX
2415
2416 /* error_logger !
2417 {log, Level, format, [args], #{ gl, pid, time, error_logger => #{tag, emulator => true} }}
2418 */
2419 static Eterm
do_allocate_logger_message(Eterm gleader,ErtsMonotonicTime * ts,Eterm * pid,Eterm ** hp,ErlOffHeap ** ohp,ErlHeapFragment ** bp,Uint sz)2420 do_allocate_logger_message(Eterm gleader, ErtsMonotonicTime *ts, Eterm *pid,
2421 Eterm **hp, ErlOffHeap **ohp,
2422 ErlHeapFragment **bp, Uint sz)
2423 {
2424 Uint gl_sz;
2425 gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader);
2426 sz = sz + gl_sz + 6 /*outer 5-tuple*/
2427 + MAP2_SZ /* error_logger map */;
2428
2429 *pid = erts_get_current_pid();
2430
2431 if (is_nil(gleader) && is_non_value(*pid)) {
2432 sz += MAP2_SZ /* metadata map no gl, no pid */;
2433 } else if (is_nil(gleader) || is_non_value(*pid))
2434 sz += MAP3_SZ /* metadata map no gl or no pid*/;
2435 else
2436 sz += MAP4_SZ /* metadata map w gl w pid*/;
2437
2438 *ts = ERTS_MONOTONIC_TO_USEC(erts_os_system_time());
2439 erts_bld_sint64(NULL, &sz, *ts);
2440
2441 *bp = new_message_buffer(sz);
2442 *ohp = &(*bp)->off_heap;
2443 *hp = (*bp)->mem;
2444
2445 return copy_struct(gleader,gl_sz,hp,*ohp);
2446 }
2447
do_send_logger_message(Eterm gl,Eterm tag,Eterm format,Eterm args,ErtsMonotonicTime ts,Eterm pid,Eterm * hp,ErlHeapFragment * bp)2448 static void do_send_logger_message(Eterm gl, Eterm tag, Eterm format, Eterm args,
2449 ErtsMonotonicTime ts, Eterm pid,
2450 Eterm *hp, ErlHeapFragment *bp)
2451 {
2452 Eterm message, md, el_tag = tag;
2453 Eterm time = erts_bld_sint64(&hp, NULL, ts);
2454
2455 /* This mapping is needed for the backwards compatible error_logger */
2456 switch (tag) {
2457 case am_info: el_tag = am_info_msg; break;
2458 case am_warning: el_tag = am_warning_msg; break;
2459 default:
2460 ASSERT(am_error);
2461 break;
2462 }
2463
2464 md = MAP2(hp, am_emulator, am_true, ERTS_MAKE_AM("tag"), el_tag);
2465 hp += MAP2_SZ;
2466
2467 if (is_nil(gl) && is_non_value(pid)) {
2468 /* no gl and no pid, probably from a port */
2469 md = MAP2(hp,
2470 am_error_logger, md,
2471 am_time, time);
2472 hp += MAP2_SZ;
2473 pid = NIL;
2474 } else if (is_nil(gl)) {
2475 /* no gl */
2476 md = MAP3(hp,
2477 am_error_logger, md,
2478 am_pid, pid,
2479 am_time, time);
2480 hp += MAP3_SZ;
2481 } else if (is_non_value(pid)) {
2482 /* no gl */
2483 md = MAP3(hp,
2484 am_error_logger, md,
2485 ERTS_MAKE_AM("gl"), gl,
2486 am_time, time);
2487 hp += MAP3_SZ;
2488 pid = NIL;
2489 } else {
2490 md = MAP4(hp,
2491 am_error_logger, md,
2492 ERTS_MAKE_AM("gl"), gl,
2493 am_pid, pid,
2494 am_time, time);
2495 hp += MAP4_SZ;
2496 }
2497
2498 message = TUPLE5(hp, am_log, tag, format, args, md);
2499 erts_queue_error_logger_message(pid, message, bp);
2500 }
2501
do_send_to_logger(Eterm tag,Eterm gl,char * buf,size_t len)2502 static int do_send_to_logger(Eterm tag, Eterm gl, char *buf, size_t len)
2503 {
2504 Uint sz;
2505 Eterm list, args, format, pid;
2506 ErtsMonotonicTime ts;
2507
2508 Eterm *hp = NULL;
2509 ErlOffHeap *ohp = NULL;
2510 ErlHeapFragment *bp = NULL;
2511
2512 sz = len * 2 /* message list */ + 2 /* cons surrounding message list */
2513 + 8 /* "~s~n" */;
2514
2515 /* gleader size is accounted and allocated next */
2516 gl = do_allocate_logger_message(gl, &ts, &pid, &hp, &ohp, &bp, sz);
2517
2518 list = buf_to_intlist(&hp, buf, len, NIL);
2519 args = CONS(hp,list,NIL);
2520 hp += 2;
2521 format = buf_to_intlist(&hp, "~s~n", 4, NIL);
2522
2523 do_send_logger_message(gl, tag, format, args, ts, pid, hp, bp);
2524 return 0;
2525 }
2526
do_send_term_to_logger(Eterm tag,Eterm gl,char * buf,size_t len,Eterm args)2527 static int do_send_term_to_logger(Eterm tag, Eterm gl,
2528 char *buf, size_t len, Eterm args)
2529 {
2530 Uint sz;
2531 Uint args_sz;
2532 Eterm format, pid;
2533 ErtsMonotonicTime ts;
2534
2535 Eterm *hp = NULL;
2536 ErlOffHeap *ohp = NULL;
2537 ErlHeapFragment *bp = NULL;
2538
2539 ASSERT(len > 0);
2540
2541 args_sz = size_object(args);
2542 sz = len * 2 /* format */ + args_sz;
2543
2544 /* gleader size is accounted and allocated next */
2545 gl = do_allocate_logger_message(gl, &ts, &pid, &hp, &ohp, &bp, sz);
2546
2547 format = buf_to_intlist(&hp, buf, len, NIL);
2548 args = copy_struct(args, args_sz, &hp, ohp);
2549
2550 do_send_logger_message(gl, tag, format, args, ts, pid, hp, bp);
2551 return 0;
2552 }
2553
2554 static ERTS_INLINE int
send_info_to_logger(Eterm gleader,char * buf,size_t len)2555 send_info_to_logger(Eterm gleader, char *buf, size_t len)
2556 {
2557 return do_send_to_logger(am_info, gleader, buf, len);
2558 }
2559
2560 static ERTS_INLINE int
send_warning_to_logger(Eterm gleader,char * buf,size_t len)2561 send_warning_to_logger(Eterm gleader, char *buf, size_t len)
2562 {
2563 return do_send_to_logger(erts_error_logger_warnings, gleader, buf, len);
2564 }
2565
2566 static ERTS_INLINE int
send_error_to_logger(Eterm gleader,char * buf,size_t len)2567 send_error_to_logger(Eterm gleader, char *buf, size_t len)
2568 {
2569 return do_send_to_logger(am_error, gleader, buf, len);
2570 }
2571
2572 static ERTS_INLINE int
send_error_term_to_logger(Eterm gleader,char * buf,size_t len,Eterm args)2573 send_error_term_to_logger(Eterm gleader, char *buf, size_t len, Eterm args)
2574 {
2575 return do_send_term_to_logger(am_error, gleader, buf, len, args);
2576 }
2577
2578 #define LOGGER_DSBUF_INC_SZ 256
2579
2580 static erts_dsprintf_buf_t *
grow_logger_dsbuf(erts_dsprintf_buf_t * dsbufp,size_t need)2581 grow_logger_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need)
2582 {
2583 size_t size;
2584 size_t free_size = dsbufp->size - dsbufp->str_len;
2585
2586 ASSERT(dsbufp && dsbufp->str);
2587
2588 if (need <= free_size)
2589 return dsbufp;
2590
2591 size = need - free_size + LOGGER_DSBUF_INC_SZ;
2592 size = (((size + LOGGER_DSBUF_INC_SZ - 1) / LOGGER_DSBUF_INC_SZ)
2593 * LOGGER_DSBUF_INC_SZ);
2594 size += dsbufp->size;
2595 ASSERT(dsbufp->str_len + need <= size);
2596 dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_LOGGER_DSBUF,
2597 (void *) dsbufp->str,
2598 size);
2599 dsbufp->size = size;
2600 return dsbufp;
2601 }
2602
2603 erts_dsprintf_buf_t *
erts_create_logger_dsbuf(void)2604 erts_create_logger_dsbuf(void)
2605 {
2606 erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_logger_dsbuf);
2607 erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_LOGGER_DSBUF,
2608 sizeof(erts_dsprintf_buf_t));
2609 sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t));
2610 dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_LOGGER_DSBUF,
2611 LOGGER_DSBUF_INC_SZ);
2612 dsbufp->str[0] = '\0';
2613 dsbufp->size = LOGGER_DSBUF_INC_SZ;
2614 return dsbufp;
2615 }
2616
2617 static ERTS_INLINE void
destroy_logger_dsbuf(erts_dsprintf_buf_t * dsbufp)2618 destroy_logger_dsbuf(erts_dsprintf_buf_t *dsbufp)
2619 {
2620 ASSERT(dsbufp && dsbufp->str);
2621 erts_free(ERTS_ALC_T_LOGGER_DSBUF, (void *) dsbufp->str);
2622 erts_free(ERTS_ALC_T_LOGGER_DSBUF, (void *) dsbufp);
2623 }
2624
2625 int
erts_send_info_to_logger(Eterm gleader,erts_dsprintf_buf_t * dsbufp)2626 erts_send_info_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
2627 {
2628 int res;
2629 res = send_info_to_logger(gleader, dsbufp->str, dsbufp->str_len);
2630 destroy_logger_dsbuf(dsbufp);
2631 return res;
2632 }
2633
2634 int
erts_send_warning_to_logger(Eterm gleader,erts_dsprintf_buf_t * dsbufp)2635 erts_send_warning_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
2636 {
2637 int res;
2638 res = send_warning_to_logger(gleader, dsbufp->str, dsbufp->str_len);
2639 destroy_logger_dsbuf(dsbufp);
2640 return res;
2641 }
2642
2643 int
erts_send_error_to_logger(Eterm gleader,erts_dsprintf_buf_t * dsbufp)2644 erts_send_error_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
2645 {
2646 int res;
2647 res = send_error_to_logger(gleader, dsbufp->str, dsbufp->str_len);
2648 destroy_logger_dsbuf(dsbufp);
2649 return res;
2650 }
2651
2652 int
erts_send_error_term_to_logger(Eterm gleader,erts_dsprintf_buf_t * dsbufp,Eterm args)2653 erts_send_error_term_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp, Eterm args)
2654 {
2655 int res;
2656 res = send_error_term_to_logger(gleader, dsbufp->str, dsbufp->str_len, args);
2657 destroy_logger_dsbuf(dsbufp);
2658 return res;
2659 }
2660
2661 int
erts_send_info_to_logger_str(Eterm gleader,char * str)2662 erts_send_info_to_logger_str(Eterm gleader, char *str)
2663 {
2664 return send_info_to_logger(gleader, str, sys_strlen(str));
2665 }
2666
2667 int
erts_send_warning_to_logger_str(Eterm gleader,char * str)2668 erts_send_warning_to_logger_str(Eterm gleader, char *str)
2669 {
2670 return send_warning_to_logger(gleader, str, sys_strlen(str));
2671 }
2672
2673 int
erts_send_error_to_logger_str(Eterm gleader,char * str)2674 erts_send_error_to_logger_str(Eterm gleader, char *str)
2675 {
2676 return send_error_to_logger(gleader, str, sys_strlen(str));
2677 }
2678
2679 int
erts_send_info_to_logger_nogl(erts_dsprintf_buf_t * dsbuf)2680 erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *dsbuf)
2681 {
2682 return erts_send_info_to_logger(NIL, dsbuf);
2683 }
2684
2685 int
erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t * dsbuf)2686 erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *dsbuf)
2687 {
2688 return erts_send_warning_to_logger(NIL, dsbuf);
2689 }
2690
2691 int
erts_send_error_to_logger_nogl(erts_dsprintf_buf_t * dsbuf)2692 erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *dsbuf)
2693 {
2694 return erts_send_error_to_logger(NIL, dsbuf);
2695 }
2696
2697 int
erts_send_info_to_logger_str_nogl(char * str)2698 erts_send_info_to_logger_str_nogl(char *str)
2699 {
2700 return erts_send_info_to_logger_str(NIL, str);
2701 }
2702
2703 int
erts_send_warning_to_logger_str_nogl(char * str)2704 erts_send_warning_to_logger_str_nogl(char *str)
2705 {
2706 return erts_send_warning_to_logger_str(NIL, str);
2707 }
2708
2709 int
erts_send_error_to_logger_str_nogl(char * str)2710 erts_send_error_to_logger_str_nogl(char *str)
2711 {
2712 return erts_send_error_to_logger_str(NIL, str);
2713 }
2714
2715
2716 #define TMP_DSBUF_INC_SZ 256
2717
2718 static erts_dsprintf_buf_t *
grow_tmp_dsbuf(erts_dsprintf_buf_t * dsbufp,size_t need)2719 grow_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need)
2720 {
2721 size_t size;
2722 size_t free_size = dsbufp->size - dsbufp->str_len;
2723
2724 ASSERT(dsbufp);
2725
2726 if (need <= free_size)
2727 return dsbufp;
2728 size = need - free_size + TMP_DSBUF_INC_SZ;
2729 size = ((size + TMP_DSBUF_INC_SZ - 1)/TMP_DSBUF_INC_SZ)*TMP_DSBUF_INC_SZ;
2730 size += dsbufp->size;
2731 ASSERT(dsbufp->str_len + need <= size);
2732 dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_TMP_DSBUF,
2733 (void *) dsbufp->str,
2734 size);
2735 dsbufp->size = size;
2736 return dsbufp;
2737 }
2738
2739 erts_dsprintf_buf_t *
erts_create_tmp_dsbuf(Uint size)2740 erts_create_tmp_dsbuf(Uint size)
2741 {
2742 Uint init_size = size ? size : TMP_DSBUF_INC_SZ;
2743 erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_tmp_dsbuf);
2744 erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_TMP_DSBUF,
2745 sizeof(erts_dsprintf_buf_t));
2746 sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t));
2747 dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_TMP_DSBUF, init_size);
2748 dsbufp->str[0] = '\0';
2749 dsbufp->size = init_size;
2750 return dsbufp;
2751 }
2752
2753 void
erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t * dsbufp)2754 erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp)
2755 {
2756 if (dsbufp->str)
2757 erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp->str);
2758 erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp);
2759 }
2760
2761 /* eq and cmp are written as separate functions a eq is a little faster */
2762
2763 /*
2764 * Test for equality of two terms.
2765 * Returns 0 if not equal, or a non-zero value otherwise.
2766 */
eq(Eterm a,Eterm b)2767 int eq(Eterm a, Eterm b)
2768 {
2769 DECLARE_WSTACK(stack);
2770 Sint sz;
2771 Eterm* aa;
2772 Eterm* bb;
2773
2774 tailrecur:
2775 if (is_same(a, b)) goto pop_next;
2776 tailrecur_ne:
2777
2778 switch (primary_tag(a)) {
2779 case TAG_PRIMARY_LIST:
2780 if (is_list(b)) {
2781 Eterm* aval = list_val(a);
2782 Eterm* bval = list_val(b);
2783 while (1) {
2784 Eterm atmp = CAR(aval);
2785 Eterm btmp = CAR(bval);
2786 if (!is_same(atmp,btmp)) {
2787 WSTACK_PUSH2(stack,(UWord) CDR(bval),(UWord) CDR(aval));
2788 a = atmp;
2789 b = btmp;
2790 goto tailrecur_ne;
2791 }
2792 atmp = CDR(aval);
2793 btmp = CDR(bval);
2794 if (is_same(atmp,btmp)) {
2795 goto pop_next;
2796 }
2797 if (is_not_list(atmp) || is_not_list(btmp)) {
2798 a = atmp;
2799 b = btmp;
2800 goto tailrecur_ne;
2801 }
2802 aval = list_val(atmp);
2803 bval = list_val(btmp);
2804 }
2805 }
2806 break; /* not equal */
2807
2808 case TAG_PRIMARY_BOXED:
2809 {
2810 Eterm hdr = *boxed_val(a);
2811 switch (hdr & _TAG_HEADER_MASK) {
2812 case ARITYVAL_SUBTAG:
2813 {
2814 aa = tuple_val(a);
2815 if (!is_boxed(b) || *boxed_val(b) != *aa)
2816 goto not_equal;
2817 bb = tuple_val(b);
2818 if ((sz = arityval(*aa)) == 0) goto pop_next;
2819 ++aa;
2820 ++bb;
2821 goto term_array;
2822 }
2823 case REFC_BINARY_SUBTAG:
2824 case HEAP_BINARY_SUBTAG:
2825 case SUB_BINARY_SUBTAG:
2826 {
2827 byte* a_ptr;
2828 byte* b_ptr;
2829 size_t a_size;
2830 size_t b_size;
2831 Uint a_bitsize;
2832 Uint b_bitsize;
2833 Uint a_bitoffs;
2834 Uint b_bitoffs;
2835
2836 if (!is_binary(b)) {
2837 goto not_equal;
2838 }
2839 a_size = binary_size(a);
2840 b_size = binary_size(b);
2841 if (a_size != b_size) {
2842 goto not_equal;
2843 }
2844 ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
2845 ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
2846 if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
2847 if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next;
2848 } else if (a_bitsize == b_bitsize) {
2849 if (erts_cmp_bits(a_ptr, a_bitoffs, b_ptr, b_bitoffs,
2850 (a_size << 3) + a_bitsize) == 0) goto pop_next;
2851 }
2852 break; /* not equal */
2853 }
2854 case EXPORT_SUBTAG:
2855 {
2856 if (is_export(b)) {
2857 Export* a_exp = *((Export **) (export_val(a) + 1));
2858 Export* b_exp = *((Export **) (export_val(b) + 1));
2859 if (a_exp == b_exp) goto pop_next;
2860 }
2861 break; /* not equal */
2862 }
2863 case FUN_SUBTAG:
2864 {
2865 ErlFunThing* f1;
2866 ErlFunThing* f2;
2867
2868 if (!is_fun(b))
2869 goto not_equal;
2870 f1 = (ErlFunThing *) fun_val(a);
2871 f2 = (ErlFunThing *) fun_val(b);
2872 if (f1->fe->module != f2->fe->module ||
2873 f1->fe->index != f2->fe->index ||
2874 f1->fe->old_uniq != f2->fe->old_uniq ||
2875 f1->num_free != f2->num_free) {
2876 goto not_equal;
2877 }
2878 if ((sz = f1->num_free) == 0) goto pop_next;
2879 aa = f1->env;
2880 bb = f2->env;
2881 goto term_array;
2882 }
2883
2884 case EXTERNAL_PID_SUBTAG: {
2885 ExternalThing *ap;
2886 ExternalThing *bp;
2887 int i;
2888
2889 if(!is_external(b))
2890 goto not_equal;
2891
2892 ap = external_thing_ptr(a);
2893 bp = external_thing_ptr(b);
2894
2895 if(ap->header != bp->header || ap->node != bp->node)
2896 goto not_equal;
2897
2898 ASSERT(external_data_words(a) == EXTERNAL_PID_DATA_WORDS);
2899 ASSERT(external_data_words(b) == EXTERNAL_PID_DATA_WORDS);
2900
2901 for (i = 0; i < EXTERNAL_PID_DATA_WORDS; i++) {
2902 if (ap->data.ui[i] != bp->data.ui[i])
2903 goto not_equal;
2904 }
2905 goto pop_next;
2906 }
2907 case EXTERNAL_PORT_SUBTAG: {
2908 ExternalThing *ap;
2909 ExternalThing *bp;
2910 int i;
2911
2912 if(!is_external(b))
2913 goto not_equal;
2914
2915 ap = external_thing_ptr(a);
2916 bp = external_thing_ptr(b);
2917
2918 if(ap->header != bp->header || ap->node != bp->node)
2919 goto not_equal;
2920
2921 ASSERT(EXTERNAL_PORT_DATA_WORDS == external_data_words(a));
2922 ASSERT(EXTERNAL_PORT_DATA_WORDS == external_data_words(b));
2923
2924 for (i = 0; i < EXTERNAL_PORT_DATA_WORDS; i++) {
2925 if (ap->data.ui[i] != bp->data.ui[i])
2926 goto not_equal;
2927 }
2928 goto pop_next;
2929 }
2930 case EXTERNAL_REF_SUBTAG: {
2931 /*
2932 * Observe!
2933 * When comparing refs we need to compare ref numbers
2934 * (32-bit words) *not* ref data words.
2935 */
2936 Uint32 *anum;
2937 Uint32 *bnum;
2938 Uint common_len;
2939 Uint alen;
2940 Uint blen;
2941 Uint i;
2942 ExternalThing* athing;
2943 ExternalThing* bthing;
2944
2945 if(!is_external_ref(b))
2946 goto not_equal;
2947
2948 athing = external_thing_ptr(a);
2949 bthing = external_thing_ptr(b);
2950
2951 if(athing->node != bthing->node)
2952 goto not_equal;
2953
2954 anum = external_thing_ref_numbers(athing);
2955 bnum = external_thing_ref_numbers(bthing);
2956 alen = external_thing_ref_no_numbers(athing);
2957 blen = external_thing_ref_no_numbers(bthing);
2958
2959 goto ref_common;
2960
2961 case REF_SUBTAG:
2962
2963 if (!is_internal_ref(b))
2964 goto not_equal;
2965
2966 alen = internal_ref_no_numbers(a);
2967 anum = internal_ref_numbers(a);
2968 blen = internal_ref_no_numbers(b);
2969 bnum = internal_ref_numbers(b);
2970
2971 ref_common:
2972 ASSERT(alen > 0 && blen > 0);
2973
2974 if (anum[0] != bnum[0])
2975 goto not_equal;
2976
2977 if (alen == 3 && blen == 3) {
2978 /* Most refs are of length 3 */
2979 if (anum[1] == bnum[1] && anum[2] == bnum[2]) {
2980 goto pop_next;
2981 } else {
2982 goto not_equal;
2983 }
2984 }
2985
2986 common_len = alen;
2987 if (blen < alen)
2988 common_len = blen;
2989
2990 for (i = 1; i < common_len; i++)
2991 if (anum[i] != bnum[i])
2992 goto not_equal;
2993
2994 if(alen != blen) {
2995
2996 if (alen > blen) {
2997 for (i = common_len; i < alen; i++)
2998 if (anum[i] != 0)
2999 goto not_equal;
3000 }
3001 else {
3002 for (i = common_len; i < blen; i++)
3003 if (bnum[i] != 0)
3004 goto not_equal;
3005 }
3006 }
3007 goto pop_next;
3008 }
3009 case POS_BIG_SUBTAG:
3010 case NEG_BIG_SUBTAG:
3011 {
3012 int i;
3013
3014 if (!is_big(b))
3015 goto not_equal;
3016 aa = big_val(a);
3017 bb = big_val(b);
3018 if (*aa != *bb)
3019 goto not_equal;
3020 i = BIG_ARITY(aa);
3021 while(i--) {
3022 if (*++aa != *++bb)
3023 goto not_equal;
3024 }
3025 goto pop_next;
3026 }
3027 case FLOAT_SUBTAG:
3028 {
3029 FloatDef af;
3030 FloatDef bf;
3031
3032 if (is_float(b)) {
3033 GET_DOUBLE(a, af);
3034 GET_DOUBLE(b, bf);
3035 if (af.fd == bf.fd) goto pop_next;
3036 }
3037 break; /* not equal */
3038 }
3039 case MAP_SUBTAG:
3040 if (is_flatmap(a)) {
3041 aa = flatmap_val(a);
3042 if (!is_boxed(b) || *boxed_val(b) != *aa)
3043 goto not_equal;
3044 bb = flatmap_val(b);
3045 sz = flatmap_get_size((flatmap_t*)aa);
3046
3047 if (sz != flatmap_get_size((flatmap_t*)bb)) goto not_equal;
3048 if (sz == 0) goto pop_next;
3049
3050 aa += 2;
3051 bb += 2;
3052 sz += 1; /* increment for tuple-keys */
3053 goto term_array;
3054
3055 } else {
3056 if (!is_boxed(b) || *boxed_val(b) != hdr)
3057 goto not_equal;
3058
3059 aa = hashmap_val(a) + 1;
3060 bb = hashmap_val(b) + 1;
3061 switch (hdr & _HEADER_MAP_SUBTAG_MASK) {
3062 case HAMT_SUBTAG_HEAD_ARRAY:
3063 if (aa[0] != bb[0])
3064 goto not_equal;
3065 aa++; bb++;
3066 sz = 16;
3067 break;
3068 case HAMT_SUBTAG_HEAD_BITMAP:
3069 if (aa[0] != bb[0])
3070 goto not_equal;
3071 aa++; bb++;
3072 case HAMT_SUBTAG_NODE_BITMAP:
3073 sz = hashmap_bitcount(MAP_HEADER_VAL(hdr));
3074 ASSERT(sz > 0 && sz < 17);
3075 break;
3076 default:
3077 erts_exit(ERTS_ERROR_EXIT, "Unknown hashmap subsubtag\n");
3078 }
3079 goto term_array;
3080 }
3081 default:
3082 ASSERT(!"Unknown boxed subtab in EQ");
3083 }
3084 break;
3085 }
3086 }
3087 goto not_equal;
3088
3089
3090 term_array: /* arrays in 'aa' and 'bb', length in 'sz' */
3091 ASSERT(sz != 0);
3092 {
3093 Eterm* ap = aa;
3094 Eterm* bp = bb;
3095 Sint i = sz;
3096 for (;;) {
3097 if (!is_same(*ap,*bp)) break;
3098 if (--i == 0) goto pop_next;
3099 ++ap;
3100 ++bp;
3101 }
3102 a = *ap;
3103 b = *bp;
3104 if (is_both_immed(a,b)) {
3105 goto not_equal;
3106 }
3107 if (i > 1) { /* push the rest */
3108 WSTACK_PUSH3(stack, i-1, (UWord)(bp+1),
3109 ((UWord)(ap+1)) | TAG_PRIMARY_HEADER);
3110 /* We (ab)use TAG_PRIMARY_HEADER to recognize a term_array */
3111 }
3112 goto tailrecur_ne;
3113 }
3114
3115 pop_next:
3116 if (!WSTACK_ISEMPTY(stack)) {
3117 UWord something = WSTACK_POP(stack);
3118 if (primary_tag((Eterm) something) == TAG_PRIMARY_HEADER) { /* a term_array */
3119 aa = (Eterm*) something;
3120 bb = (Eterm*) WSTACK_POP(stack);
3121 sz = WSTACK_POP(stack);
3122 goto term_array;
3123 }
3124 a = something;
3125 b = WSTACK_POP(stack);
3126 goto tailrecur;
3127 }
3128
3129 DESTROY_WSTACK(stack);
3130 return 1;
3131
3132 not_equal:
3133 DESTROY_WSTACK(stack);
3134 return 0;
3135 }
3136
3137
3138
3139 /*
3140 * Compare objects.
3141 * Returns 0 if equal, a negative value if a < b, or a positive number a > b.
3142 *
3143 * According to the Erlang Standard, types are orderered as follows:
3144 * numbers < (characters) < atoms < refs < funs < ports < pids <
3145 * tuples < maps < [] < conses < binaries.
3146 *
3147 */
3148
3149 Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only);
3150
3151 /* erts_cmp(Eterm a, Eterm b, int exact)
3152 * exact = 1 -> term-based compare
3153 * exact = 0 -> arith-based compare
3154 */
erts_cmp_compound(Eterm a,Eterm b,int exact,int eq_only)3155 Sint erts_cmp_compound(Eterm a, Eterm b, int exact, int eq_only)
3156 {
3157 #define PSTACK_TYPE struct erts_cmp_hashmap_state
3158 struct erts_cmp_hashmap_state {
3159 Sint wstack_rollback;
3160 int was_exact;
3161 Eterm *ap;
3162 Eterm *bp;
3163 Eterm min_key;
3164 Sint cmp_res; /* result so far -1,0,+1 */
3165 };
3166 PSTACK_DECLARE(hmap_stack, 1);
3167 WSTACK_DECLARE(stack);
3168 WSTACK_DECLARE(b_stack); /* only used by hashmaps */
3169 Eterm* aa;
3170 Eterm* bb;
3171 int i;
3172 Sint j;
3173 int a_tag;
3174 int b_tag;
3175 ErlNode *anode;
3176 ErlNode *bnode;
3177 Uint alen;
3178 Uint blen;
3179 Uint32 *anum;
3180 Uint32 *bnum;
3181
3182 /* The WSTACK contains naked Eterms and Operations marked with header-tags */
3183 #define OP_BITS 4
3184 #define OP_MASK 0xF
3185 #define TERM_ARRAY_OP 0
3186 #define SWITCH_EXACT_OFF_OP 1
3187 #define HASHMAP_PHASE1_ARE_KEYS_EQUAL 2
3188 #define HASHMAP_PHASE1_IS_MIN_KEY 3
3189 #define HASHMAP_PHASE1_CMP_VALUES 4
3190 #define HASHMAP_PHASE2_ARE_KEYS_EQUAL 5
3191 #define HASHMAP_PHASE2_IS_MIN_KEY_A 6
3192 #define HASHMAP_PHASE2_IS_MIN_KEY_B 7
3193
3194
3195 #define OP_WORD(OP) (((OP) << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_HEADER)
3196 #define TERM_ARRAY_OP_WORD(SZ) OP_WORD(((SZ) << OP_BITS) | TERM_ARRAY_OP)
3197
3198 #define GET_OP(WORD) (ASSERT(is_header(WORD)), ((WORD) >> _TAG_PRIMARY_SIZE) & OP_MASK)
3199 #define GET_OP_ARG(WORD) (ASSERT(is_header(WORD)), ((WORD) >> (OP_BITS + _TAG_PRIMARY_SIZE)))
3200
3201
3202 #define RETURN_NEQ(cmp) { j=(cmp); ASSERT(j != 0); goto not_equal; }
3203 #define ON_CMP_GOTO(cmp) if ((j=(cmp)) == 0) goto pop_next; else goto not_equal
3204
3205 #undef CMP_NODES
3206 #define CMP_NODES(AN, BN) \
3207 do { \
3208 if((AN) != (BN)) { \
3209 if((AN)->sysname != (BN)->sysname) \
3210 RETURN_NEQ(erts_cmp_atoms((AN)->sysname, (BN)->sysname)); \
3211 ASSERT((AN)->creation != (BN)->creation); \
3212 RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \
3213 } \
3214 } while (0)
3215
3216
3217 bodyrecur:
3218 j = 0;
3219 tailrecur:
3220 if (is_same(a,b)) { /* Equal values or pointers. */
3221 goto pop_next;
3222 }
3223 tailrecur_ne:
3224
3225 /* deal with majority (?) cases by brute-force */
3226 if (is_atom(a)) {
3227 if (is_atom(b)) {
3228 ON_CMP_GOTO(erts_cmp_atoms(a, b));
3229 }
3230 } else if (is_both_small(a, b)) {
3231 ON_CMP_GOTO(signed_val(a) - signed_val(b));
3232 }
3233
3234 /*
3235 * Take care of cases where the types are the same.
3236 */
3237
3238 a_tag = 42; /* Suppress warning */
3239 switch (primary_tag(a)) {
3240 case TAG_PRIMARY_IMMED1:
3241 switch ((a & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) {
3242 case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE):
3243 if (is_internal_port(b)) {
3244 Uint adata = internal_port_data(a);
3245 Uint bdata = internal_port_data(b);
3246 ON_CMP_GOTO((Sint)(adata - bdata));
3247 } else if (is_external_port(b)) {
3248 anode = erts_this_node;
3249 bnode = external_port_node(b);
3250 CMP_NODES(anode, bnode);
3251 ERTS_INTERNAL_ERROR("different nodes compared equal");
3252 } else {
3253 a_tag = PORT_DEF;
3254 goto mixed_types;
3255 }
3256
3257 case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE):
3258 if (is_internal_pid(b)) {
3259 Uint adata = internal_pid_data(a);
3260 Uint bdata = internal_pid_data(b);
3261 ON_CMP_GOTO((Sint)(adata - bdata));
3262 }
3263 else if (is_not_external_pid(b)) {
3264 a_tag = PID_DEF;
3265 goto mixed_types;
3266 }
3267
3268 pid_common:
3269 {
3270 Uint32 a_pid_num, a_pid_ser;
3271 Uint32 b_pid_num, b_pid_ser;
3272
3273 if (is_internal_pid(a)) {
3274 a_pid_num = internal_pid_number(a);
3275 a_pid_ser = internal_pid_serial(a);
3276 anode = erts_this_node;
3277 }
3278 else {
3279 ASSERT(is_external_pid(a));
3280 a_pid_num = external_pid_number(a);
3281 a_pid_ser = external_pid_serial(a);
3282 anode = external_pid_node(a);
3283 }
3284 if (is_internal_pid(b)) {
3285 b_pid_num = internal_pid_number(b);
3286 b_pid_ser = internal_pid_serial(b);
3287 bnode = erts_this_node;
3288 }
3289 else {
3290 ASSERT(is_external_pid(b));
3291 b_pid_num = external_pid_number(b);
3292 b_pid_ser = external_pid_serial(b);
3293 bnode = external_pid_node(b);
3294 }
3295
3296 if (a_pid_ser != b_pid_ser)
3297 RETURN_NEQ(a_pid_ser < b_pid_ser ? -1 : 1);
3298 if (a_pid_num != b_pid_num)
3299 RETURN_NEQ(a_pid_num < b_pid_num ? -1 : 1);
3300 CMP_NODES(anode, bnode);
3301 goto pop_next;
3302 }
3303 case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE):
3304 a_tag = SMALL_DEF;
3305 goto mixed_types;
3306 case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): {
3307 switch ((a & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) {
3308 case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE):
3309 a_tag = ATOM_DEF;
3310 goto mixed_types;
3311 case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE):
3312 a_tag = NIL_DEF;
3313 goto mixed_types;
3314 }
3315 }
3316 }
3317 case TAG_PRIMARY_LIST:
3318 if (is_not_list(b)) {
3319 a_tag = LIST_DEF;
3320 goto mixed_types;
3321 }
3322 aa = list_val(a);
3323 bb = list_val(b);
3324 while (1) {
3325 Eterm atmp = CAR(aa);
3326 Eterm btmp = CAR(bb);
3327 if (!is_same(atmp,btmp)) {
3328 WSTACK_PUSH2(stack,(UWord) CDR(bb),(UWord) CDR(aa));
3329 a = atmp;
3330 b = btmp;
3331 goto tailrecur_ne;
3332 }
3333 atmp = CDR(aa);
3334 btmp = CDR(bb);
3335 if (is_same(atmp,btmp)) {
3336 goto pop_next;
3337 }
3338 if (is_not_list(atmp) || is_not_list(btmp)) {
3339 a = atmp;
3340 b = btmp;
3341 goto tailrecur_ne;
3342 }
3343 aa = list_val(atmp);
3344 bb = list_val(btmp);
3345 }
3346 case TAG_PRIMARY_BOXED:
3347 {
3348 Eterm ahdr = *boxed_val(a);
3349 switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
3350 case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):
3351 if (!is_tuple(b)) {
3352 a_tag = TUPLE_DEF;
3353 goto mixed_types;
3354 }
3355 aa = tuple_val(a);
3356 bb = tuple_val(b);
3357 /* compare the arities */
3358 i = arityval(ahdr); /* get the arity*/
3359 if (i != arityval(*bb)) {
3360 RETURN_NEQ((int)(i - arityval(*bb)));
3361 }
3362 if (i == 0) {
3363 goto pop_next;
3364 }
3365 ++aa;
3366 ++bb;
3367 goto term_array;
3368 case (_TAG_HEADER_MAP >> _TAG_PRIMARY_SIZE) :
3369 {
3370 struct erts_cmp_hashmap_state* sp;
3371 if (is_flatmap_header(ahdr)) {
3372 if (!is_flatmap(b)) {
3373 if (is_hashmap(b)) {
3374 aa = (Eterm *)flatmap_val(a);
3375 i = flatmap_get_size((flatmap_t*)aa) - hashmap_size(b);
3376 ASSERT(i != 0);
3377 RETURN_NEQ(i);
3378 }
3379 a_tag = MAP_DEF;
3380 goto mixed_types;
3381 }
3382 aa = (Eterm *)flatmap_val(a);
3383 bb = (Eterm *)flatmap_val(b);
3384
3385 i = flatmap_get_size((flatmap_t*)aa);
3386 if (i != flatmap_get_size((flatmap_t*)bb)) {
3387 RETURN_NEQ((int)(i - flatmap_get_size((flatmap_t*)bb)));
3388 }
3389 if (i == 0) {
3390 goto pop_next;
3391 }
3392 aa += 2;
3393 bb += 2;
3394 if (exact) {
3395 i += 1; /* increment for tuple-keys */
3396 goto term_array;
3397 }
3398 else {
3399 /* Value array */
3400 WSTACK_PUSH3(stack,(UWord)(bb+1),(UWord)(aa+1),TERM_ARRAY_OP_WORD(i));
3401 /* Switch back from 'exact' key compare */
3402 WSTACK_PUSH(stack,OP_WORD(SWITCH_EXACT_OFF_OP));
3403 /* Now do 'exact' compare of key tuples */
3404 a = *aa;
3405 b = *bb;
3406 exact = 1;
3407 goto bodyrecur;
3408 }
3409 }
3410 if (!is_hashmap(b)) {
3411 if (is_flatmap(b)) {
3412 bb = (Eterm *)flatmap_val(b);
3413 i = hashmap_size(a) - flatmap_get_size((flatmap_t*)bb);
3414 ASSERT(i != 0);
3415 RETURN_NEQ(i);
3416 }
3417 a_tag = MAP_DEF;
3418 goto mixed_types;
3419 }
3420 i = hashmap_size(a) - hashmap_size(b);
3421 if (i) {
3422 RETURN_NEQ(i);
3423 }
3424 if (hashmap_size(a) == 0) {
3425 goto pop_next;
3426 }
3427
3428 /* Hashmap compare strategy:
3429 Phase 1. While keys are identical
3430 Do synchronous stepping through leafs of both trees in hash
3431 order. Maintain value compare result of minimal key.
3432
3433 Phase 2. If key diff was found in phase 1
3434 Ignore values from now on.
3435 Continue iterate trees by always advancing the one
3436 lagging behind hash-wise. Identical keys are skipped.
3437 A minimal key can only be candidate as tie-breaker if we
3438 have passed that hash value in the other tree (which means
3439 the key did not exist in the other tree).
3440 */
3441
3442 sp = PSTACK_PUSH(hmap_stack);
3443 hashmap_iterator_init(&stack, a, 0);
3444 hashmap_iterator_init(&b_stack, b, 0);
3445 sp->ap = hashmap_iterator_next(&stack);
3446 sp->bp = hashmap_iterator_next(&b_stack);
3447 sp->cmp_res = 0;
3448 ASSERT(sp->ap && sp->bp);
3449
3450 a = CAR(sp->ap);
3451 b = CAR(sp->bp);
3452 sp->was_exact = exact;
3453 exact = 1;
3454 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_ARE_KEYS_EQUAL));
3455 sp->wstack_rollback = WSTACK_COUNT(stack);
3456 goto bodyrecur;
3457 }
3458 case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
3459 if (!is_float(b)) {
3460 a_tag = FLOAT_DEF;
3461 goto mixed_types;
3462 } else {
3463 FloatDef af;
3464 FloatDef bf;
3465
3466 GET_DOUBLE(a, af);
3467 GET_DOUBLE(b, bf);
3468 ON_CMP_GOTO(erts_float_comp(af.fd, bf.fd));
3469 }
3470 case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
3471 case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
3472 if (!is_big(b)) {
3473 a_tag = BIG_DEF;
3474 goto mixed_types;
3475 }
3476 ON_CMP_GOTO(big_comp(a, b));
3477 case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE):
3478 if (!is_export(b)) {
3479 a_tag = EXPORT_DEF;
3480 goto mixed_types;
3481 } else {
3482 Export* a_exp = *((Export **) (export_val(a) + 1));
3483 Export* b_exp = *((Export **) (export_val(b) + 1));
3484
3485 if ((j = erts_cmp_atoms(a_exp->info.mfa.module,
3486 b_exp->info.mfa.module)) != 0) {
3487 RETURN_NEQ(j);
3488 }
3489 if ((j = erts_cmp_atoms(a_exp->info.mfa.function,
3490 b_exp->info.mfa.function)) != 0) {
3491 RETURN_NEQ(j);
3492 }
3493 ON_CMP_GOTO((Sint) a_exp->info.mfa.arity - (Sint) b_exp->info.mfa.arity);
3494 }
3495 break;
3496 case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
3497 if (!is_fun(b)) {
3498 a_tag = FUN_DEF;
3499 goto mixed_types;
3500 } else {
3501 ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
3502 ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
3503 Sint diff;
3504
3505 diff = erts_cmp_atoms((f1->fe)->module, (f2->fe)->module);
3506 if (diff != 0) {
3507 RETURN_NEQ(diff);
3508 }
3509 diff = f1->fe->index - f2->fe->index;
3510 if (diff != 0) {
3511 RETURN_NEQ(diff);
3512 }
3513 diff = f1->fe->old_uniq - f2->fe->old_uniq;
3514 if (diff != 0) {
3515 RETURN_NEQ(diff);
3516 }
3517 diff = f1->num_free - f2->num_free;
3518 if (diff != 0) {
3519 RETURN_NEQ(diff);
3520 }
3521 i = f1->num_free;
3522 if (i == 0) goto pop_next;
3523 aa = f1->env;
3524 bb = f2->env;
3525 goto term_array;
3526 }
3527 case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE):
3528 if (!is_pid(b)) {
3529 a_tag = EXTERNAL_PID_DEF;
3530 goto mixed_types;
3531 }
3532 goto pid_common;
3533
3534 case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE):
3535 if (is_internal_port(b)) {
3536 anode = external_port_node(a);
3537 bnode = erts_this_node;
3538 CMP_NODES(anode, bnode);
3539 ERTS_INTERNAL_ERROR("different nodes compared equal");
3540 } else if (is_external_port(b)) {
3541 Uint64 anum, bnum;
3542 anode = external_port_node(a);
3543 bnode = external_port_node(b);
3544 CMP_NODES(anode, bnode);
3545 anum = external_port_number(a);
3546 bnum = external_port_number(b);
3547 if (anum == bnum)
3548 goto pop_next;
3549 RETURN_NEQ(anum < bnum ? -1 : 1);
3550 } else {
3551 a_tag = EXTERNAL_PORT_DEF;
3552 goto mixed_types;
3553 }
3554 case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
3555 /*
3556 * Note! When comparing refs we need to compare ref numbers
3557 * (32-bit words), *not* ref data words.
3558 */
3559
3560 if (is_internal_ref(b)) {
3561 bnode = erts_this_node;
3562 blen = internal_ref_no_numbers(b);
3563 bnum = internal_ref_numbers(b);
3564 } else if(is_external_ref(b)) {
3565 ExternalThing* bthing = external_thing_ptr(b);
3566 bnode = bthing->node;
3567 bnum = external_thing_ref_numbers(bthing);
3568 blen = external_thing_ref_no_numbers(bthing);
3569 } else {
3570 a_tag = REF_DEF;
3571 goto mixed_types;
3572 }
3573 anode = erts_this_node;
3574 alen = internal_ref_no_numbers(a);
3575 anum = internal_ref_numbers(a);
3576
3577 ref_common:
3578 CMP_NODES(anode, bnode);
3579
3580 ASSERT(alen > 0 && blen > 0);
3581 if (alen != blen) {
3582 if (alen > blen) {
3583 do {
3584 if (anum[alen - 1] != 0)
3585 RETURN_NEQ(1);
3586 alen--;
3587 } while (alen > blen);
3588 }
3589 else {
3590 do {
3591 if (bnum[blen - 1] != 0)
3592 RETURN_NEQ(-1);
3593 blen--;
3594 } while (alen < blen);
3595 }
3596 }
3597
3598 ASSERT(alen == blen);
3599 for (i = (Sint) alen - 1; i >= 0; i--)
3600 if (anum[i] != bnum[i])
3601 RETURN_NEQ(anum[i] < bnum[i] ? -1 : 1);
3602 goto pop_next;
3603 case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE):
3604 if (is_internal_ref(b)) {
3605 bnode = erts_this_node;
3606 blen = internal_ref_no_numbers(b);
3607 bnum = internal_ref_numbers(b);
3608 } else if (is_external_ref(b)) {
3609 ExternalThing* bthing = external_thing_ptr(b);
3610 bnode = bthing->node;
3611 bnum = external_thing_ref_numbers(bthing);
3612 blen = external_thing_ref_no_numbers(bthing);
3613 } else {
3614 a_tag = EXTERNAL_REF_DEF;
3615 goto mixed_types;
3616 }
3617 {
3618 ExternalThing* athing = external_thing_ptr(a);
3619 anode = athing->node;
3620 anum = external_thing_ref_numbers(athing);
3621 alen = external_thing_ref_no_numbers(athing);
3622 }
3623 goto ref_common;
3624 default:
3625 /* Must be a binary */
3626 ASSERT(is_binary(a));
3627 if (!is_binary(b)) {
3628 a_tag = BINARY_DEF;
3629 goto mixed_types;
3630 } else {
3631 Uint a_size = binary_size(a);
3632 Uint b_size = binary_size(b);
3633 Uint a_bitsize;
3634 Uint b_bitsize;
3635 Uint a_bitoffs;
3636 Uint b_bitoffs;
3637 Uint min_size;
3638 int cmp;
3639 byte* a_ptr;
3640 byte* b_ptr;
3641 if (eq_only && a_size != b_size) {
3642 RETURN_NEQ(a_size - b_size);
3643 }
3644 ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
3645 ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
3646 if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
3647 min_size = (a_size < b_size) ? a_size : b_size;
3648 if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) {
3649 RETURN_NEQ(cmp);
3650 }
3651 }
3652 else {
3653 a_size = (a_size << 3) + a_bitsize;
3654 b_size = (b_size << 3) + b_bitsize;
3655 min_size = (a_size < b_size) ? a_size : b_size;
3656 if ((cmp = erts_cmp_bits(a_ptr,a_bitoffs,
3657 b_ptr,b_bitoffs,min_size)) != 0) {
3658 RETURN_NEQ(cmp);
3659 }
3660 }
3661 ON_CMP_GOTO((Sint)(a_size - b_size));
3662 }
3663 }
3664 }
3665 }
3666
3667 /*
3668 * Take care of the case that the tags are different.
3669 */
3670
3671 mixed_types:
3672
3673 {
3674 FloatDef f1, f2;
3675 Eterm big;
3676 Eterm aw = a;
3677 Eterm bw = b;
3678 #define MAX_LOSSLESS_FLOAT ((double)((1LL << 53) - 2))
3679 #define MIN_LOSSLESS_FLOAT ((double)(((1LL << 53) - 2)*-1))
3680 #define BIG_ARITY_FLOAT_MAX (1024 / D_EXP) /* arity of max float as a bignum */
3681 Eterm big_buf[BIG_NEED_SIZE(BIG_ARITY_FLOAT_MAX)];
3682
3683 b_tag = tag_val_def(bw);
3684
3685 switch(_NUMBER_CODE(a_tag, b_tag)) {
3686 case SMALL_BIG:
3687 j = big_sign(bw) ? 1 : -1;
3688 break;
3689 case BIG_SMALL:
3690 j = big_sign(aw) ? -1 : 1;
3691 break;
3692 case SMALL_FLOAT:
3693 if (exact) goto exact_fall_through;
3694 GET_DOUBLE(bw, f2);
3695 if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) {
3696 /* Float is within the no loss limit */
3697 f1.fd = signed_val(aw);
3698 j = erts_float_comp(f1.fd, f2.fd);
3699 }
3700 #if ERTS_SIZEOF_ETERM == 8
3701 else if (f2.fd > (double) (MAX_SMALL + 1)) {
3702 /* Float is a positive bignum, i.e. bigger */
3703 j = -1;
3704 } else if (f2.fd < (double) (MIN_SMALL - 1)) {
3705 /* Float is a negative bignum, i.e. smaller */
3706 j = 1;
3707 } else {
3708 /* Float is a Sint but less precise */
3709 j = signed_val(aw) - (Sint) f2.fd;
3710 }
3711 #else
3712 else {
3713 /* If float is positive it is bigger than small */
3714 j = (f2.fd > 0.0) ? -1 : 1;
3715 }
3716 #endif /* ERTS_SIZEOF_ETERM == 8 */
3717 break;
3718 case FLOAT_BIG:
3719 if (exact) goto exact_fall_through;
3720 {
3721 Wterm tmp = aw;
3722 aw = bw;
3723 bw = tmp;
3724 }/* fall through */
3725 case BIG_FLOAT:
3726 if (exact) goto exact_fall_through;
3727 GET_DOUBLE(bw, f2);
3728 if ((f2.fd < (double) (MAX_SMALL + 1))
3729 && (f2.fd > (double) (MIN_SMALL - 1))) {
3730 /* Float is a Sint */
3731 j = big_sign(aw) ? -1 : 1;
3732 } else if (big_arity(aw) > BIG_ARITY_FLOAT_MAX
3733 || pow(2.0,(big_arity(aw)-1)*D_EXP) > fabs(f2.fd)) {
3734 /* If bignum size shows that it is bigger than the abs float */
3735 j = big_sign(aw) ? -1 : 1;
3736 } else if (big_arity(aw) < BIG_ARITY_FLOAT_MAX
3737 && (pow(2.0,(big_arity(aw))*D_EXP)-1.0) < fabs(f2.fd)) {
3738 /* If bignum size shows that it is smaller than the abs float */
3739 j = f2.fd < 0 ? 1 : -1;
3740 } else if (f2.fd < MAX_LOSSLESS_FLOAT && f2.fd > MIN_LOSSLESS_FLOAT) {
3741 /* Float is within the no loss limit */
3742 if (big_to_double(aw, &f1.fd) < 0) {
3743 j = big_sign(aw) ? -1 : 1;
3744 } else {
3745 j = erts_float_comp(f1.fd, f2.fd);
3746 }
3747 } else {
3748 big = double_to_big(f2.fd, big_buf, sizeof(big_buf)/sizeof(Eterm));
3749 j = big_comp(aw, big);
3750 }
3751 if (_NUMBER_CODE(a_tag, b_tag) == FLOAT_BIG) {
3752 j = -j;
3753 }
3754 break;
3755 case FLOAT_SMALL:
3756 if (exact) goto exact_fall_through;
3757 GET_DOUBLE(aw, f1);
3758 if (f1.fd < MAX_LOSSLESS_FLOAT && f1.fd > MIN_LOSSLESS_FLOAT) {
3759 /* Float is within the no loss limit */
3760 f2.fd = signed_val(bw);
3761 j = erts_float_comp(f1.fd, f2.fd);
3762 }
3763 #if ERTS_SIZEOF_ETERM == 8
3764 else if (f1.fd > (double) (MAX_SMALL + 1)) {
3765 /* Float is a positive bignum, i.e. bigger */
3766 j = 1;
3767 } else if (f1.fd < (double) (MIN_SMALL - 1)) {
3768 /* Float is a negative bignum, i.e. smaller */
3769 j = -1;
3770 } else {
3771 /* Float is a Sint but less precise it */
3772 j = (Sint) f1.fd - signed_val(bw);
3773 }
3774 #else
3775 else {
3776 /* If float is positive it is bigger than small */
3777 j = (f1.fd > 0.0) ? 1 : -1;
3778 }
3779 #endif /* ERTS_SIZEOF_ETERM == 8 */
3780 break;
3781 exact_fall_through:
3782 default:
3783 j = b_tag - a_tag;
3784 }
3785 }
3786 if (j == 0) {
3787 goto pop_next;
3788 } else {
3789 goto not_equal;
3790 }
3791
3792 term_array: /* arrays in 'aa' and 'bb', length in 'i' */
3793 ASSERT(i>0);
3794 while (--i) {
3795 a = *aa++;
3796 b = *bb++;
3797 if (!is_same(a, b)) {
3798 if (is_atom(a) && is_atom(b)) {
3799 if ((j = erts_cmp_atoms(a, b)) != 0) {
3800 goto not_equal;
3801 }
3802 } else if (is_both_small(a, b)) {
3803 if ((j = signed_val(a)-signed_val(b)) != 0) {
3804 goto not_equal;
3805 }
3806 } else {
3807 WSTACK_PUSH3(stack, (UWord)bb, (UWord)aa, TERM_ARRAY_OP_WORD(i));
3808 goto tailrecur_ne;
3809 }
3810 }
3811 }
3812 a = *aa;
3813 b = *bb;
3814 goto tailrecur;
3815
3816 pop_next:
3817 if (!WSTACK_ISEMPTY(stack)) {
3818 UWord something = WSTACK_POP(stack);
3819 struct erts_cmp_hashmap_state* sp;
3820 if (primary_tag((Eterm) something) == TAG_PRIMARY_HEADER) { /* an operation */
3821 switch (GET_OP(something)) {
3822 case TERM_ARRAY_OP:
3823 i = GET_OP_ARG(something);
3824 aa = (Eterm*)WSTACK_POP(stack);
3825 bb = (Eterm*) WSTACK_POP(stack);
3826 goto term_array;
3827
3828 case SWITCH_EXACT_OFF_OP:
3829 /* Done with exact compare of map keys, switch back */
3830 ASSERT(exact);
3831 exact = 0;
3832 goto pop_next;
3833
3834 case HASHMAP_PHASE1_ARE_KEYS_EQUAL: {
3835 sp = PSTACK_TOP(hmap_stack);
3836 if (j) {
3837 /* Key diff found, enter phase 2 */
3838 if (hashmap_key_hash_cmp(sp->ap, sp->bp) < 0) {
3839 sp->min_key = CAR(sp->ap);
3840 sp->cmp_res = -1;
3841 sp->ap = hashmap_iterator_next(&stack);
3842 }
3843 else {
3844 sp->min_key = CAR(sp->bp);
3845 sp->cmp_res = 1;
3846 sp->bp = hashmap_iterator_next(&b_stack);
3847 }
3848 exact = 1; /* only exact key compares in phase 2 */
3849 goto case_HASHMAP_PHASE2_LOOP;
3850 }
3851
3852 /* No key diff found so far, compare values if min key */
3853
3854 if (sp->cmp_res) {
3855 a = CAR(sp->ap);
3856 b = sp->min_key;
3857 exact = 1;
3858 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_IS_MIN_KEY));
3859 sp->wstack_rollback = WSTACK_COUNT(stack);
3860 goto bodyrecur;
3861 }
3862 /* no min key-value found yet */
3863 a = CDR(sp->ap);
3864 b = CDR(sp->bp);
3865 exact = sp->was_exact;
3866 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_CMP_VALUES));
3867 sp->wstack_rollback = WSTACK_COUNT(stack);
3868 goto bodyrecur;
3869 }
3870 case HASHMAP_PHASE1_IS_MIN_KEY:
3871 sp = PSTACK_TOP(hmap_stack);
3872 if (j < 0) {
3873 a = CDR(sp->ap);
3874 b = CDR(sp->bp);
3875 exact = sp->was_exact;
3876 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_CMP_VALUES));
3877 sp->wstack_rollback = WSTACK_COUNT(stack);
3878 goto bodyrecur;
3879 }
3880 goto case_HASHMAP_PHASE1_LOOP;
3881
3882 case HASHMAP_PHASE1_CMP_VALUES:
3883 sp = PSTACK_TOP(hmap_stack);
3884 if (j) {
3885 sp->cmp_res = j;
3886 sp->min_key = CAR(sp->ap);
3887 }
3888 case_HASHMAP_PHASE1_LOOP:
3889 sp->ap = hashmap_iterator_next(&stack);
3890 sp->bp = hashmap_iterator_next(&b_stack);
3891 if (!sp->ap) {
3892 /* end of maps with identical keys */
3893 ASSERT(!sp->bp);
3894 j = sp->cmp_res;
3895 exact = sp->was_exact;
3896 (void) PSTACK_POP(hmap_stack);
3897 ON_CMP_GOTO(j);
3898 }
3899 a = CAR(sp->ap);
3900 b = CAR(sp->bp);
3901 exact = 1;
3902 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE1_ARE_KEYS_EQUAL));
3903 sp->wstack_rollback = WSTACK_COUNT(stack);
3904 goto bodyrecur;
3905
3906 case_HASHMAP_PHASE2_LOOP:
3907 if (sp->ap && sp->bp) {
3908 a = CAR(sp->ap);
3909 b = CAR(sp->bp);
3910 ASSERT(exact);
3911 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_ARE_KEYS_EQUAL));
3912 sp->wstack_rollback = WSTACK_COUNT(stack);
3913 goto bodyrecur;
3914 }
3915 goto case_HASHMAP_PHASE2_NEXT_STEP;
3916
3917 case HASHMAP_PHASE2_ARE_KEYS_EQUAL:
3918 sp = PSTACK_TOP(hmap_stack);
3919 if (j == 0) {
3920 /* keys are equal, skip them */
3921 sp->ap = hashmap_iterator_next(&stack);
3922 sp->bp = hashmap_iterator_next(&b_stack);
3923 goto case_HASHMAP_PHASE2_LOOP;
3924 }
3925 /* fall through */
3926 case_HASHMAP_PHASE2_NEXT_STEP:
3927 if (sp->ap || sp->bp) {
3928 if (hashmap_key_hash_cmp(sp->ap, sp->bp) < 0) {
3929 ASSERT(sp->ap);
3930 a = CAR(sp->ap);
3931 b = sp->min_key;
3932 ASSERT(exact);
3933 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_IS_MIN_KEY_A));
3934 }
3935 else { /* hash_cmp > 0 */
3936 ASSERT(sp->bp);
3937 a = CAR(sp->bp);
3938 b = sp->min_key;
3939 ASSERT(exact);
3940 WSTACK_PUSH(stack, OP_WORD(HASHMAP_PHASE2_IS_MIN_KEY_B));
3941 }
3942 sp->wstack_rollback = WSTACK_COUNT(stack);
3943 goto bodyrecur;
3944 }
3945 /* End of both maps */
3946 j = sp->cmp_res;
3947 exact = sp->was_exact;
3948 (void) PSTACK_POP(hmap_stack);
3949 ON_CMP_GOTO(j);
3950
3951 case HASHMAP_PHASE2_IS_MIN_KEY_A:
3952 sp = PSTACK_TOP(hmap_stack);
3953 if (j < 0) {
3954 sp->min_key = CAR(sp->ap);
3955 sp->cmp_res = -1;
3956 }
3957 sp->ap = hashmap_iterator_next(&stack);
3958 goto case_HASHMAP_PHASE2_LOOP;
3959
3960 case HASHMAP_PHASE2_IS_MIN_KEY_B:
3961 sp = PSTACK_TOP(hmap_stack);
3962 if (j < 0) {
3963 sp->min_key = CAR(sp->bp);
3964 sp->cmp_res = 1;
3965 }
3966 sp->bp = hashmap_iterator_next(&b_stack);
3967 goto case_HASHMAP_PHASE2_LOOP;
3968
3969 default:
3970 ASSERT(!"Invalid cmp op");
3971 } /* switch */
3972 }
3973 a = (Eterm) something;
3974 b = (Eterm) WSTACK_POP(stack);
3975 goto tailrecur;
3976 }
3977
3978 ASSERT(PSTACK_IS_EMPTY(hmap_stack));
3979 PSTACK_DESTROY(hmap_stack);
3980 WSTACK_DESTROY(stack);
3981 WSTACK_DESTROY(b_stack);
3982 return 0;
3983
3984 not_equal:
3985 if (!PSTACK_IS_EMPTY(hmap_stack) && !eq_only) {
3986 WSTACK_ROLLBACK(stack, PSTACK_TOP(hmap_stack)->wstack_rollback);
3987 goto pop_next;
3988 }
3989 PSTACK_DESTROY(hmap_stack);
3990 WSTACK_DESTROY(stack);
3991 WSTACK_DESTROY(b_stack);
3992 return j;
3993
3994 #undef CMP_NODES
3995 }
3996
3997
3998 Eterm
store_external_or_ref_(Uint ** hpp,ErlOffHeap * oh,Eterm ns)3999 store_external_or_ref_(Uint **hpp, ErlOffHeap* oh, Eterm ns)
4000 {
4001 struct erl_off_heap_header *ohhp;
4002 Uint i;
4003 Uint size;
4004 Eterm *from_hp;
4005 Eterm *to_hp = *hpp;
4006
4007 ASSERT(is_external(ns) || is_internal_ref(ns));
4008
4009 from_hp = boxed_val(ns);
4010 size = thing_arityval(*from_hp) + 1;
4011 *hpp += size;
4012
4013 for(i = 0; i < size; i++)
4014 to_hp[i] = from_hp[i];
4015
4016 if (is_external_header(*from_hp)) {
4017 ExternalThing *etp = (ExternalThing *) from_hp;
4018 ASSERT(is_external(ns));
4019 erts_ref_node_entry(etp->node, 2, make_boxed(to_hp));
4020 }
4021 else if (!is_magic_ref_thing(from_hp))
4022 return make_internal_ref(to_hp);
4023 else {
4024 ErtsMRefThing *mreft = (ErtsMRefThing *) from_hp;
4025 ErtsMagicBinary *mb = mreft->mb;
4026 ASSERT(is_magic_ref_thing(from_hp));
4027 erts_refc_inc(&mb->intern.refc, 2);
4028 OH_OVERHEAD(oh, mb->orig_size / sizeof(Eterm));
4029 }
4030
4031 ohhp = (struct erl_off_heap_header*) to_hp;
4032 ohhp->next = oh->first;
4033 oh->first = ohhp;
4034
4035 return make_boxed(to_hp);
4036 }
4037
4038 Eterm
store_external_or_ref_in_proc_(Process * proc,Eterm ns)4039 store_external_or_ref_in_proc_(Process *proc, Eterm ns)
4040 {
4041 Uint sz;
4042 Uint *hp;
4043
4044 ASSERT(is_external(ns) || is_internal_ref(ns));
4045
4046 sz = NC_HEAP_SIZE(ns);
4047 ASSERT(sz > 0);
4048 hp = HAlloc(proc, sz);
4049 return store_external_or_ref_(&hp, &MSO(proc), ns);
4050 }
4051
bin_write(fmtfn_t to,void * to_arg,byte * buf,size_t sz)4052 void bin_write(fmtfn_t to, void *to_arg, byte* buf, size_t sz)
4053 {
4054 size_t i;
4055
4056 for (i=0;i<sz;i++) {
4057 if (IS_DIGIT(buf[i]))
4058 erts_print(to, to_arg, "%d,", buf[i]);
4059 else if (IS_PRINT(buf[i])) {
4060 erts_print(to, to_arg, "%c,", buf[i]);
4061 }
4062 else
4063 erts_print(to, to_arg, "%d,", buf[i]);
4064 }
4065 erts_putc(to, to_arg, '\n');
4066 }
4067
4068 /* Fill buf with the contents of bytelist list
4069 * return number of chars in list
4070 * or -1 for type error
4071 * or -2 for not enough buffer space (buffer contains truncated result)
4072 */
4073 Sint
intlist_to_buf(Eterm list,char * buf,Sint len)4074 intlist_to_buf(Eterm list, char *buf, Sint len)
4075 {
4076 Eterm* listptr;
4077 Sint sz = 0;
4078
4079 if (is_nil(list))
4080 return 0;
4081 if (is_not_list(list))
4082 return -1;
4083 listptr = list_val(list);
4084
4085 while (sz < len) {
4086 if (!is_byte(*listptr))
4087 return -1;
4088 buf[sz++] = unsigned_val(*listptr);
4089 if (is_nil(*(listptr + 1)))
4090 return(sz);
4091 if (is_not_list(*(listptr + 1)))
4092 return -1;
4093 listptr = list_val(*(listptr + 1));
4094 }
4095 return -2; /* not enough space */
4096 }
4097
4098 /** @brief Fill buf with the UTF8 contents of the unicode list
4099 * @param len Max number of characters to write.
4100 * @param written NULL or bytes written.
4101 * @return 0 ok,
4102 * -1 type error,
4103 * -2 list too long, only \c len characters written
4104 */
4105 int
erts_unicode_list_to_buf(Eterm list,byte * buf,Sint len,Sint * written)4106 erts_unicode_list_to_buf(Eterm list, byte *buf, Sint len, Sint* written)
4107 {
4108 Eterm* listptr;
4109 Sint sz = 0;
4110 Sint val;
4111 int res;
4112
4113 while (1) {
4114 if (is_nil(list)) {
4115 res = 0;
4116 break;
4117 }
4118 if (is_not_list(list)) {
4119 res = -1;
4120 break;
4121 }
4122 listptr = list_val(list);
4123
4124 if (len-- <= 0) {
4125 res = -2;
4126 break;
4127 }
4128
4129 if (is_not_small(CAR(listptr))) {
4130 res = -1;
4131 break;
4132 }
4133 val = signed_val(CAR(listptr));
4134 if (0 <= val && val < 0x80) {
4135 buf[sz] = val;
4136 sz++;
4137 } else if (val < 0x800) {
4138 buf[sz+0] = 0xC0 | (val >> 6);
4139 buf[sz+1] = 0x80 | (val & 0x3F);
4140 sz += 2;
4141 } else if (val < 0x10000UL) {
4142 if (0xD800 <= val && val <= 0xDFFF) {
4143 res = -1;
4144 break;
4145 }
4146 buf[sz+0] = 0xE0 | (val >> 12);
4147 buf[sz+1] = 0x80 | ((val >> 6) & 0x3F);
4148 buf[sz+2] = 0x80 | (val & 0x3F);
4149 sz += 3;
4150 } else if (val < 0x110000) {
4151 buf[sz+0] = 0xF0 | (val >> 18);
4152 buf[sz+1] = 0x80 | ((val >> 12) & 0x3F);
4153 buf[sz+2] = 0x80 | ((val >> 6) & 0x3F);
4154 buf[sz+3] = 0x80 | (val & 0x3F);
4155 sz += 4;
4156 } else {
4157 res = -1;
4158 break;
4159 }
4160 list = CDR(listptr);
4161 }
4162
4163 if (written)
4164 *written = sz;
4165 return res;
4166 }
4167
4168 Sint
erts_unicode_list_to_buf_len(Eterm list)4169 erts_unicode_list_to_buf_len(Eterm list)
4170 {
4171 Eterm* listptr;
4172 Sint sz = 0;
4173
4174 if (is_nil(list)) {
4175 return 0;
4176 }
4177 if (is_not_list(list)) {
4178 return -1;
4179 }
4180 listptr = list_val(list);
4181
4182 while (1) {
4183 Sint val;
4184
4185 if (is_not_small(CAR(listptr))) {
4186 return -1;
4187 }
4188 val = signed_val(CAR(listptr));
4189 if (0 <= val && val < 0x80) {
4190 sz++;
4191 } else if (val < 0x800) {
4192 sz += 2;
4193 } else if (val < 0x10000UL) {
4194 if (0xD800 <= val && val <= 0xDFFF) {
4195 return -1;
4196 }
4197 sz += 3;
4198 } else if (val < 0x110000) {
4199 sz += 4;
4200 } else {
4201 return -1;
4202 }
4203 list = CDR(listptr);
4204 if (is_nil(list)) {
4205 return sz;
4206 }
4207 if (is_not_list(list)) {
4208 return -1;
4209 }
4210 listptr = list_val(list);
4211 }
4212 }
4213
4214 /* Prints an integer in the given base, returning the number of digits printed.
4215 *
4216 * (*buf) is a pointer to the buffer, and is set to the start of the string
4217 * when returning. */
Sint_to_buf(Sint n,int base,char ** buf,size_t buf_size)4218 int Sint_to_buf(Sint n, int base, char **buf, size_t buf_size)
4219 {
4220 char *p = &(*buf)[buf_size - 1];
4221 int sign = 0, size = 0;
4222
4223 ASSERT(base >= 2 && base <= 36);
4224
4225 if (n == 0) {
4226 *p-- = '0';
4227 size++;
4228 } else if (n < 0) {
4229 sign = 1;
4230 n = -n;
4231 }
4232
4233 while (n != 0) {
4234 int digit = n % base;
4235
4236 if (digit < 10) {
4237 *p-- = '0' + digit;
4238 } else {
4239 *p-- = 'A' + (digit - 10);
4240 }
4241
4242 size++;
4243
4244 n /= base;
4245 }
4246
4247 if (sign) {
4248 *p-- = '-';
4249 size++;
4250 }
4251
4252 *buf = p + 1;
4253
4254 return size;
4255 }
4256
4257 /* Build a list of integers in some safe memory area
4258 ** Memory must be pre allocated prio call 2*len in size
4259 ** hp is a pointer to the "heap" pointer on return
4260 ** this pointer is updated to point after the list
4261 */
4262
4263 Eterm
buf_to_intlist(Eterm ** hpp,const char * buf,size_t len,Eterm tail)4264 buf_to_intlist(Eterm** hpp, const char *buf, size_t len, Eterm tail)
4265 {
4266 Eterm* hp = *hpp;
4267 size_t i = len;
4268
4269 while(i != 0) {
4270 --i;
4271 tail = CONS(hp, make_small((Uint)(byte)buf[i]), tail);
4272 hp += 2;
4273 }
4274
4275 *hpp = hp;
4276 return tail;
4277 }
4278
4279 /*
4280 ** Write io list in to a buffer.
4281 **
4282 ** An iolist is defined as:
4283 **
4284 ** iohead ::= Binary
4285 ** | Byte (i.e integer in range [0..255]
4286 ** | iolist
4287 ** ;
4288 **
4289 ** iotail ::= []
4290 ** | Binary (added by tony)
4291 ** | iolist
4292 ** ;
4293 **
4294 ** iolist ::= []
4295 ** | Binary
4296 ** | [ iohead | iotail]
4297 ** ;
4298 **
4299 ** Return remaining bytes in buffer on success
4300 ** ERTS_IOLIST_TO_BUF_OVERFLOW on overflow
4301 ** ERTS_IOLIST_TO_BUF_TYPE_ERROR on type error (including that result would not be a whole number of bytes)
4302 **
4303 ** Note!
4304 ** Do not detect indata errors in this fiunction that are not detected by erts_iolist_size!
4305 **
4306 ** A caller should be able to rely on a successful return from erts_iolist_to_buf
4307 ** if erts_iolist_size is previously successfully called and erts_iolist_to_buf
4308 ** is called with a buffer at least as large as the value given by erts_iolist_size.
4309 **
4310 */
4311
4312 typedef enum {
4313 ERTS_IL2B_BCOPY_OK,
4314 ERTS_IL2B_BCOPY_YIELD,
4315 ERTS_IL2B_BCOPY_OVERFLOW,
4316 ERTS_IL2B_BCOPY_TYPE_ERROR
4317 } ErtsIL2BBCopyRes;
4318
4319 static ErtsIL2BBCopyRes
4320 iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp);
4321
4322 static ERTS_INLINE ErlDrvSizeT
iolist_to_buf(const int yield_support,ErtsIOList2BufState * state,Eterm obj,char * buf,ErlDrvSizeT alloced_len)4323 iolist_to_buf(const int yield_support,
4324 ErtsIOList2BufState *state,
4325 Eterm obj,
4326 char* buf,
4327 ErlDrvSizeT alloced_len)
4328 {
4329 #undef IOLIST_TO_BUF_BCOPY
4330 #define IOLIST_TO_BUF_BCOPY(CONSP) \
4331 do { \
4332 size_t size = binary_size(obj); \
4333 if (size > 0) { \
4334 Uint bitsize; \
4335 byte* bptr; \
4336 Uint bitoffs; \
4337 Uint num_bits; \
4338 if (yield_support) { \
4339 size_t max_size = ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
4340 if (yield_count > 0) \
4341 max_size *= yield_count+1; \
4342 if (size > max_size) { \
4343 state->objp = CONSP; \
4344 goto L_bcopy_yield; \
4345 } \
4346 if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) { \
4347 int cost = (int) size; \
4348 cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT; \
4349 yield_count -= cost; \
4350 } \
4351 } \
4352 if (len < size) \
4353 goto L_overflow; \
4354 ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); \
4355 if (bitsize != 0) \
4356 goto L_type_error; \
4357 num_bits = 8*size; \
4358 copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); \
4359 buf += size; \
4360 len -= size; \
4361 } \
4362 } while (0)
4363
4364 ErlDrvSizeT res, len;
4365 Eterm* objp = NULL;
4366 int init_yield_count;
4367 int yield_count;
4368 DECLARE_ESTACK(s);
4369
4370 len = (ErlDrvSizeT) alloced_len;
4371
4372 if (!yield_support) {
4373 yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
4374 goto L_again;
4375 }
4376 else {
4377
4378 if (state->iolist.reds_left <= 0)
4379 return ERTS_IOLIST_TO_BUF_YIELD;
4380
4381 ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
4382 init_yield_count = (ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED
4383 * state->iolist.reds_left);
4384 yield_count = init_yield_count;
4385
4386 if (!state->iolist.estack.start)
4387 goto L_again;
4388 else {
4389 int chk_stack;
4390 /* Restart; restore state... */
4391 ESTACK_RESTORE(s, &state->iolist.estack);
4392
4393 if (!state->bcopy.bptr)
4394 chk_stack = 0;
4395 else {
4396 chk_stack = 1;
4397 switch (iolist_to_buf_bcopy(state, THE_NON_VALUE, &yield_count)) {
4398 case ERTS_IL2B_BCOPY_OK:
4399 break;
4400 case ERTS_IL2B_BCOPY_YIELD:
4401 BUMP_ALL_REDS(state->iolist.c_p);
4402 state->iolist.reds_left = 0;
4403 ESTACK_SAVE(s, &state->iolist.estack);
4404 return ERTS_IOLIST_TO_BUF_YIELD;
4405 case ERTS_IL2B_BCOPY_OVERFLOW:
4406 goto L_overflow;
4407 case ERTS_IL2B_BCOPY_TYPE_ERROR:
4408 goto L_type_error;
4409 }
4410 }
4411
4412 obj = state->iolist.obj;
4413 buf = state->buf;
4414 len = state->len;
4415 objp = state->objp;
4416 state->objp = NULL;
4417 if (objp)
4418 goto L_tail;
4419 if (!chk_stack)
4420 goto L_again;
4421 /* check stack */
4422 }
4423 }
4424
4425 while (!ESTACK_ISEMPTY(s)) {
4426 obj = ESTACK_POP(s);
4427 L_again:
4428 if (is_list(obj)) {
4429 while (1) { /* Tail loop */
4430 while (1) { /* Head loop */
4431 if (yield_support && --yield_count <= 0)
4432 goto L_yield;
4433 objp = list_val(obj);
4434 obj = CAR(objp);
4435 if (is_byte(obj)) {
4436 if (len == 0) {
4437 goto L_overflow;
4438 }
4439 *buf++ = unsigned_val(obj);
4440 len--;
4441 } else if (is_binary(obj)) {
4442 IOLIST_TO_BUF_BCOPY(objp);
4443 } else if (is_list(obj)) {
4444 ESTACK_PUSH(s, CDR(objp));
4445 continue; /* Head loop */
4446 } else if (is_not_nil(obj)) {
4447 goto L_type_error;
4448 }
4449 break;
4450 }
4451
4452 L_tail:
4453
4454 obj = CDR(objp);
4455
4456 if (is_list(obj)) {
4457 continue; /* Tail loop */
4458 } else if (is_binary(obj)) {
4459 IOLIST_TO_BUF_BCOPY(NULL);
4460 } else if (is_not_nil(obj)) {
4461 goto L_type_error;
4462 }
4463 break;
4464 }
4465 } else if (is_binary(obj)) {
4466 IOLIST_TO_BUF_BCOPY(NULL);
4467 } else if (is_not_nil(obj)) {
4468 goto L_type_error;
4469 } else if (yield_support && --yield_count <= 0)
4470 goto L_yield;
4471 }
4472
4473 res = len;
4474
4475 L_return:
4476
4477 DESTROY_ESTACK(s);
4478
4479 if (yield_support) {
4480 int reds;
4481 CLEAR_SAVED_ESTACK(&state->iolist.estack);
4482 reds = ((init_yield_count - yield_count - 1)
4483 / ERTS_IOLIST_TO_BUF_YIELD_COUNT_PER_RED) + 1;
4484 BUMP_REDS(state->iolist.c_p, reds);
4485 state->iolist.reds_left -= reds;
4486 if (state->iolist.reds_left < 0)
4487 state->iolist.reds_left = 0;
4488 }
4489
4490
4491 return res;
4492
4493 L_type_error:
4494 res = ERTS_IOLIST_TO_BUF_TYPE_ERROR;
4495 goto L_return;
4496
4497 L_overflow:
4498 res = ERTS_IOLIST_TO_BUF_OVERFLOW;
4499 goto L_return;
4500
4501 L_bcopy_yield:
4502
4503 state->buf = buf;
4504 state->len = len;
4505
4506 switch (iolist_to_buf_bcopy(state, obj, &yield_count)) {
4507 case ERTS_IL2B_BCOPY_OK:
4508 ERTS_INTERNAL_ERROR("Missing yield");
4509 case ERTS_IL2B_BCOPY_YIELD:
4510 BUMP_ALL_REDS(state->iolist.c_p);
4511 state->iolist.reds_left = 0;
4512 ESTACK_SAVE(s, &state->iolist.estack);
4513 return ERTS_IOLIST_TO_BUF_YIELD;
4514 case ERTS_IL2B_BCOPY_OVERFLOW:
4515 goto L_overflow;
4516 case ERTS_IL2B_BCOPY_TYPE_ERROR:
4517 goto L_type_error;
4518 }
4519
4520 L_yield:
4521
4522 BUMP_ALL_REDS(state->iolist.c_p);
4523 state->iolist.reds_left = 0;
4524 state->iolist.obj = obj;
4525 state->buf = buf;
4526 state->len = len;
4527 ESTACK_SAVE(s, &state->iolist.estack);
4528 return ERTS_IOLIST_TO_BUF_YIELD;
4529
4530 #undef IOLIST_TO_BUF_BCOPY
4531 }
4532
4533 static ErtsIL2BBCopyRes
iolist_to_buf_bcopy(ErtsIOList2BufState * state,Eterm obj,int * yield_countp)4534 iolist_to_buf_bcopy(ErtsIOList2BufState *state, Eterm obj, int *yield_countp)
4535 {
4536 ErtsIL2BBCopyRes res;
4537 char *buf = state->buf;
4538 ErlDrvSizeT len = state->len;
4539 byte* bptr;
4540 size_t size;
4541 size_t max_size;
4542 Uint bitoffs;
4543 Uint num_bits;
4544 int yield_count = *yield_countp;
4545
4546 if (state->bcopy.bptr) {
4547 bptr = state->bcopy.bptr;
4548 size = state->bcopy.size;
4549 bitoffs = state->bcopy.bitoffs;
4550 state->bcopy.bptr = NULL;
4551 }
4552 else {
4553 Uint bitsize;
4554
4555 ASSERT(is_binary(obj));
4556
4557 size = binary_size(obj);
4558 if (size <= 0)
4559 return ERTS_IL2B_BCOPY_OK;
4560
4561 if (len < size)
4562 return ERTS_IL2B_BCOPY_OVERFLOW;
4563
4564 ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
4565 if (bitsize != 0)
4566 return ERTS_IL2B_BCOPY_TYPE_ERROR;
4567 }
4568
4569 ASSERT(size > 0);
4570 max_size = (size_t) ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
4571 if (yield_count > 0)
4572 max_size *= (size_t) (yield_count+1);
4573
4574 if (size <= max_size) {
4575 if (size >= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT) {
4576 int cost = (int) size;
4577 cost /= ERTS_IOLIST_TO_BUF_BYTES_PER_YIELD_COUNT;
4578 yield_count -= cost;
4579 }
4580 res = ERTS_IL2B_BCOPY_OK;
4581 }
4582 else {
4583 ASSERT(0 < max_size && max_size < size);
4584 yield_count = 0;
4585 state->bcopy.bptr = bptr + max_size;
4586 state->bcopy.bitoffs = bitoffs;
4587 state->bcopy.size = size - max_size;
4588 size = max_size;
4589 res = ERTS_IL2B_BCOPY_YIELD;
4590 }
4591
4592 num_bits = 8*size;
4593 copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits);
4594 state->buf += size;
4595 state->len -= size;
4596 *yield_countp = yield_count;
4597
4598 return res;
4599 }
4600
erts_iolist_to_buf_yielding(ErtsIOList2BufState * state)4601 ErlDrvSizeT erts_iolist_to_buf_yielding(ErtsIOList2BufState *state)
4602 {
4603 return iolist_to_buf(1, state, state->iolist.obj, state->buf, state->len);
4604 }
4605
erts_iolist_to_buf(Eterm obj,char * buf,ErlDrvSizeT alloced_len)4606 ErlDrvSizeT erts_iolist_to_buf(Eterm obj, char* buf, ErlDrvSizeT alloced_len)
4607 {
4608 return iolist_to_buf(0, NULL, obj, buf, alloced_len);
4609 }
4610
4611 /*
4612 * Return 0 if successful, and non-zero if unsuccessful.
4613 *
4614 * It is vital that if erts_iolist_to_buf would return an error for
4615 * any type of term data, this function should do so as well.
4616 * Any input term error detected in erts_iolist_to_buf should also
4617 * be detected in this function!
4618 */
4619
4620 static ERTS_INLINE int
iolist_size(const int yield_support,ErtsIOListState * state,Eterm obj,ErlDrvSizeT * sizep)4621 iolist_size(const int yield_support, ErtsIOListState *state, Eterm obj, ErlDrvSizeT* sizep)
4622 {
4623 int res, init_yield_count, yield_count;
4624 Eterm* objp;
4625 Uint size = (Uint) *sizep;
4626 DECLARE_ESTACK(s);
4627
4628 if (!yield_support)
4629 yield_count = init_yield_count = 0; /* Shut up faulty warning... >:-( */
4630 else {
4631 if (state->reds_left <= 0)
4632 return ERTS_IOLIST_YIELD;
4633 ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
4634 init_yield_count = ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED;
4635 init_yield_count *= state->reds_left;
4636 yield_count = init_yield_count;
4637 if (state->estack.start) {
4638 /* Restart; restore state... */
4639 ESTACK_RESTORE(s, &state->estack);
4640 size = (Uint) state->size;
4641 obj = state->obj;
4642 }
4643 }
4644
4645 goto L_again;
4646
4647 #define SAFE_ADD(Var, Val) \
4648 do { \
4649 Uint valvar = (Val); \
4650 Var += valvar; \
4651 if (Var < valvar) { \
4652 goto L_overflow_error; \
4653 } \
4654 } while (0)
4655
4656 while (!ESTACK_ISEMPTY(s)) {
4657 obj = ESTACK_POP(s);
4658 L_again:
4659 if (is_list(obj)) {
4660 while (1) { /* Tail loop */
4661 while (1) { /* Head loop */
4662 if (yield_support && --yield_count <= 0)
4663 goto L_yield;
4664 objp = list_val(obj);
4665 /* Head */
4666 obj = CAR(objp);
4667 if (is_byte(obj)) {
4668 size++;
4669 if (size == 0) {
4670 goto L_overflow_error;
4671 }
4672 } else if (is_binary(obj) && binary_bitsize(obj) == 0) {
4673 SAFE_ADD(size, binary_size(obj));
4674 } else if (is_list(obj)) {
4675 ESTACK_PUSH(s, CDR(objp));
4676 continue; /* Head loop */
4677 } else if (is_not_nil(obj)) {
4678 goto L_type_error;
4679 }
4680 break;
4681 }
4682 /* Tail */
4683 obj = CDR(objp);
4684 if (is_list(obj))
4685 continue; /* Tail loop */
4686 else if (is_binary(obj) && binary_bitsize(obj) == 0) {
4687 SAFE_ADD(size, binary_size(obj));
4688 } else if (is_not_nil(obj)) {
4689 goto L_type_error;
4690 }
4691 break;
4692 }
4693 } else {
4694 if (yield_support && --yield_count <= 0)
4695 goto L_yield;
4696 if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */
4697 SAFE_ADD(size, binary_size(obj));
4698 } else if (is_not_nil(obj)) {
4699 goto L_type_error;
4700 }
4701 }
4702 }
4703 #undef SAFE_ADD
4704
4705 *sizep = (ErlDrvSizeT) size;
4706
4707 res = ERTS_IOLIST_OK;
4708
4709 L_return:
4710
4711 DESTROY_ESTACK(s);
4712
4713 if (yield_support) {
4714 int yc, reds;
4715 CLEAR_SAVED_ESTACK(&state->estack);
4716 yc = init_yield_count - yield_count;
4717 reds = ((yc - 1) / ERTS_IOLIST_SIZE_YIELDS_COUNT_PER_RED) + 1;
4718 BUMP_REDS(state->c_p, reds);
4719 state->reds_left -= reds;
4720 state->size = (ErlDrvSizeT) size;
4721 state->have_size = 1;
4722 }
4723
4724 return res;
4725
4726 L_overflow_error:
4727 res = ERTS_IOLIST_OVERFLOW;
4728 size = 0;
4729 goto L_return;
4730
4731 L_type_error:
4732 res = ERTS_IOLIST_TYPE;
4733 size = 0;
4734 goto L_return;
4735
4736 L_yield:
4737 BUMP_ALL_REDS(state->c_p);
4738 state->reds_left = 0;
4739 state->size = size;
4740 state->obj = obj;
4741 ESTACK_SAVE(s, &state->estack);
4742 return ERTS_IOLIST_YIELD;
4743 }
4744
erts_iolist_size_yielding(ErtsIOListState * state)4745 int erts_iolist_size_yielding(ErtsIOListState *state)
4746 {
4747 ErlDrvSizeT size = state->size;
4748 return iolist_size(1, state, state->obj, &size);
4749 }
4750
erts_iolist_size(Eterm obj,ErlDrvSizeT * sizep)4751 int erts_iolist_size(Eterm obj, ErlDrvSizeT* sizep)
4752 {
4753 *sizep = 0;
4754 return iolist_size(0, NULL, obj, sizep);
4755 }
4756
4757 /* return 0 if item is not a non-empty flat list of bytes
4758 otherwise return the nonzero length of the list */
4759 Sint
is_string(Eterm list)4760 is_string(Eterm list)
4761 {
4762 Sint len = 0;
4763
4764 while(is_list(list)) {
4765 Eterm* consp = list_val(list);
4766 Eterm hd = CAR(consp);
4767
4768 if (!is_byte(hd))
4769 return 0;
4770 len++;
4771 list = CDR(consp);
4772 }
4773 if (is_nil(list))
4774 return len;
4775 return 0;
4776 }
4777
4778 static int trim_threshold;
4779 static int top_pad;
4780 static int mmap_threshold;
4781 static int mmap_max;
4782
4783 Uint tot_bin_allocated;
4784
erts_init_utils(void)4785 void erts_init_utils(void)
4786 {
4787 #if defined(DEBUG) && defined(ARCH_64)
4788 erts_tsd_key_create(&erts_ycf_debug_stack_start_tsd_key, "erts_ycf_debug_stack_start_tsd_key");
4789 #endif
4790 }
4791
erts_utils_sched_spec_data_init(void)4792 void erts_utils_sched_spec_data_init(void)
4793 {
4794 #if defined(DEBUG) && defined(ARCH_64)
4795 erts_tsd_set(erts_ycf_debug_stack_start_tsd_key, NULL);
4796 #endif
4797 }
4798
erts_init_utils_mem(void)4799 void erts_init_utils_mem(void)
4800 {
4801 trim_threshold = -1;
4802 top_pad = -1;
4803 mmap_threshold = -1;
4804 mmap_max = -1;
4805 }
4806
4807 int
sys_alloc_opt(int opt,int value)4808 sys_alloc_opt(int opt, int value)
4809 {
4810 #if HAVE_MALLOPT
4811 int m_opt;
4812 int *curr_val;
4813
4814 switch(opt) {
4815 case SYS_ALLOC_OPT_TRIM_THRESHOLD:
4816 #ifdef M_TRIM_THRESHOLD
4817 m_opt = M_TRIM_THRESHOLD;
4818 curr_val = &trim_threshold;
4819 break;
4820 #else
4821 return 0;
4822 #endif
4823 case SYS_ALLOC_OPT_TOP_PAD:
4824 #ifdef M_TOP_PAD
4825 m_opt = M_TOP_PAD;
4826 curr_val = &top_pad;
4827 break;
4828 #else
4829 return 0;
4830 #endif
4831 case SYS_ALLOC_OPT_MMAP_THRESHOLD:
4832 #ifdef M_MMAP_THRESHOLD
4833 m_opt = M_MMAP_THRESHOLD;
4834 curr_val = &mmap_threshold;
4835 break;
4836 #else
4837 return 0;
4838 #endif
4839 case SYS_ALLOC_OPT_MMAP_MAX:
4840 #ifdef M_MMAP_MAX
4841 m_opt = M_MMAP_MAX;
4842 curr_val = &mmap_max;
4843 break;
4844 #else
4845 return 0;
4846 #endif
4847 default:
4848 return 0;
4849 }
4850
4851 if(mallopt(m_opt, value)) {
4852 *curr_val = value;
4853 return 1;
4854 }
4855
4856 #endif /* #if HAVE_MALLOPT */
4857
4858 return 0;
4859 }
4860
4861 void
sys_alloc_stat(SysAllocStat * sasp)4862 sys_alloc_stat(SysAllocStat *sasp)
4863 {
4864 sasp->trim_threshold = trim_threshold;
4865 sasp->top_pad = top_pad;
4866 sasp->mmap_threshold = mmap_threshold;
4867 sasp->mmap_max = mmap_max;
4868
4869 }
4870
4871 char *
erts_read_env(char * key)4872 erts_read_env(char *key)
4873 {
4874 size_t value_len = 256;
4875 char *value = erts_alloc(ERTS_ALC_T_TMP, value_len);
4876 int res;
4877 while (1) {
4878 res = erts_sys_explicit_8bit_getenv(key, value, &value_len);
4879
4880 if (res >= 0) {
4881 break;
4882 }
4883
4884 value = erts_realloc(ERTS_ALC_T_TMP, value, value_len);
4885 }
4886
4887 if (res != 1) {
4888 erts_free(ERTS_ALC_T_TMP, value);
4889 return NULL;
4890 }
4891
4892 return value;
4893 }
4894
4895 void
erts_free_read_env(void * value)4896 erts_free_read_env(void *value)
4897 {
4898 if (value)
4899 erts_free(ERTS_ALC_T_TMP, value);
4900 }
4901
4902
4903 typedef struct {
4904 size_t sz;
4905 char *ptr;
4906 } ErtsEmuArg;
4907
4908 typedef struct {
4909 int argc;
4910 ErtsEmuArg *arg;
4911 size_t no_bytes;
4912 } ErtsEmuArgs;
4913
4914 ErtsEmuArgs saved_emu_args = {0};
4915
4916 void
erts_save_emu_args(int argc,char ** argv)4917 erts_save_emu_args(int argc, char **argv)
4918 {
4919 #ifdef DEBUG
4920 char *end_ptr;
4921 #endif
4922 char *ptr;
4923 int i;
4924 size_t arg_sz[100];
4925 size_t size;
4926
4927 ASSERT(!saved_emu_args.argc);
4928
4929 size = sizeof(ErtsEmuArg)*argc;
4930 for (i = 0; i < argc; i++) {
4931 size_t sz = sys_strlen(argv[i]);
4932 if (i < sizeof(arg_sz)/sizeof(arg_sz[0]))
4933 arg_sz[i] = sz;
4934 size += sz+1;
4935 }
4936 ptr = (char *) malloc(size);
4937 if (!ptr) {
4938 ERTS_INTERNAL_ERROR("malloc failed to allocate memory!");
4939 }
4940 #ifdef DEBUG
4941 end_ptr = ptr + size;
4942 #endif
4943 saved_emu_args.arg = (ErtsEmuArg *) ptr;
4944 ptr += sizeof(ErtsEmuArg)*argc;
4945 saved_emu_args.argc = argc;
4946 saved_emu_args.no_bytes = 0;
4947 for (i = 0; i < argc; i++) {
4948 size_t sz;
4949 if (i < sizeof(arg_sz)/sizeof(arg_sz[0]))
4950 sz = arg_sz[i];
4951 else
4952 sz = sys_strlen(argv[i]);
4953 saved_emu_args.arg[i].ptr = ptr;
4954 saved_emu_args.arg[i].sz = sz;
4955 saved_emu_args.no_bytes += sz;
4956 ptr += sz+1;
4957 sys_strcpy(saved_emu_args.arg[i].ptr, argv[i]);
4958 }
4959 ASSERT(ptr == end_ptr);
4960 }
4961
4962 Eterm
erts_get_emu_args(Process * c_p)4963 erts_get_emu_args(Process *c_p)
4964 {
4965 #ifdef DEBUG
4966 Eterm *end_hp;
4967 #endif
4968 int i;
4969 Uint hsz;
4970 Eterm *hp, res;
4971
4972 hsz = saved_emu_args.no_bytes*2;
4973 hsz += saved_emu_args.argc*2;
4974
4975 hp = HAlloc(c_p, hsz);
4976 #ifdef DEBUG
4977 end_hp = hp + hsz;
4978 #endif
4979 res = NIL;
4980
4981 for (i = saved_emu_args.argc-1; i >= 0; i--) {
4982 Eterm arg = buf_to_intlist(&hp,
4983 saved_emu_args.arg[i].ptr,
4984 saved_emu_args.arg[i].sz,
4985 NIL);
4986 res = CONS(hp, arg, res);
4987 hp += 2;
4988 }
4989
4990 ASSERT(hp == end_hp);
4991
4992 return res;
4993 }
4994
4995 /*
4996 * To be used to silence unused result warnings, but do not abuse it.
4997 */
erts_silence_warn_unused_result(long unused)4998 void erts_silence_warn_unused_result(long unused)
4999 {
5000
5001 }
5002
5003 /*
5004 * Interval counts
5005 */
5006 void
erts_interval_init(erts_interval_t * icp)5007 erts_interval_init(erts_interval_t *icp)
5008 {
5009 erts_atomic64_init_nob(&icp->counter.atomic, 0);
5010 }
5011
5012 static ERTS_INLINE Uint64
step_interval_nob(erts_interval_t * icp)5013 step_interval_nob(erts_interval_t *icp)
5014 {
5015 return (Uint64) erts_atomic64_inc_read_nob(&icp->counter.atomic);
5016 }
5017
5018 static ERTS_INLINE Uint64
step_interval_relb(erts_interval_t * icp)5019 step_interval_relb(erts_interval_t *icp)
5020 {
5021 return (Uint64) erts_atomic64_inc_read_relb(&icp->counter.atomic);
5022 }
5023
5024
5025 static ERTS_INLINE Uint64
ensure_later_interval_nob(erts_interval_t * icp,Uint64 ic)5026 ensure_later_interval_nob(erts_interval_t *icp, Uint64 ic)
5027 {
5028 Uint64 curr_ic;
5029 curr_ic = (Uint64) erts_atomic64_read_nob(&icp->counter.atomic);
5030 if (curr_ic > ic)
5031 return curr_ic;
5032 return (Uint64) erts_atomic64_inc_read_nob(&icp->counter.atomic);
5033 }
5034
5035
5036 static ERTS_INLINE Uint64
ensure_later_interval_acqb(erts_interval_t * icp,Uint64 ic)5037 ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
5038 {
5039 Uint64 curr_ic;
5040 curr_ic = (Uint64) erts_atomic64_read_acqb(&icp->counter.atomic);
5041 if (curr_ic > ic)
5042 return curr_ic;
5043 return (Uint64) erts_atomic64_inc_read_acqb(&icp->counter.atomic);
5044 }
5045
5046 Uint64
erts_step_interval_nob(erts_interval_t * icp)5047 erts_step_interval_nob(erts_interval_t *icp)
5048 {
5049 return step_interval_nob(icp);
5050 }
5051
5052 Uint64
erts_step_interval_relb(erts_interval_t * icp)5053 erts_step_interval_relb(erts_interval_t *icp)
5054 {
5055 return step_interval_relb(icp);
5056 }
5057
5058 Uint64
erts_ensure_later_interval_nob(erts_interval_t * icp,Uint64 ic)5059 erts_ensure_later_interval_nob(erts_interval_t *icp, Uint64 ic)
5060 {
5061 return ensure_later_interval_nob(icp, ic);
5062 }
5063
5064 Uint64
erts_ensure_later_interval_acqb(erts_interval_t * icp,Uint64 ic)5065 erts_ensure_later_interval_acqb(erts_interval_t *icp, Uint64 ic)
5066 {
5067 return ensure_later_interval_acqb(icp, ic);
5068 }
5069
5070 /*
5071 * A millisecond timestamp without time correction where there's no hrtime
5072 * - for tracing on "long" things...
5073 */
erts_timestamp_millis(void)5074 Uint64 erts_timestamp_millis(void)
5075 {
5076 #ifdef ERTS_HAVE_OS_MONOTONIC_TIME_SUPPORT
5077 return ERTS_MONOTONIC_TO_MSEC(erts_os_monotonic_time());
5078 #else
5079 Uint64 res;
5080 SysTimeval tv;
5081 sys_gettimeofday(&tv);
5082 res = (Uint64) tv.tv_sec*1000000;
5083 res += (Uint64) tv.tv_usec;
5084 return (res / 1000);
5085 #endif
5086 }
5087
5088 /*
5089 * erts_check_below_limit() and
5090 * erts_check_above_limit() are put
5091 * in utils.c in order to prevent
5092 * inlining.
5093 */
5094
5095 int
erts_check_below_limit(char * ptr,char * limit)5096 erts_check_below_limit(char *ptr, char *limit)
5097 {
5098 return ptr < limit;
5099 }
5100
5101 int
erts_check_above_limit(char * ptr,char * limit)5102 erts_check_above_limit(char *ptr, char *limit)
5103 {
5104 return ptr > limit;
5105 }
5106
5107 void *
erts_ptr_id(void * ptr)5108 erts_ptr_id(void *ptr)
5109 {
5110 return ptr;
5111 }
5112
erts_get_stacklimit()5113 const void *erts_get_stacklimit() {
5114 return ethr_get_stacklimit();
5115 }
5116
erts_check_if_stack_grows_downwards(char * ptr)5117 int erts_check_if_stack_grows_downwards(char *ptr)
5118 {
5119 char c;
5120 if (erts_check_below_limit(&c, ptr))
5121 return 1;
5122 else
5123 return 0;
5124 }
5125
5126
5127 /*
5128 * Build a single {M,F,A,Loction} item to be part of
5129 * a stack trace.
5130 */
5131 Eterm*
erts_build_mfa_item(FunctionInfo * fi,Eterm * hp,Eterm args,Eterm * mfa_p,Eterm loc)5132 erts_build_mfa_item(FunctionInfo* fi, Eterm* hp, Eterm args, Eterm* mfa_p, Eterm loc)
5133 {
5134 if (fi->loc != LINE_INVALID_LOCATION) {
5135 Eterm tuple;
5136 int line = LOC_LINE(fi->loc);
5137 int file = LOC_FILE(fi->loc);
5138 Eterm file_term = NIL;
5139
5140 if (file == 0) {
5141 Atom* ap = atom_tab(atom_val(fi->mfa->module));
5142 file_term = buf_to_intlist(&hp, ".erl", 4, NIL);
5143 file_term = buf_to_intlist(&hp, (char*)ap->name, ap->len, file_term);
5144 } else {
5145 file_term = erts_atom_to_string(&hp, (fi->fname_ptr)[file-1]);
5146 }
5147
5148 tuple = TUPLE2(hp, am_line, make_small(line));
5149 hp += 3;
5150 loc = CONS(hp, tuple, loc);
5151 hp += 2;
5152 tuple = TUPLE2(hp, am_file, file_term);
5153 hp += 3;
5154 loc = CONS(hp, tuple, loc);
5155 hp += 2;
5156 }
5157
5158 if (is_list(args) || is_nil(args)) {
5159 *mfa_p = TUPLE4(hp, fi->mfa->module, fi->mfa->function,
5160 args, loc);
5161 } else {
5162 Eterm arity = make_small(fi->mfa->arity);
5163 *mfa_p = TUPLE4(hp, fi->mfa->module, fi->mfa->function,
5164 arity, loc);
5165 }
5166 return hp + 5;
5167 }
5168
5169 static void erts_qsort_helper(byte *base,
5170 size_t nr_of_items,
5171 size_t item_size,
5172 erts_void_ptr_cmp_t compare,
5173 Uint32 extra_seed);
5174 static erts_qsort_partion_array_result
5175 erts_qsort_partion_array(byte *base,
5176 size_t nr_of_items,
5177 size_t item_size,
5178 erts_void_ptr_cmp_t compare,
5179 Uint32 extra_seed);
5180
erts_qsort_swap(size_t item_size,void * iptr,void * jptr)5181 static void erts_qsort_swap(size_t item_size,
5182 void* iptr,
5183 void* jptr)
5184 {
5185 ASSERT(item_size % sizeof(UWord) == 0);
5186
5187 if (iptr != jptr) {
5188 /* Do it word by word */
5189 UWord* iwp = (UWord*) iptr;
5190 UWord* jwp = (UWord*) jptr;
5191 size_t cnt;
5192 for (cnt = item_size / sizeof(UWord); cnt; cnt--) {
5193 UWord tmp;
5194 sys_memcpy(&tmp, jwp, sizeof(UWord));
5195 sys_memcpy(jwp, iwp, sizeof(UWord));
5196 sys_memcpy(iwp, &tmp, sizeof(UWord));
5197 jwp++;
5198 iwp++;
5199 }
5200 }
5201 }
5202
5203 /* **Important Note**
5204 *
5205 * A yielding version of this function is generated with YCF. This
5206 * means that the code has to follow some restrictions. See note about
5207 * YCF near the top of the file for more information.
5208 */
5209 static erts_qsort_partion_array_result
erts_qsort_partion_array(byte * base,size_t nr_of_items,size_t item_size,erts_void_ptr_cmp_t compare,Uint32 extra_seed)5210 erts_qsort_partion_array(byte *base,
5211 size_t nr_of_items,
5212 size_t item_size,
5213 erts_void_ptr_cmp_t compare,
5214 Uint32 extra_seed)
5215 {
5216 /*
5217 The array is portioned using a fast-path-slow-path approach. We
5218 first assume that the there is no duplicates of the selected
5219 pivot item in the array. If this assumption holds, we only need
5220 to keep track of two regions (items greater than the pivot, and
5221 items smaller than the pivot) which leads to fewer swaps than if
5222 we need to keep track of three regions (items greater than the
5223 pivot, items smaller than the pivot, and items equal to the
5224 pivot). If we find an item that is equal to the pivot, we fall
5225 back to the slow path that keeps track of three regions.
5226
5227 Start of fast path:
5228 */
5229 byte* second_part_start = base + (nr_of_items * item_size);
5230 byte* curr = base + item_size;
5231 int more_than_one_pivot_item = 0;
5232 size_t pivot_index =
5233 ((size_t)erts_sched_local_random_hash_64_to_32_shift((Uint64)extra_seed +
5234 (Uint64)((UWord)compare) +
5235 (Uint64)((UWord)base) -
5236 (Uint64)nr_of_items)) % nr_of_items;
5237 /* Move pivot first */
5238 erts_qsort_swap(item_size, base, base + pivot_index * item_size);
5239 while (curr != second_part_start) {
5240 int compare_res = compare(curr, base);
5241 if (compare_res < 0) {
5242 /* Include in first part */
5243 curr += item_size;
5244 } else if (compare_res == 0) {
5245 more_than_one_pivot_item = 1;
5246 break;
5247 } else {
5248 /* Move to last part */
5249 second_part_start -= item_size;
5250 erts_qsort_swap(item_size, curr, second_part_start);
5251 }
5252 }
5253 if (!more_than_one_pivot_item) {
5254 /* Fast path successful (we don't need to use the slow path) */
5255 /* Move the pivot before the second part (if any) */
5256 erts_qsort_partion_array_result res;
5257 res.pivot_part_start = second_part_start - item_size;
5258 res.pivot_part_end = second_part_start;
5259 erts_qsort_swap(item_size, base, res.pivot_part_start);
5260 return res;
5261 } else {
5262 /*
5263 We have more than one item equal to the pivot item and need
5264 to keep track of three regions.
5265
5266 Start of slow path:
5267 */
5268 byte * pivot_part_start = curr - item_size;
5269 byte * pivot_part_end = curr + item_size;
5270 byte * last_part_start = second_part_start;
5271
5272 erts_qsort_swap(item_size, base, pivot_part_start);
5273
5274 while (pivot_part_end != last_part_start) {
5275 int compare_res =
5276 compare(pivot_part_end, pivot_part_end - item_size);
5277 if (compare_res == 0) {
5278 /* Include in pivot part */
5279 pivot_part_end += item_size;
5280 } else if (compare_res < 0) {
5281 /* Move pivot part one step to the right */
5282 erts_qsort_swap(item_size, pivot_part_start, pivot_part_end);
5283 pivot_part_start += item_size;
5284 pivot_part_end += item_size;
5285 } else {
5286 /* Move to last part */
5287 last_part_start -= item_size;
5288 erts_qsort_swap(item_size, pivot_part_end, last_part_start);
5289 }
5290 }
5291 {
5292 erts_qsort_partion_array_result res;
5293 res.pivot_part_start = pivot_part_start;
5294 res.pivot_part_end = pivot_part_end;
5295 return res;
5296 }
5297 }
5298 }
5299
erts_qsort_insertion_sort(byte * base,size_t nr_of_items,size_t item_size,erts_void_ptr_cmp_t compare)5300 static void erts_qsort_insertion_sort(byte *base,
5301 size_t nr_of_items,
5302 size_t item_size,
5303 erts_void_ptr_cmp_t compare)
5304 {
5305 byte *end = base + ((nr_of_items-1) * item_size);
5306 byte *unsorted_start = base;
5307 while (unsorted_start < end) {
5308 byte *smallest_so_far = unsorted_start;
5309 byte *curr = smallest_so_far + item_size;
5310 while (curr <= end) {
5311 if (compare(curr, smallest_so_far) < 0) {
5312 smallest_so_far = curr;
5313 }
5314 curr += item_size;
5315 }
5316 if (smallest_so_far != unsorted_start) {
5317 erts_qsort_swap(item_size, unsorted_start, smallest_so_far);
5318 }
5319 unsorted_start += item_size;
5320 }
5321 }
5322
5323 /* **Important Note**
5324 *
5325 * A yielding version of this function is generated with YCF. This
5326 * means that the code has to follow some restrictions. See note about
5327 * YCF near the top of the file for more information.
5328 */
erts_qsort_helper(byte * base,size_t nr_of_items,size_t item_size,erts_void_ptr_cmp_t compare,Uint32 extra_seed)5329 static void erts_qsort_helper(byte *base,
5330 size_t nr_of_items,
5331 size_t item_size,
5332 erts_void_ptr_cmp_t compare,
5333 Uint32 extra_seed)
5334 {
5335 erts_qsort_partion_array_result partion_info;
5336 size_t nr_of_items_in_first_partion;
5337 size_t nr_of_items_second_partion;
5338 const size_t qsort_cut_off = 16;
5339 if (nr_of_items <= qsort_cut_off) {
5340 erts_qsort_insertion_sort(base, nr_of_items, item_size, compare);
5341 YCF_CONSUME_REDS(nr_of_items * erts_fit_in_bits_int64(nr_of_items) * 2);
5342 return;
5343 }
5344 partion_info = erts_qsort_partion_array(base,
5345 nr_of_items,
5346 item_size,
5347 compare,
5348 extra_seed);
5349 nr_of_items_in_first_partion =
5350 ((partion_info.pivot_part_start - base) / sizeof(byte)) / item_size;
5351 nr_of_items_second_partion =
5352 nr_of_items - (((partion_info.pivot_part_end - base) / sizeof(byte)) / item_size);
5353 erts_qsort_helper(base,
5354 nr_of_items_in_first_partion,
5355 item_size, compare,
5356 extra_seed + 1);
5357 erts_qsort_helper(partion_info.pivot_part_end,
5358 nr_of_items_second_partion,
5359 item_size,
5360 compare,
5361 extra_seed + 1);
5362 }
5363
5364 /***************
5365 ** Quicksort **
5366 ***************
5367 *
5368 * A quicksort implementation with the same interface as the qsort
5369 * function in the C standard library.
5370 *
5371 * A yielding version of erts_qsort is generated by YCF. The functions
5372 * (erts_qsort_ycf_gen_yielding, erts_qsort_ycf_gen_continue and
5373 * erts_qsort_ycf_gen_destroy) for the yielding version is declared in
5374 * global.h. See note about YCF near the top of the file for more
5375 * information.
5376 *
5377 * !!!!
5378 * Note that the erts_qsort_swap that is used by erts_qsort does not have
5379 * trapping enabled. If the array items are large erts_qsort should also
5380 * trap in the erts_qsort_swap function, but this causes terrible
5381 * performance when the array items are small, so one should investigate
5382 * a fast-path approach
5383 */
erts_qsort(void * base,size_t nr_of_items,size_t item_size,erts_void_ptr_cmp_t compare)5384 void erts_qsort(void *base,
5385 size_t nr_of_items,
5386 size_t item_size,
5387 erts_void_ptr_cmp_t compare)
5388 {
5389 const int improved_seed_limit = 128;
5390 Uint32 seed = nr_of_items > improved_seed_limit ? erts_sched_local_random(0) : 1;
5391 erts_qsort_helper((byte*)base, nr_of_items, item_size, compare, seed);
5392 }
5393
5394 typedef struct {
5395 void* trap_state;
5396 erts_ycf_continue_fun_t ycf_continue;
5397 erts_ycf_destroy_trap_state_fun_t ycf_destroy_trap_state;
5398 } erts_ycf_trap_driver_state_holder;
5399
erts_ycf_trap_driver_dtor(Binary * bin)5400 static int erts_ycf_trap_driver_dtor(Binary* bin)
5401 {
5402 erts_ycf_trap_driver_state_holder* holder = ERTS_MAGIC_BIN_DATA(bin);
5403 if (holder->trap_state != NULL) {
5404 holder->ycf_destroy_trap_state(holder->trap_state);
5405 }
5406 return 1;
5407 }
5408
erts_ycf_trap_driver_alloc(size_t size,void * ctx)5409 static void* erts_ycf_trap_driver_alloc(size_t size, void* ctx)
5410 {
5411 ErtsAlcType_t type = (ErtsAlcType_t)(Uint)ctx;
5412 return erts_alloc(type, size);
5413 }
5414
erts_ycf_trap_driver_free(void * data,void * ctx)5415 static void erts_ycf_trap_driver_free(void* data, void* ctx)
5416 {
5417 ErtsAlcType_t type = (ErtsAlcType_t)(Uint)ctx;
5418 erts_free(type, data);
5419 }
5420
erts_ycf_trap_driver_trap_helper(Process * p,Eterm * bif_args,int nr_of_arguments,Eterm trapTerm,Export * export_entry)5421 static BIF_RETTYPE erts_ycf_trap_driver_trap_helper(Process* p,
5422 Eterm* bif_args,
5423 int nr_of_arguments,
5424 Eterm trapTerm,
5425 Export *export_entry) {
5426 int i;
5427 Eterm* reg = erts_proc_sched_data((p))->registers->x_reg_array.d;
5428 ERTS_BIF_PREP_TRAP(export_entry, p, nr_of_arguments);
5429 reg[0] = trapTerm;
5430 for (i = 1; i < nr_of_arguments; i++) {
5431 reg[i] = bif_args[i];
5432 }
5433 return THE_NON_VALUE; \
5434 }
5435
erts_ycf_trap_driver(Process * p,Eterm * bif_args,int nr_of_arguments,int iterations_per_red,ErtsAlcType_t memory_allocation_type,size_t ycf_stack_alloc_size,int export_entry_index,erts_ycf_continue_fun_t ycf_continue_fun,erts_ycf_destroy_trap_state_fun_t ycf_destroy_fun,erts_ycf_yielding_fun_t ycf_yielding_fun)5436 BIF_RETTYPE erts_ycf_trap_driver(Process* p,
5437 Eterm* bif_args,
5438 int nr_of_arguments,
5439 int iterations_per_red,
5440 ErtsAlcType_t memory_allocation_type,
5441 size_t ycf_stack_alloc_size,
5442 int export_entry_index,
5443 erts_ycf_continue_fun_t ycf_continue_fun,
5444 erts_ycf_destroy_trap_state_fun_t ycf_destroy_fun,
5445 erts_ycf_yielding_fun_t ycf_yielding_fun) {
5446 const long reds = iterations_per_red * ERTS_BIF_REDS_LEFT(p);
5447 long nr_of_reductions = DBG_RANDOM_REDS(reds, (Uint)&p);
5448 const long init_reds = nr_of_reductions;
5449 if (is_internal_magic_ref(bif_args[0])) {
5450 erts_ycf_trap_driver_state_holder *state_holder;
5451 Binary *state_bin = erts_magic_ref2bin(bif_args[0]);
5452 BIF_RETTYPE ret;
5453 if (ERTS_MAGIC_BIN_DESTRUCTOR(state_bin) == erts_ycf_trap_driver_dtor) {
5454 /* Continue a trapped call */
5455 erts_set_gc_state(p, 1);
5456 state_holder = ERTS_MAGIC_BIN_DATA(state_bin);
5457 #if defined(DEBUG) && defined(ARCH_64)
5458 ycf_debug_set_stack_start(&nr_of_reductions);
5459 #endif
5460 ret = state_holder->ycf_continue(&nr_of_reductions,
5461 &state_holder->trap_state,
5462 NULL);
5463 #if defined(DEBUG) && defined(ARCH_64)
5464 ycf_debug_reset_stack_start();
5465 #endif
5466 BUMP_REDS(p, (init_reds - nr_of_reductions) / iterations_per_red);
5467 if (state_holder->trap_state == NULL) {
5468 return ret;
5469 } else {
5470 erts_set_gc_state(p, 0);
5471 return erts_ycf_trap_driver_trap_helper(p,
5472 bif_args,
5473 nr_of_arguments,
5474 bif_args[0],
5475 BIF_TRAP_EXPORT(export_entry_index));
5476 }
5477 }
5478 }
5479 {
5480 void *trap_state = NULL;
5481 BIF_RETTYPE ret;
5482 #if defined(DEBUG) && defined(ARCH_64)
5483 ycf_debug_set_stack_start(&nr_of_reductions);
5484 #endif
5485 /* Start a new call */
5486 ret =
5487 ycf_yielding_fun(&nr_of_reductions,
5488 &trap_state,
5489 NULL,
5490 erts_ycf_trap_driver_alloc,
5491 erts_ycf_trap_driver_free,
5492 (void*)(Uint)memory_allocation_type,
5493 ycf_stack_alloc_size,
5494 NULL,
5495 p,
5496 bif_args);
5497 #if defined(DEBUG) && defined(ARCH_64)
5498 ycf_debug_reset_stack_start();
5499 #endif
5500 BUMP_REDS(p, (init_reds - nr_of_reductions) / iterations_per_red);
5501 if (trap_state == NULL) {
5502 /* The operation has completed */
5503 return ret;
5504 } else {
5505 /* We need to trap */
5506 Binary* state_bin = erts_create_magic_binary(sizeof(erts_ycf_trap_driver_state_holder),
5507 erts_ycf_trap_driver_dtor);
5508 Eterm* hp = HAlloc(p, ERTS_MAGIC_REF_THING_SIZE);
5509 Eterm state_mref = erts_mk_magic_ref(&hp, &MSO(p), state_bin);
5510 erts_ycf_trap_driver_state_holder *holder = ERTS_MAGIC_BIN_DATA(state_bin);
5511 holder->ycf_continue = ycf_continue_fun;
5512 holder->ycf_destroy_trap_state = ycf_destroy_fun;
5513 holder->trap_state = trap_state;
5514 erts_set_gc_state(p, 0);
5515 return erts_ycf_trap_driver_trap_helper(p,
5516 bif_args,
5517 nr_of_arguments,
5518 state_mref,
5519 BIF_TRAP_EXPORT(export_entry_index));
5520 }
5521 }
5522 }
5523