156
erts_arith_alloc(Process* p, Eterm* last_htop, Uint need)
158
return do_alloc(p, last_htop, need);
162
erts_heap_alloc(Process* p, Uint need)
166
#ifdef HEAP_FRAG_ELIM_TEST
167
if (need <= ARITH_AVAIL(p)) {
168
Eterm* hp = ARITH_HEAP(p);
170
ARITH_HEAP(p) += need;
171
ARITH_AVAIL(p) -= need;
177
if (p->htop == NULL) {
178
if (need <= global_hend - global_htop) {
182
} else if (global_htop != NULL) {
176
#if defined(HEAP_FRAG_ELIM_TEST)
177
void erts_arith_shrink(Process* p, Eterm* hp)
179
#if defined(CHECK_FOR_HOLES)
183
* We must find the heap fragment that hp points into.
184
* If we are unlucky, we might have to search through
185
* a large part of the list. We'll hope that will not
188
for (hf = MBUF(p); hf != 0; hf = hf->next) {
189
if (hp - hf->mem < (unsigned long)hf->size) {
184
* Garbage collect the global heap.
191
* We are not allowed to changed hf->size (because the
192
* size must be correct when deallocating). Therefore,
193
* clear out the uninitialized part of the heap fragment.
188
p.htop = global_htop;
189
p.heap = global_heap;
190
p.hend = global_hend;
191
p.heap_sz = global_heap_sz;
195
p.group_leader = NIL;
196
p.seq_trace_token = NIL;
198
p.debug_dictionary = NULL;
199
#ifdef HEAP_FRAG_ELIM_TEST
205
(void) erts_garbage_collect(&p, need, NULL, 0);
206
global_htop = p.htop;
207
global_heap = p.heap;
208
global_hend = p.hend;
209
global_heap_sz = p.heap_sz;
214
return erts_global_alloc(need);
195
Eterm* to = hf->mem + hf->size;
218
hp = do_alloc(p, p->htop, need);
220
#ifdef HEAP_FRAG_ELIM_TEST
221
if (SAVED_HEAP_TOP(p) == NULL) {
222
SAVED_HEAP_TOP(p) = HEAP_TOP(p);
223
HEAP_TOP(p) = HEAP_LIMIT(p);
224
MSO(p).overhead = HEAP_SIZE(p);
225
HALLOC_MBUF(p) = MBUF(p);
228
ARITH_HEAP(p) = NULL;
235
erts_global_alloc(Uint need)
205
void erts_arith_shrink(Process* p, Eterm* hp)
237
if (need <= global_hend - global_htop) {
238
Eterm* hp = global_htop;
209
#if !defined(HYBRID) && !defined(DEBUG) && !defined(CHECK_FOR_HOLES)
210
if (ARITH_AVAIL(p) == 0) {
243
* Either there is no enough room on the global heap, or the heap pointers
244
* are "owned" by the running process.
212
* For a non-hybrid system, there is nothing to gain by
246
ErlHeapFragment* bp = (ErlHeapFragment*)
247
ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG,
248
sizeof(ErlHeapFragment) + ((need-1)*sizeof(Eterm)));
249
bp->next = MBUF(dummy);
251
if (HALLOC_MBUF(dummy) == NULL) {
252
HALLOC_MBUF(dummy) = bp;
255
MBUF_SIZE(dummy) += need;
256
bp->off_heap.mso = NULL;
257
bp->off_heap.externals = NULL;
258
bp->off_heap.overhead = 0;
259
MSO(dummy).overhead += (sizeof(ErlHeapFragment)/sizeof(Eterm) - 1);
265
#if 0 /* XXX Not used! */
266
/* Does what arith_alloc does, but only ensures that the space is
267
allocated; doesn't actually start using it. */
268
void arith_ensure_alloc(Process* p, Uint need)
277
if (ARITH_AVAIL(p) >= need)
280
n = (need < 128) ? 128 : need;
281
bp = new_message_buffer(n+1);
288
for (i = 0; i <= n; i++) {
289
hp[i] = ARITH_MARKER;
294
ARITH_CHECK_ME(p) = ARITH_HEAP(p);
220
* We must find the heap fragment that hp points into.
221
* If we are unlucky, we might have to search through
222
* a large part of the list. We'll hope that will not
225
for (hf = MBUF(p); hf != 0; hf = hf->next) {
226
if (hp - hf->mem < (unsigned long)hf->size) {
227
if (ARITH_HEAP(p) - hf->mem < (unsigned long)hf->size) {
229
* Regain lost space from the current arith heap
230
* and make sure that there are no garbage in a heap
231
* fragment (important for the hybrid heap).
233
Uint diff = ARITH_HEAP(p) - hp;
235
ARITH_AVAIL(p) += diff;
238
hp[--diff] = ERTS_HOLE_MARKER;
240
ARITH_CHECK_ME(p) = hp;
242
#if defined(HYBRID) || defined(DEBUG) || defined(CHECK_FOR_HOLES)
245
* We are not allowed to changed hf->size (because the
246
* size must be correct when deallocating). Therefore,
247
* clear out the uninitialized part of the heap fragment.
249
Eterm* to = hf->mem + hf->size;
261
#ifdef CHECK_FOR_HOLES
263
erts_set_hole_marker(Eterm* ptr, Uint sz)
268
for (i = 0; i < sz; i++) {
269
*p++ = ERTS_HOLE_MARKER;
343
319
#define IS_PRINT(c) (!IS_CNTRL(c))
346
* Generate the integer part from a double.
349
double_to_integer(Process* p, double x)
359
if ((x < (double) (MAX_SMALL+1)) && (x > (double) (MIN_SMALL-1))) {
361
return make_small(xi);
371
/* Unscale & (calculate exponent) */
374
x /= D_BASE; /* "shift" right */
377
sz = BIG_NEED_SIZE(ds); /* number of words */
380
* Beam note: This function is called from guard bifs (round/1 and trunc/1),
381
* which are not allowed to build anything at all on the heap.
382
* Therefore it is essential to use the ArithAlloc() macro instead of HAlloc().
384
hp = ArithAlloc(p, sz+1);
386
xp = (digit_t*) (hp + 1);
388
for (i = ds-1; i >= 0; i--) {
391
x *= D_BASE; /* "shift" left */
393
xp[i] = d; /* store digit */
394
x -= d; /* remove integer part */
396
while ((ds & (BIG_DIGITS_PER_WORD-1)) != 0) {
401
*hp = make_neg_bignum_header(sz-1);
403
*hp = make_pos_bignum_header(sz-1);
408
Uint erts_tot_link_lh_size;
411
* Create a new link with ref.
413
* item: pid, port, atom, small, or NIL.
414
* data: pid, port, atom, small, or NIL.
415
* ref: reference, or NIL
418
new_ref_link(ErlLink* next, ErlLinkType type, Eterm item, Eterm data, Eterm ref)
420
/* item, data, and ref are allowed to be pids, ports, refs, or any
421
immediate Erlang term */
423
#define CP_LINK_VAL(To, Hp, From) \
425
if (IS_CONST(From)) \
431
ASSERT(is_internal_ref((From)) || is_external((From))); \
432
(To) = make_boxed((Hp)); \
433
len__ = thing_arityval(*boxed_val((From))) + 1; \
434
for(i__ = 0; i__ < len__; i__++) \
435
(*((Hp)++)) = boxed_val((From))[i__]; \
436
if (is_external((To))) { \
437
external_thing_ptr((To))->next = NULL; \
438
external_thing_ptr((To))->node->refc++; \
445
Uint link_size = ERL_LINK_SIZE;
448
link_size += NC_HEAP_SIZE(item);
450
link_size += NC_HEAP_SIZE(data);
452
link_size += NC_HEAP_SIZE(ref);
454
ASSERT(link_size >= ERL_LINK_SIZE);
456
ERTS_PROC_MORE_MEM(link_size);
458
if (link_size == ERL_LINK_SIZE) {
459
lnk = (ErlLink*) erts_alloc(ERTS_ALC_T_LINK,
460
link_size*sizeof(Uint));
463
else if (link_size <= ERL_LINK_SH_SIZE) {
464
lnk = (ErlLink*) erts_alloc(ERTS_ALC_T_LINK_SH,
465
link_size*sizeof(Uint));
469
lnk = (ErlLink*) erts_alloc(ERTS_ALC_T_LINK_LH,
470
link_size*sizeof(Uint));
471
erts_tot_link_lh_size += link_size*sizeof(Uint);
478
CP_LINK_VAL(lnk->item, hp, item);
479
CP_LINK_VAL(lnk->data, hp, data);
480
CP_LINK_VAL(lnk->ref, hp, ref);
482
ASSERT(!hp || (Uint) hp <= (Uint) (lnk + link_size));
483
ASSERT(next == lnk->next);
484
ASSERT(type == lnk->type);
485
ASSERT(EQ(item, lnk->item));
486
ASSERT(EQ(data, lnk->data));
487
ASSERT(EQ(ref, lnk->ref));
499
new_link(ErlLink* next, ErlLinkType type, Eterm item, Eterm data)
501
return new_ref_link(next, type, item, data, NIL);
505
** Delete an old link (and relink)
517
link_size = ERL_LINK_SIZE;
519
if (!IS_CONST(tlink->item)) {
520
link_size += NC_HEAP_SIZE(tlink->item);
521
if(is_external(tlink->item)) {
522
node = external_thing_ptr(tlink->item)->node;
523
DEREF_ERL_NODE(node);
526
if (!IS_CONST(tlink->data)) {
527
link_size += NC_HEAP_SIZE(tlink->data);
528
if(is_external(tlink->data)) {
529
node = external_thing_ptr(tlink->data)->node;
530
DEREF_ERL_NODE(node);
533
if (!IS_CONST(tlink->ref)) {
534
link_size += NC_HEAP_SIZE(tlink->ref);
535
if(is_external(tlink->ref)) {
536
node = external_thing_ptr(tlink->ref)->node;
537
DEREF_ERL_NODE(node);
542
ASSERT(link_size >= ERL_LINK_SIZE);
543
sys_memset((void *) tlink, 0x0f, link_size*sizeof(Uint));
546
ERTS_PROC_LESS_MEM(link_size);
548
if (link_size == ERL_LINK_SIZE)
549
erts_free(ERTS_ALC_T_LINK, (void *) tlink);
550
else if (link_size <= ERL_LINK_SH_SIZE)
551
erts_free(ERTS_ALC_T_LINK_SH, (void *) tlink);
553
erts_tot_link_lh_size -= link_size*sizeof(Uint);
554
erts_free(ERTS_ALC_T_LINK_LH, (void *) tlink);
562
not_opt_find_link_by_ref(ErlLink** first, Eterm ref)
568
for (prev = NULL, lnk = *first; lnk; prev = lnk, lnk = lnk->next)
569
if (eq(lnk->ref, ref))
570
return (prev == NULL) ? first : &prev->next;
577
** Find a link, given the value of the ref field
578
** Result is NULL if not found
579
** otherwise a pointer to a pointer to it is returned (fit with del_link)
582
find_link_by_ref(ErlLink** first, Eterm ref)
590
ErlLink **not_opt_res = not_opt_find_link_by_ref(first, ref);
593
if (is_internal_ref(ref)) {
594
anode = internal_ref_node(ref);
595
alen = internal_ref_no_of_numbers(ref);
596
anum = internal_ref_numbers(ref);
599
ASSERT(is_external_ref(ref));
600
anode = external_ref_node(ref);
601
alen = external_ref_no_of_numbers(ref);
602
anum = external_ref_numbers(ref);
607
for (prev = NULL, lnk = *first; lnk; prev = lnk, lnk = lnk->next) {
609
* "if (eq(lnk->ref, ref))
610
* return (prev == NULL) ? first : &prev->next;"
613
if (is_nil(lnk->ref))
616
if (is_internal_ref(lnk->ref)) {
617
ASSERT(internal_ref_no_of_numbers(lnk->ref) > 0);
620
bnum = internal_ref_numbers(lnk->ref);
621
if (anum[0] != bnum[0])
623
if (anode != internal_ref_node(lnk->ref))
625
blen = internal_ref_no_of_numbers(lnk->ref);
628
ASSERT(is_external_ref(lnk->ref));
629
ASSERT(external_ref_no_of_numbers(lnk->ref) > 0);
632
bnum = external_ref_numbers(lnk->ref);
633
if (anum[0] != bnum[0])
635
if (anode != external_ref_node(lnk->ref))
637
blen = external_ref_no_of_numbers(lnk->ref);
641
if (alen == 3 && blen == 3) { /* Most refs are of length 3 */
643
if (anum[1] != bnum[1] || anum[2] != bnum[2])
647
res = (prev == NULL) ? first : &prev->next;
648
ASSERT(not_opt_res == res);
660
for (i = 1; i < common_len; i++)
661
if (anum[i] != bnum[i])
667
for (i = common_len; i < alen; i++)
672
for (i = common_len; i < blen; i++)
683
ASSERT(not_opt_res == NULL);
687
static ERTS_INLINE ErlLink**
688
gen_find_link(ErlLink** first, ErlLinkType type, Eterm item, Eterm data)
693
for (lnk = *first, prev = NULL; lnk; prev = lnk, lnk = lnk->next) {
694
if (lnk->type != type)
696
if (!EQ(lnk->item, item))
698
if (is_nil(data) || EQ(lnk->data, data))
699
return (prev == NULL) ? first : &prev->next;
706
** Result is NULL if not found
707
** otherwise a pointer to a pointer to it is returned (fit with del_link)
710
find_link(ErlLink** first, ErlLinkType type, Eterm item, Eterm data)
712
ErlLink *lnk = *first;
713
ErlLink *prev = NULL;
716
/* First a couple of optimized special cases that are common... */
718
if (is_immed(item)) {
719
if (is_immed(data) || is_external_pid(data)) {
720
/* Local links, node monitors, and remote links in a dist entries
721
will be handled here. */
722
for (; lnk; prev = lnk, lnk = lnk->next) {
723
if (lnk->type != type)
725
if (lnk->item != item)
729
res = (prev == NULL) ? first : &prev->next;
730
ASSERT(res == gen_find_link(first, type, item, data));
733
if (data == lnk->data)
735
if (is_not_external_pid(lnk->data))
737
if (external_node(data) != external_node(lnk->data))
739
if (external_pid_data(data) != external_pid_data(lnk->data))
744
ASSERT(NULL == gen_find_link(first, type, item, data));
748
else if (is_external_pid(item) && is_nil(data)) {
749
/* Remote links stored in process structs will be handled here. */
750
for (; lnk; prev = lnk, lnk = lnk->next) {
751
if (lnk->type != type)
753
if (is_not_external_pid(lnk->item))
755
if (external_node(item) != external_node(lnk->item))
757
if (external_pid_data(item) != external_pid_data(lnk->item))
764
/* ... and then the general case. */
765
return gen_find_link(first, type, item, data);
769
erts_link_size(ErlLink* elp)
774
size = ERL_LINK_SIZE*sizeof(Uint);
775
if(!IS_CONST(elp->item))
776
size += NC_HEAP_SIZE(elp->item)*sizeof(Uint);
777
if(!IS_CONST(elp->data))
778
size += NC_HEAP_SIZE(elp->data)*sizeof(Uint);
779
if(!IS_CONST(elp->ref))
780
size += NC_HEAP_SIZE(elp->ref)*sizeof(Uint);
785
322
* Calculate length of a list.
786
323
* Returns -1 if not a proper list (i.e. not terminated with NIL)
1689
Uint siz = (Uint) VECTOR_SIZE(term);
1693
hash = make_broken_hash(erts_unchecked_vector_get(i,term),
1695
return hash*FUNNY_NUMBER11 + siz;
1700
1396
erl_exit(1, "Invalid tag in make_broken_hash\n");
1705
static int do_send_to_logger(char *tag, Eterm gleader, char *buf, int len)
1401
static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len)
1707
1403
/* error_logger !
1708
1404
{notify,{info_msg,gleader,{emulator,"~s~n",[<message as list>]}}} |
1709
1405
{notify,{error,gleader,{emulator,"~s~n",[<message as list>]}}} |
1710
1406
{notify,{warning_msg,gleader,{emulator,"~s~n",[<message as list>}]}} */
1712
Eterm atom_tag, atom_notify;
1717
1411
Eterm list,plist,format,tuple1,tuple2,tuple3;
1414
ErlHeapFragment *bp;
1419
ASSERT(is_atom(tag));
1719
1421
if (len <= 0) {
1722
if ((p = whereis_process(am_error_logger)) == NULL ||
1723
p->status == P_EXITING || p->status == P_RUNNING) {
1724
/* Now, buf might not be null-terminated and it might be tmp_buf... */
1725
if (len >= TMP_BUF_SIZE) {
1726
len = TMP_BUF_SIZE - 1;
1728
sys_memmove(tmp_buf,buf,len);
1729
tmp_buf[len] = '\0';
1730
erl_printf(CERR,"(no error logger present) %s: %s\r\n",
1428
!erts_get_scheduler_data() || /* Must be scheduler thread */
1430
(p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0)) == NULL
1431
|| p->status == P_RUNNING) {
1432
/* buf *always* points to a null terminated string */
1433
erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n",
1735
1437
/* So we have an error logger, lets build the message */
1736
atom_tag = am_atom_put(tag,strlen(tag));
1737
atom_notify = am_atom_put("notify",6);
1738
1439
gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader);
1739
1440
sz = len * 2 /* message list */+ 2 /* cons surrounding message list */
1741
1442
3 /*outher 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ +
1742
1443
8 /* "~s~n" */;
1445
bp = new_message_buffer(sz);
1446
ohp = &bp->off_heap;
1744
1452
gl = (is_nil(gleader)
1746
1454
: (IS_CONST(gleader)
1748
: copy_struct(gleader,gl_sz,&hp,&MSO(p))));
1456
: copy_struct(gleader,gl_sz,&hp,ohp)));
1749
1457
list = buf_to_intlist(&hp, buf, len, NIL);
1750
1458
plist = CONS(hp,list,NIL);
1752
1460
format = buf_to_intlist(&hp, "~s~n", 4, NIL);
1753
1461
tuple1 = TUPLE3(hp, am_emulator, format, plist);
1755
tuple2 = TUPLE3(hp, atom_tag, gl, tuple1);
1463
tuple2 = TUPLE3(hp, tag, gl, tuple1);
1757
tuple3 = TUPLE2(hp, atom_notify, tuple2);
1465
tuple3 = TUPLE2(hp, am_notify, tuple2);
1758
1466
#ifdef HARDDEBUG
1759
display(tuple3,CERR);
1761
queue_message_tt(p, NULL, tuple3, NIL);
1467
erts_fprintf(stderr, "%T\n", tuple3);
1471
Eterm from = erts_get_current_pid();
1472
if (is_not_internal_pid(from))
1474
erts_queue_error_logger_message(from, tuple3, bp);
1477
erts_queue_message(p, 0/* only used for smp build */, NULL, tuple3, NIL);
1765
int erts_send_info_to_logger(Eterm gleader, char *buf, int len)
1482
static ERTS_INLINE int
1483
send_info_to_logger(Eterm gleader, char *buf, int len)
1767
return do_send_to_logger("info_msg",gleader,buf,len);
1485
return do_send_to_logger(am_info_msg, gleader, buf, len);
1770
int erts_send_warning_to_logger(Eterm gleader, char *buf, int len)
1488
static ERTS_INLINE int
1489
send_warning_to_logger(Eterm gleader, char *buf, int len)
1773
1492
switch (erts_error_logger_warnings) {
1778
tag = "warning_msg";
1493
case am_info: tag = am_info_msg; break;
1494
case am_warning: tag = am_warning_msg; break;
1495
default: tag = am_error; break;
1784
return do_send_to_logger(tag,gleader,buf,len);
1787
int erts_send_error_to_logger(Eterm gleader, char *buf, int len)
1789
return do_send_to_logger("error",gleader,buf,len);
1792
/* To be removed, old obsolete interface */
1793
int send_error_to_logger(Eterm gleader)
1795
return erts_send_error_to_logger(gleader,tmp_buf,cerr_pos) == 0;
1497
return do_send_to_logger(tag, gleader, buf, len);
1500
static ERTS_INLINE int
1501
send_error_to_logger(Eterm gleader, char *buf, int len)
1503
return do_send_to_logger(am_error, gleader, buf, len);
1506
#define LOGGER_DSBUF_INC_SZ 256
1508
static erts_dsprintf_buf_t *
1509
grow_logger_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need)
1512
size_t free_size = dsbufp->size - dsbufp->str_len;
1514
ASSERT(dsbufp && dsbufp->str);
1516
if (need <= free_size)
1519
size = need - free_size + LOGGER_DSBUF_INC_SZ;
1520
size = (((size + LOGGER_DSBUF_INC_SZ - 1) / LOGGER_DSBUF_INC_SZ)
1521
* LOGGER_DSBUF_INC_SZ);
1522
size += dsbufp->size;
1523
ASSERT(dsbufp->str_len + need <= size);
1524
dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_LOGGER_DSBUF,
1525
(void *) dsbufp->str,
1527
dsbufp->size = size;
1531
erts_dsprintf_buf_t *
1532
erts_create_logger_dsbuf(void)
1534
erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_logger_dsbuf);
1535
erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_LOGGER_DSBUF,
1536
sizeof(erts_dsprintf_buf_t));
1537
sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t));
1538
dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_LOGGER_DSBUF,
1539
LOGGER_DSBUF_INC_SZ);
1540
dsbufp->str[0] = '\0';
1541
dsbufp->size = LOGGER_DSBUF_INC_SZ;
1545
static ERTS_INLINE void
1546
destroy_logger_dsbuf(erts_dsprintf_buf_t *dsbufp)
1548
ASSERT(dsbufp && dsbufp->str);
1549
erts_free(ERTS_ALC_T_LOGGER_DSBUF, (void *) dsbufp->str);
1550
erts_free(ERTS_ALC_T_LOGGER_DSBUF, (void *) dsbufp);
1554
erts_send_info_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
1557
res = send_info_to_logger(gleader, dsbufp->str, dsbufp->str_len);
1558
destroy_logger_dsbuf(dsbufp);
1563
erts_send_warning_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
1566
res = send_warning_to_logger(gleader, dsbufp->str, dsbufp->str_len);
1567
destroy_logger_dsbuf(dsbufp);
1572
erts_send_error_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp)
1575
res = send_error_to_logger(gleader, dsbufp->str, dsbufp->str_len);
1576
destroy_logger_dsbuf(dsbufp);
1581
erts_send_info_to_logger_str(Eterm gleader, char *str)
1583
return send_info_to_logger(gleader, str, sys_strlen(str));
1587
erts_send_warning_to_logger_str(Eterm gleader, char *str)
1589
return send_warning_to_logger(gleader, str, sys_strlen(str));
1593
erts_send_error_to_logger_str(Eterm gleader, char *str)
1595
return send_error_to_logger(gleader, str, sys_strlen(str));
1599
erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *dsbuf)
1601
return erts_send_info_to_logger(NIL, dsbuf);
1605
erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *dsbuf)
1607
return erts_send_warning_to_logger(NIL, dsbuf);
1611
erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *dsbuf)
1613
return erts_send_error_to_logger(NIL, dsbuf);
1617
erts_send_info_to_logger_str_nogl(char *str)
1619
return erts_send_info_to_logger_str(NIL, str);
1623
erts_send_warning_to_logger_str_nogl(char *str)
1625
return erts_send_warning_to_logger_str(NIL, str);
1629
erts_send_error_to_logger_str_nogl(char *str)
1631
return erts_send_error_to_logger_str(NIL, str);
1635
#define TMP_DSBUF_INC_SZ 256
1637
static erts_dsprintf_buf_t *
1638
grow_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need)
1641
size_t free_size = dsbufp->size - dsbufp->str_len;
1645
if (need <= free_size)
1647
size = need - free_size + TMP_DSBUF_INC_SZ;
1648
size = ((size + TMP_DSBUF_INC_SZ - 1)/TMP_DSBUF_INC_SZ)*TMP_DSBUF_INC_SZ;
1649
size += dsbufp->size;
1650
ASSERT(dsbufp->str_len + need <= size);
1651
dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_TMP_DSBUF,
1652
(void *) dsbufp->str,
1654
dsbufp->size = size;
1658
erts_dsprintf_buf_t *
1659
erts_create_tmp_dsbuf(Uint size)
1661
Uint init_size = size ? size : TMP_DSBUF_INC_SZ;
1662
erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_tmp_dsbuf);
1663
erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_TMP_DSBUF,
1664
sizeof(erts_dsprintf_buf_t));
1665
sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t));
1666
dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_TMP_DSBUF, init_size);
1667
dsbufp->str[0] = '\0';
1668
dsbufp->size = init_size;
1673
erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp)
1676
erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp->str);
1677
erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp);
1797
1681
/* eq and cmp are written as separate functions a eq is a little faster */
2168
2108
aa = list_val(*aa);
2169
2109
bb = list_val(*bb);
2172
if (is_not_float(b))
2180
return float_comp(af.fd, bf.fd);
2185
* When comparing refs we need to compare ref numbers (32-bit words)
2186
* *not* ref data words.
2196
if (is_internal_ref(b)) {
2197
bnode = erts_this_node;
2198
bnum = internal_ref_numbers(b);
2199
blen = internal_ref_no_of_numbers(b);
2201
else if(is_external_ref(b)) {
2202
bnode = external_ref_node(b);
2203
bnum = external_ref_numbers(b);
2204
blen = external_ref_no_of_numbers(b);
2209
anode = erts_this_node;
2210
anum = internal_ref_numbers(a);
2211
alen = internal_ref_no_of_numbers(a);
2215
CMP_NODES(anode, bnode);
2217
ASSERT(alen > 0 && blen > 0);
2223
if (anum[alen - 1] != 0)
2226
} while (alen > blen);
2230
if (bnum[blen - 1] != 0)
2233
} while (alen < blen);
2238
ASSERT(alen == blen);
2240
for (i = (Sint) alen - 1; i >= 0; i--)
2241
if (anum[i] != bnum[i])
2242
return anum[i] < bnum[i] ? -1 : 1;
2246
case EXTERNAL_REF_DEF:
2248
if (is_internal_ref(b)) {
2249
bnode = erts_this_node;
2250
bnum = internal_ref_numbers(b);
2251
blen = internal_ref_no_of_numbers(b);
2253
else if(is_external_ref(b)) {
2254
bnode = external_ref_node(b);
2255
bnum = external_ref_numbers(b);
2256
blen = external_ref_no_of_numbers(b);
2261
anode = external_ref_node(a);
2262
anum = external_ref_numbers(a);
2263
alen = external_ref_no_of_numbers(a);
2270
return big_comp(a, b);
2272
if (is_not_binary(b))
2275
Uint a_size = binary_size(a);
2276
Uint b_size = binary_size(b);
2282
min_size = (a_size < b_size) ? a_size : b_size;
2283
GET_BINARY_BYTES(a, a_ptr);
2284
GET_BINARY_BYTES(b, b_ptr);
2285
if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) {
2288
return a_size - b_size;
2295
ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
2296
ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
2300
diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name,
2301
atom_tab(atom_val(f1->fe->module))->len,
2302
atom_tab(atom_val(f2->fe->module))->name,
2303
atom_tab(atom_val(f2->fe->module))->len);
2307
diff = f1->fe->old_index - f2->fe->old_index;
2311
diff = f1->fe->old_uniq - f2->fe->old_uniq;
2315
diff = f1->num_free - f2->num_free;
2319
num_free = f1->num_free;
2320
for (i = 0; i < num_free; i++) {
2321
if ((diff = cmp(f1->env[i], f2->env[i])) != 0) {
2334
if(is_internal_pid(b)) {
2335
bnode = erts_this_node;
2336
bdata = internal_pid_data(b);
2338
else if (is_external_pid(b)) {
2339
bnode = external_pid_node(b);
2340
bdata = external_pid_data(b);
2345
anode = erts_this_node;
2346
adata = internal_pid_data(a);
2351
return adata < bdata ? -1 : 1;
2353
CMP_NODES(anode, bnode);
2357
case EXTERNAL_PID_DEF:
2359
if(is_internal_pid(b)) {
2360
bnode = erts_this_node;
2361
bdata = internal_pid_data(b);
2363
else if (is_external_pid(b)) {
2364
bnode = external_pid_node(b);
2365
bdata = external_pid_data(b);
2370
anode = external_pid_node(a);
2371
adata = external_pid_data(a);
2377
if(is_internal_port(b)) {
2378
bnode = erts_this_node;
2379
bdata = internal_port_data(b);
2381
else if (is_external_port(b)) {
2382
bnode = external_port_node(b);
2383
bdata = external_port_data(b);
2388
anode = erts_this_node;
2389
adata = internal_port_data(a);
2394
CMP_NODES(anode, bnode);
2397
return adata < bdata ? -1 : 1;
2401
case EXTERNAL_PORT_DEF:
2403
if(is_internal_port(b)) {
2404
bnode = erts_this_node;
2405
bdata = internal_port_data(b);
2407
else if (is_external_port(b)) {
2408
bnode = external_port_node(b);
2409
bdata = external_port_data(b);
2414
anode = external_port_node(a);
2415
adata = external_port_data(a);
2421
if (is_not_vector(b))
2424
if (n < VECTOR_SIZE(b)) return(-1);
2425
if (n > VECTOR_SIZE(b)) return(1);
2426
for (i = 1; i <= n; i++) {
2427
Eterm atmp = erts_unchecked_vector_get(i, a);
2428
Eterm btmp = erts_unchecked_vector_get(i, b);
2429
if ((j = cmp(atmp, btmp)) != 0) {
2111
case TAG_PRIMARY_BOXED:
2113
Eterm ahdr = *boxed_val(a);
2114
switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) {
2115
case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE):
2116
if (is_not_tuple(b)) {
2122
/* compare the arities */
2123
i = arityval(ahdr); /* get the arity*/
2124
if (i < arityval(*bb)) return(-1);
2125
if (i > arityval(*bb)) return(1);
2133
if (is_atom(a) && is_atom(b)) {
2134
if ((j = cmp_atoms(a, b)) != 0) {
2137
} else if (is_both_small(a, b)) {
2138
if ((j = signed_val(a)-signed_val(b)) != 0) {
2141
} else if ((j = cmp(a, b)) != 0) {
2149
case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE):
2150
if (is_not_float(b)) {
2159
return float_comp(af.fd, bf.fd);
2161
case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE):
2162
case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE):
2163
if (is_not_big(b)) {
2167
return big_comp(a, b);
2168
case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE):
2169
if (is_not_export(b)) {
2173
Export* a_exp = (Export *) (export_val(a))[1];
2174
Export* b_exp = (Export *) (export_val(b))[1];
2176
if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) {
2179
if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) {
2182
return (Sint) a_exp->code[2] - (Sint) b_exp->code[2];
2185
case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE):
2186
if (is_not_fun(b)) {
2190
ErlFunThing* f1 = (ErlFunThing *) fun_val(a);
2191
ErlFunThing* f2 = (ErlFunThing *) fun_val(b);
2195
diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name,
2196
atom_tab(atom_val(f1->fe->module))->len,
2197
atom_tab(atom_val(f2->fe->module))->name,
2198
atom_tab(atom_val(f2->fe->module))->len);
2202
diff = f1->fe->old_index - f2->fe->old_index;
2206
diff = f1->fe->old_uniq - f2->fe->old_uniq;
2210
diff = f1->num_free - f2->num_free;
2214
num_free = f1->num_free;
2215
for (i = 0; i < num_free; i++) {
2216
if ((diff = cmp(f1->env[i], f2->env[i])) != 0) {
2222
case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE):
2223
if (is_internal_pid(b)) {
2224
bnode = erts_this_node;
2225
bdata = internal_pid_data(b);
2226
} else if (is_external_pid(b)) {
2227
bnode = external_pid_node(b);
2228
bdata = external_pid_data(b);
2230
a_tag = EXTERNAL_PID_DEF;
2233
anode = external_pid_node(a);
2234
adata = external_pid_data(a);
2236
case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE):
2237
if (is_internal_port(b)) {
2238
bnode = erts_this_node;
2239
bdata = internal_port_data(b);
2240
} else if (is_external_port(b)) {
2241
bnode = external_port_node(b);
2242
bdata = external_port_data(b);
2244
a_tag = EXTERNAL_PORT_DEF;
2247
anode = external_port_node(a);
2248
adata = external_port_data(a);
2250
case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE):
2252
* Note! When comparing refs we need to compare ref numbers
2253
* (32-bit words), *not* ref data words.
2256
if (is_internal_ref(b)) {
2257
bnode = erts_this_node;
2258
bnum = internal_ref_numbers(b);
2259
blen = internal_ref_no_of_numbers(b);
2260
} else if(is_external_ref(b)) {
2261
bnode = external_ref_node(b);
2262
bnum = external_ref_numbers(b);
2263
blen = external_ref_no_of_numbers(b);
2268
anode = erts_this_node;
2269
anum = internal_ref_numbers(a);
2270
alen = internal_ref_no_of_numbers(a);
2273
CMP_NODES(anode, bnode);
2275
ASSERT(alen > 0 && blen > 0);
2279
if (anum[alen - 1] != 0)
2282
} while (alen > blen);
2286
if (bnum[blen - 1] != 0)
2289
} while (alen < blen);
2293
ASSERT(alen == blen);
2294
for (i = (Sint) alen - 1; i >= 0; i--)
2295
if (anum[i] != bnum[i])
2296
return anum[i] < bnum[i] ? -1 : 1;
2298
case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE):
2299
if (is_internal_ref(b)) {
2300
bnode = erts_this_node;
2301
bnum = internal_ref_numbers(b);
2302
blen = internal_ref_no_of_numbers(b);
2303
} else if (is_external_ref(b)) {
2304
bnode = external_ref_node(b);
2305
bnum = external_ref_numbers(b);
2306
blen = external_ref_no_of_numbers(b);
2308
a_tag = EXTERNAL_REF_DEF;
2311
anode = external_ref_node(a);
2312
anum = external_ref_numbers(a);
2313
alen = external_ref_no_of_numbers(a);
2316
/* Must be a binary */
2317
ASSERT(is_binary(a));
2318
if (is_not_binary(b)) {
2322
Uint a_size = binary_size(a);
2323
Uint b_size = binary_size(b);
2332
ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize);
2333
ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize);
2334
if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) {
2335
min_size = (a_size < b_size) ? a_size : b_size;
2336
if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) {
2339
return a_size - b_size;
2343
a_size = (a_size << 3) + a_bitsize;
2344
b_size = (b_size << 3) + b_bitsize;
2345
min_size = (a_size < b_size) ? a_size : b_size;
2346
if ((cmp = erts_cmp_bits(a_ptr,a_bitoffs,
2347
b_ptr,b_bitoffs,min_size)) != 0) {
2351
return a_size - b_size;
2360
* Take care of the case that the tags are different.
2436
2364
b_tag = tag_val_def(b);
2439
* Take care of the case that the tags are different.
2443
2367
FloatDef f1, f2;
2561
2469
return store_external_or_ref_(&hp, &MSO(proc).externals, ns);
2571
display1(Eterm obj, CIO fd)
2577
if (dcount-- <= 0) return(1);
2580
erl_printf(fd, "<cp/header:%08lX>", (unsigned long) obj);
2584
switch (tag_val_def(obj)) {
2586
erl_printf(fd, "[]");
2589
print_atom((int)atom_val(obj),fd);
2592
erl_printf(fd, "%d", signed_val(obj));
2595
nobj = big_val(obj);
2597
if (BIG_SIGN(nobj)) {
2598
erl_printf(fd, "-16#", i);
2600
erl_printf(fd, "16#", i);
2602
for (k = i-1; k >= 0; k--) {
2603
erl_printf(fd, "%0X", BIG_DIGIT(nobj, k));
2607
erl_printf(fd, "#Ref<%lu", internal_ref_channel_no(obj));
2608
ref_num = internal_ref_numbers(obj);
2609
for (i = internal_ref_no_of_numbers(obj)-1; i >= 0; i--)
2610
erl_printf(fd, ".%lu", (unsigned long) ref_num[i]);
2611
erl_printf(fd, ">");
2613
case EXTERNAL_REF_DEF:
2614
erl_printf(fd, "#Ref<%lu", external_ref_channel_no(obj));
2615
ref_num = external_ref_numbers(obj);
2616
for (i = external_ref_no_of_numbers(obj)-1; i >= 0; i--)
2617
erl_printf(fd, ".%lu", (unsigned long) ref_num[i]);
2618
erl_printf(fd, ">");
2621
case EXTERNAL_PID_DEF:
2622
erl_printf(fd, "<%lu.%lu.%lu>",
2623
(unsigned long) pid_channel_no(obj),
2624
(unsigned long) pid_number(obj),
2625
(unsigned long) pid_serial(obj));
2628
case EXTERNAL_PORT_DEF:
2629
erl_printf(fd, "#Port<%lu.%lu>",
2630
(unsigned long) port_channel_no(obj),
2631
(unsigned long) port_number(obj));
2634
if (is_printable_string(obj)) {
2637
nobj = list_val(obj);
2639
if (dcount-- <= 0) return(1);
2640
c = signed_val(*nobj++);
2649
if (is_not_list(*nobj)) break;
2650
nobj = list_val(*nobj);
2655
nobj = list_val(obj);
2657
if (display1(*nobj++, fd) != 0) return(1);
2658
if (is_not_list(*nobj)) break;
2660
nobj = list_val(*nobj);
2662
if (is_not_nil(*nobj)) {
2664
if (display1(*nobj, fd) != 0) return(1);
2670
nobj = tuple_val(obj); /* pointer to arity */
2671
i = arityval(*nobj); /* arity */
2674
if (display1(*++nobj,fd) != 0) return(1);
2675
if (i >= 1) erl_putc(',',fd);
2681
GET_DOUBLE(obj, ff);
2683
erl_printf(fd, "%e", ff.fd);
2685
erl_printf(fd, "%e", ff.fd);
2691
ProcBin* pb = (ProcBin *) binary_val(obj);
2692
erl_printf(fd, pb->size == 1 ? "<<%lu byte>>" : "<<%lu bytes>>",
2693
(unsigned long) pb->size);
2698
ErlFunThing* funp = (ErlFunThing *) fun_val(obj);
2701
erl_printf(fd, "#Fun<");
2702
ap = atom_tab(atom_val(funp->fe->module));
2703
for (i = 0; i < ap->len; i++) {
2704
erl_putc(ap->name[i], fd);
2706
erl_printf(fd, ".%d.%d>", funp->fe->old_index,
2707
funp->fe->old_uniq);
2711
erl_printf(fd, "#Vector<%ld>", (long) signed_val(vector_val(obj)[1]));
2714
erl_printf(fd, "<unknown:%lx>", (unsigned long) obj);
2721
* Display a term on file fd.
2722
* Only used by debugging rountines as Erlang formatting is
2723
* done in the io module.
2727
display(Eterm obj, CIO fd)
2734
/* as above, but limit the number of items printed */
2735
void ldisplay(Eterm obj, CIO fd, int count)
2739
if (dcount <= 0) erl_printf(fd, "... "); /* Show that more items exist */
2743
/* print a name doing what quoting is necessary */
2744
static void print_name(byte *s, int n, CIO fd)
2753
erl_printf(fd, "''");
2767
if (!IS_ALNUM(c) && (c != '_')) {
2780
case '\'': erl_printf(fd, "\\'"); break;
2781
case '\\': erl_printf(fd, "\\\\"); break;
2782
case '\n': erl_printf(fd, "\\n"); break;
2783
case '\f': erl_printf(fd, "\\f"); break;
2784
case '\t': erl_printf(fd, "\\t"); break;
2785
case '\r': erl_printf(fd, "\\r"); break;
2786
case '\b': erl_printf(fd, "\\b"); break;
2787
case '\v': erl_printf(fd, "\\v"); break;
2790
erl_printf(fd, "\\%03o", c);
2800
/* print the text of an atom with number i on open file descriptor fd */
2802
print_atom(int i, CIO fd)
2804
if ((i < 0) || (i >= atom_table_size) || (atom_tab(i) == NULL)) {
2805
erl_printf(fd, "<bad atom index: %d>", i);
2807
print_name(atom_tab(i)->name, atom_tab(i)->len, fd);
2808
dcount -= atom_tab(i)->len;
2813
2474
* returns 0 if X is a member of list Y
2946
2603
** | [ iohead | iotail]
2949
** Return remaing bytes in buffer on succsess
2606
** Return remaning bytes in buffer on success
2950
2607
** -1 on overflow
2608
** -2 on type error (including that result would not be a whole number of bytes)
2954
2611
int io_list_to_buf(Eterm obj, char* buf, int len)
2960
while (!ESTACK_ISEMPTY(s)) {
2961
obj = ESTACK_POP(s);
2965
objp = list_val(obj);
2970
*buf++ = unsigned_val(obj);
2972
} else if (is_binary(obj)) {
2974
size_t size = binary_size(obj);
2978
GET_BINARY_BYTES(obj, bytes);
2979
sys_memcpy(buf, bytes, size);
2983
else if (is_nil(obj)) {
2986
else if (is_list(obj)) {
2987
ESTACK_PUSH(s, CDR(objp));
2988
goto L_iter_list; /* on head */
2995
goto L_iter_list; /* on tail */
2996
else if (is_binary(obj)) {
2998
size_t size = binary_size(obj);
3002
GET_BINARY_BYTES(obj, bytes);
3003
sys_memcpy(buf, bytes, size);
2618
while (!ESTACK_ISEMPTY(s)) {
2619
obj = ESTACK_POP(s);
2623
objp = list_val(obj);
2629
*buf++ = unsigned_val(obj);
2631
*buf = (char)((unsigned_val(obj) >> offset) & *buf);
2633
*buf = (unsigned_val(obj) << (8-offset));
2636
} else if (is_binary(obj)) {
2638
size_t size = binary_size(obj);
2646
ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
2647
num_bits = 8*size+bitsize;
2648
copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
2650
buf += size+(offset>7);
2651
len -= size+(offset>7);
2652
offset = offset & 7;
2654
else if (is_nil(obj)) {
2657
else if (is_list(obj)) {
2658
ESTACK_PUSH(s, CDR(objp));
2659
goto L_iter_list; /* on head */
2666
goto L_iter_list; /* on tail */
2667
else if (is_binary(obj)) {
2669
size_t size = binary_size(obj);
2676
ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
2677
num_bits = 8*size+bitsize;
2678
copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
2680
buf += size+(offset>7);
2681
len -= size+(offset>7);
2682
offset = offset & 7;
2683
} else if (is_nil(obj)) {
2688
} else if (is_binary(obj)) {
2690
size_t size = binary_size(obj);
2697
ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
2698
num_bits = 8*size+bitsize;
2699
copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
2701
buf += size+(offset>7);
2702
len -= size+(offset>7);
2703
offset = offset & 7;
2704
} else if (is_not_nil(obj)) {
2724
int io_list_to_buf2(Eterm obj, char* buf, int len)
2731
while (!ESTACK_ISEMPTY(s)) {
2732
obj = ESTACK_POP(s);
2736
objp = list_val(obj);
2742
*buf++ = unsigned_val(obj);
2744
*buf = (char)((unsigned_val(obj) >> offset) |
2745
((*buf >> (8-offset)) << (8-offset)));
2747
*buf = (unsigned_val(obj) << (8-offset));
2750
} else if (is_binary(obj)) {
2752
size_t size = binary_size(obj);
2760
ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
2761
num_bits = 8*size+bitsize;
2762
copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
2764
buf += size+(offset>7);
2765
len -= size+(offset>7);
2766
offset = offset & 7;
2768
else if (is_nil(obj)) {
2771
else if (is_list(obj)) {
2772
ESTACK_PUSH(s, CDR(objp));
2773
goto L_iter_list; /* on head */
2780
goto L_iter_list; /* on tail */
2781
else if (is_binary(obj)) {
2783
size_t size = binary_size(obj);
2790
ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
2791
num_bits = 8*size+bitsize;
2792
copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
2794
buf += size+(offset>7);
2795
len -= size+(offset>7);
2796
offset = offset & 7;
3007
2799
else if (is_nil(obj))
3010
2802
goto L_type_error;
3011
2803
} else if (is_binary(obj)) {
3013
2805
size_t size = binary_size(obj);
3014
2809
if (len < size) {
3015
2810
goto L_overflow;
3017
GET_BINARY_BYTES(obj, bytes);
3018
sys_memcpy(buf, bytes, size);
2812
ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize);
2813
num_bits = 8*size+bitsize;
2814
copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits);
2816
buf += size+(offset>7);
2817
len -= size+(offset>7);
2818
offset = offset & 7;
3021
2819
} else if (is_not_nil(obj)) {
3022
2820
goto L_type_error;
3026
2824
DESTROY_ESTACK(s);
3030
2828
DESTROY_ESTACK(s);
3144
/* return 0 if item is not a non-empty flat list of printable characters */
3147
is_printable_string(Eterm list)
3152
while(is_list(list)) {
3153
Eterm* consp = list_val(list);
3154
Eterm hd = CAR(consp);
3159
/* IS_PRINT || IS_SPACE would be another way to put it */
3160
if (IS_CNTRL(c) && !IS_SPACE(c))
3170
Uint erts_sys_misc_mem_sz;
2950
* Process and Port timers in smp case
2953
ERTS_SMP_PALLOC_IMPL(ptimer_pre, ErtsSmpPTimer, 1000)
2955
#define ERTS_PTMR_FLGS_ALLCD_SIZE \
2957
#define ERTS_PTMR_FLGS_ALLCD_MASK \
2958
((((Uint32) 1) << ERTS_PTMR_FLGS_ALLCD_SIZE) - 1)
2960
#define ERTS_PTMR_FLGS_PREALLCD ((Uint32) 1)
2961
#define ERTS_PTMR_FLGS_SLALLCD ((Uint32) 2)
2962
#define ERTS_PTMR_FLGS_LLALLCD ((Uint32) 3)
2963
#define ERTS_PTMR_FLG_CANCELLED (((Uint32) 1) << (ERTS_PTMR_FLGS_ALLCD_SIZE+0))
2968
init_ptimer_pre_alloc();
2971
static ERTS_INLINE void
2972
free_ptimer(ErtsSmpPTimer *ptimer)
2974
switch (ptimer->timer.flags & ERTS_PTMR_FLGS_ALLCD_MASK) {
2975
case ERTS_PTMR_FLGS_PREALLCD:
2976
(void) ptimer_pre_free(ptimer);
2978
case ERTS_PTMR_FLGS_SLALLCD:
2979
erts_free(ERTS_ALC_T_SL_PTIMER, (void *) ptimer);
2981
case ERTS_PTMR_FLGS_LLALLCD:
2982
erts_free(ERTS_ALC_T_LL_PTIMER, (void *) ptimer);
2985
erl_exit(ERTS_ABORT_EXIT,
2986
"Internal error: Bad ptimer alloc type\n");
2991
/* Callback for process timeout cancelled */
2993
ptimer_cancelled(ErtsSmpPTimer *ptimer)
2995
free_ptimer(ptimer);
2998
/* Callback for process timeout */
3000
ptimer_timeout(ErtsSmpPTimer *ptimer)
3002
if (!(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) {
3003
if (is_internal_pid(ptimer->timer.id)) {
3005
p = erts_pid2proc(NULL,
3008
ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
3010
if (!(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) {
3011
ASSERT(*ptimer->timer.timer_ref == ptimer);
3012
*ptimer->timer.timer_ref = NULL;
3013
(*ptimer->timer.timeout_func)(p);
3015
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
3020
ASSERT(is_internal_port(ptimer->timer.id));
3021
p = erts_id2port(ptimer->timer.id, NULL, 0);
3023
if (!(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) {
3024
ASSERT(*ptimer->timer.timer_ref == ptimer);
3025
*ptimer->timer.timer_ref = NULL;
3026
(*ptimer->timer.timeout_func)(p);
3028
erts_smp_io_unlock();
3032
free_ptimer(ptimer);
3036
erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref,
3038
ErlTimeoutProc timeout_func,
3041
ErtsSmpPTimer *res = ptimer_pre_alloc();
3043
res->timer.flags = ERTS_PTMR_FLGS_PREALLCD;
3045
if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) {
3046
res = erts_alloc(ERTS_ALC_T_SL_PTIMER, sizeof(ErtsSmpPTimer));
3047
res->timer.flags = ERTS_PTMR_FLGS_SLALLCD;
3050
res = erts_alloc(ERTS_ALC_T_LL_PTIMER, sizeof(ErtsSmpPTimer));
3051
res->timer.flags = ERTS_PTMR_FLGS_LLALLCD;
3054
res->timer.timeout_func = timeout_func;
3055
res->timer.timer_ref = timer_ref;
3057
res->timer.tm.active = 0; /* MUST be initalized */
3059
ASSERT(!*timer_ref);
3063
erl_set_timer(&res->timer.tm,
3064
(ErlTimeoutProc) ptimer_timeout,
3065
(ErlCancelProc) ptimer_cancelled,
3071
erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer)
3074
ASSERT(*ptimer->timer.timer_ref == ptimer);
3075
*ptimer->timer.timer_ref = NULL;
3076
ptimer->timer.flags |= ERTS_PTMR_FLG_CANCELLED;
3077
erl_cancel_timer(&ptimer->timer.tm);
3172
3083
static Sint trim_threshold;
3173
3084
static Sint top_pad;
3171
/* Local system block state */
3174
int threads_to_block;
3176
erts_smp_tid_t blocker_tid;
3177
int recursive_block;
3178
Uint32 allowed_activities;
3179
erts_smp_tsd_key_t blockable_key;
3182
#ifdef ERTS_ENABLE_LOCK_CHECK
3183
int activity_changing;
3186
} system_block_state;
3188
/* Global system block state */
3189
erts_system_block_state_t erts_system_block_state;
3192
static ERTS_INLINE int
3193
is_blockable_thread(void)
3195
return erts_smp_tsd_get(system_block_state.blockable_key) != NULL;
3198
static ERTS_INLINE int
3201
return (system_block_state.have_blocker
3202
&& erts_smp_equal_tids(system_block_state.blocker_tid,
3203
erts_smp_thr_self()));
3206
static ERTS_INLINE void
3207
block_me(void (*prepare)(void *),
3208
void (*resume)(void *),
3212
int update_act_changing)
3218
/* Locks might be held... */
3221
erts_smp_mtx_lock(&system_block_state.mtx);
3223
if (erts_smp_pending_system_block() && !is_blocker()) {
3224
int is_blockable = is_blockable_thread();
3225
ASSERT(is_blockable);
3228
system_block_state.threads_to_block--;
3229
#ifdef ERTS_ENABLE_LOCK_CHECK
3230
if (update_act_changing)
3231
system_block_state.activity_changing--;
3233
erts_smp_cnd_broadcast(&system_block_state.cnd);
3236
erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
3237
} while (erts_smp_pending_system_block()
3238
&& !(want_to_block && !system_block_state.have_blocker));
3239
#ifdef ERTS_ENABLE_LOCK_CHECK
3240
if (update_act_changing)
3241
system_block_state.activity_changing++;
3244
system_block_state.threads_to_block++;
3248
erts_smp_mtx_unlock(&system_block_state.mtx);
3255
erts_block_me(void (*prepare)(void *),
3256
void (*resume)(void *),
3262
#ifdef ERTS_ENABLE_LOCK_CHECK
3263
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
3266
block_me(NULL, NULL, NULL, 0, 0, 0);
3273
erts_register_blockable_thread(void)
3275
if (!is_blockable_thread()) {
3276
erts_smp_mtx_lock(&system_block_state.mtx);
3277
system_block_state.threads_to_block++;
3278
erts_smp_tsd_set(system_block_state.blockable_key,
3279
(void *) &erts_system_block_state);
3281
/* Someone might be waiting for us to block... */
3282
if (erts_smp_pending_system_block())
3283
block_me(NULL, NULL, NULL, 1, 0, 0);
3284
erts_smp_mtx_unlock(&system_block_state.mtx);
3289
erts_unregister_blockable_thread(void)
3291
if (is_blockable_thread()) {
3292
erts_smp_mtx_lock(&system_block_state.mtx);
3293
system_block_state.threads_to_block--;
3294
ASSERT(system_block_state.threads_to_block >= 0);
3295
erts_smp_tsd_set(system_block_state.blockable_key, NULL);
3297
/* Someone might be waiting for us to block... */
3298
if (erts_smp_pending_system_block())
3299
erts_smp_cnd_broadcast(&system_block_state.cnd);
3300
erts_smp_mtx_unlock(&system_block_state.mtx);
3305
erts_note_activity_begin(erts_activity_t activity)
3307
erts_smp_mtx_lock(&system_block_state.mtx);
3308
if (erts_smp_pending_system_block()) {
3309
Uint32 broadcast = 0;
3311
case ERTS_ACTIVITY_GC:
3312
broadcast = (system_block_state.allowed_activities
3313
& ERTS_BS_FLG_ALLOW_GC);
3315
case ERTS_ACTIVITY_IO:
3316
broadcast = (system_block_state.allowed_activities
3317
& ERTS_BS_FLG_ALLOW_IO);
3319
case ERTS_ACTIVITY_WAIT:
3327
erts_smp_cnd_broadcast(&system_block_state.cnd);
3329
erts_smp_mtx_unlock(&system_block_state.mtx);
3333
erts_check_block(erts_activity_t old_activity,
3334
erts_activity_t new_activity,
3336
void (*prepare)(void *),
3337
void (*resume)(void *),
3342
if (!locked && prepare)
3345
erts_smp_mtx_lock(&system_block_state.mtx);
3347
/* First check if it is ok to block... */
3351
switch (old_activity) {
3352
case ERTS_ACTIVITY_UNDEFINED:
3355
case ERTS_ACTIVITY_GC:
3356
do_block = (system_block_state.allowed_activities
3357
& ERTS_BS_FLG_ALLOW_GC);
3359
case ERTS_ACTIVITY_IO:
3360
do_block = (system_block_state.allowed_activities
3361
& ERTS_BS_FLG_ALLOW_IO);
3363
case ERTS_ACTIVITY_WAIT:
3364
/* You are not allowed to leave activity waiting
3365
* without supplying the possibility to block
3368
erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED,
3369
__FILE__, __LINE__);
3373
erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY,
3374
__FILE__, __LINE__);
3381
/* ... then check if it is necessary to block... */
3383
switch (new_activity) {
3384
case ERTS_ACTIVITY_UNDEFINED:
3387
case ERTS_ACTIVITY_GC:
3388
do_block = !(system_block_state.allowed_activities
3389
& ERTS_BS_FLG_ALLOW_GC);
3391
case ERTS_ACTIVITY_IO:
3392
do_block = !(system_block_state.allowed_activities
3393
& ERTS_BS_FLG_ALLOW_IO);
3395
case ERTS_ACTIVITY_WAIT:
3396
/* No need to block if we are going to wait */
3400
erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY,
3401
__FILE__, __LINE__);
3408
#ifdef ERTS_ENABLE_LOCK_CHECK
3410
/* Only system_block_state.mtx should be held */
3411
erts_lc_check_exact(&system_block_state.mtx.lc, 1);
3415
block_me(NULL, NULL, NULL, 1, 0, 1);
3419
erts_smp_mtx_unlock(&system_block_state.mtx);
3421
if (!locked && resume)
3428
erts_set_activity_error(erts_activity_error_t error, char *file, int line)
3431
case ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED:
3432
erl_exit(1, "%s:%d: Fatal error: Leaving activity waiting without "
3433
"supplying the possibility to block unlocked.",
3436
case ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY:
3437
erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.",
3440
case ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY:
3441
erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.",
3445
erl_exit(1, "%s:%d: Internal error in erts_smp_set_activity()",
3453
static ERTS_INLINE int
3454
threads_not_under_control(void)
3456
int res = system_block_state.threads_to_block;
3458
/* Waiting is allways an allowed activity... */
3459
res -= erts_smp_atomic_read(&erts_system_block_state.in_activity.wait);
3461
if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_GC)
3462
res -= erts_smp_atomic_read(&erts_system_block_state.in_activity.gc);
3464
if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_IO)
3465
res -= erts_smp_atomic_read(&erts_system_block_state.in_activity.io);
3475
* erts_block_system() blocks all threads registered as blockable.
3476
* It doesn't return until either all threads have blocked (0 is returned)
3477
* or it has timed out (ETIMEDOUT) is returned.
3479
* If allowed activities == 0, blocked threads will release all locks
3482
* If allowed_activities is != 0, erts_block_system() will allow blockable
3483
* threads to continue executing as long as they are doing an allowed
3484
* activity. When they are done with the allowed activity they will block,
3485
* *but* they will block holding locks. Therefore, the thread calling
3486
* erts_block_system() must *not* try to aquire any locks that might be
3487
* held by blocked threads holding locks from allowed activities.
3489
* Currently allowed_activities are:
3490
* * ERTS_BS_FLG_ALLOW_GC Thread continues with garbage
3491
* collection and blocks with
3492
* main process lock on current
3494
* * ERTS_BS_FLG_ALLOW_IO Thread continues with I/O
3498
erts_block_system(Uint32 allowed_activities)
3501
#ifdef ERTS_ENABLE_LOCK_CHECK
3502
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
3505
erts_smp_mtx_lock(&system_block_state.mtx);
3507
do_block = erts_smp_pending_system_block();
3509
&& system_block_state.have_blocker
3510
&& erts_smp_equal_tids(system_block_state.blocker_tid,
3511
erts_smp_thr_self())) {
3512
ASSERT(system_block_state.recursive_block >= 0);
3513
system_block_state.recursive_block++;
3515
/* You are not allowed to restrict allowed activites
3516
in a recursive block! */
3517
ERTS_SMP_LC_ASSERT((system_block_state.allowed_activities
3518
& ~allowed_activities) == 0);
3522
erts_smp_atomic_inc(&erts_system_block_state.do_block);
3524
/* Someone else might be waiting for us to block... */
3527
block_me(NULL, NULL, NULL, 1, 1, 0);
3530
ASSERT(!system_block_state.have_blocker);
3531
system_block_state.have_blocker = 1;
3532
system_block_state.blocker_tid = erts_smp_thr_self();
3533
system_block_state.allowed_activities = allowed_activities;
3535
if (is_blockable_thread())
3536
system_block_state.threads_to_block--;
3538
while (threads_not_under_control() && !system_block_state.emergency)
3539
erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
3541
if (system_block_state.emergency) {
3542
system_block_state.have_blocker = 0;
3547
erts_smp_mtx_unlock(&system_block_state.mtx);
3551
* erts_emergency_block_system() should only be called when we are
3552
* about to write a crash dump...
3556
erts_emergency_block_system(long timeout, Uint32 allowed_activities)
3559
long another_blocker;
3561
erts_smp_mtx_lock(&system_block_state.mtx);
3563
if (system_block_state.emergency) {
3569
another_blocker = erts_smp_pending_system_block();
3570
system_block_state.emergency = 1;
3571
erts_smp_atomic_inc(&erts_system_block_state.do_block);
3573
if (another_blocker) {
3575
erts_smp_atomic_dec(&erts_system_block_state.do_block);
3579
/* kick the other blocker */
3580
erts_smp_cnd_broadcast(&system_block_state.cnd);
3581
while (system_block_state.have_blocker)
3582
erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
3585
ASSERT(!system_block_state.have_blocker);
3586
system_block_state.have_blocker = 1;
3587
system_block_state.blocker_tid = erts_smp_thr_self();
3588
system_block_state.allowed_activities = allowed_activities;
3590
if (is_blockable_thread())
3591
system_block_state.threads_to_block--;
3594
while (threads_not_under_control())
3595
erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
3598
erts_thr_timeval_t to;
3599
erts_thr_time_now(&to);
3601
to.tv_sec += timeout / 1000;
3602
to.tv_nsec += timeout % 1000;
3603
if (to.tv_nsec >= 1000000000) {
3605
to.tv_nsec -= 1000000000;
3608
while (res != ETIMEDOUT && threads_not_under_control()) {
3609
res = erts_smp_cnd_timedwait(&system_block_state.cnd,
3610
&system_block_state.mtx,
3615
erts_smp_mtx_unlock(&system_block_state.mtx);
3620
erts_release_system(void)
3624
#ifdef ERTS_ENABLE_LOCK_CHECK
3625
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
3628
erts_smp_mtx_lock(&system_block_state.mtx);
3629
ASSERT(is_blocker());
3631
ASSERT(system_block_state.recursive_block >= 0);
3633
if (system_block_state.recursive_block)
3634
system_block_state.recursive_block--;
3636
do_block = erts_smp_atomic_dectest(&erts_system_block_state.do_block);
3637
system_block_state.have_blocker = 0;
3638
if (is_blockable_thread())
3639
system_block_state.threads_to_block++;
3643
/* Someone else might be waiting for us to block... */
3645
block_me(NULL, NULL, NULL, 1, 0, 0);
3647
erts_smp_cnd_broadcast(&system_block_state.cnd);
3650
erts_smp_mtx_unlock(&system_block_state.mtx);
3654
#ifdef ERTS_ENABLE_LOCK_CHECK
3657
erts_lc_activity_change_begin(void)
3659
erts_smp_mtx_lock(&system_block_state.mtx);
3660
system_block_state.activity_changing++;
3661
erts_smp_mtx_unlock(&system_block_state.mtx);
3665
erts_lc_activity_change_end(void)
3667
erts_smp_mtx_lock(&system_block_state.mtx);
3668
system_block_state.activity_changing--;
3669
if (system_block_state.checking && !system_block_state.activity_changing)
3670
erts_smp_cnd_broadcast(&system_block_state.cnd);
3671
erts_smp_mtx_unlock(&system_block_state.mtx);
3677
erts_is_system_blocked(erts_activity_t allowed_activities)
3681
erts_smp_mtx_lock(&system_block_state.mtx);
3682
blkd = (erts_smp_pending_system_block()
3683
&& system_block_state.have_blocker
3684
&& erts_smp_equal_tids(system_block_state.blocker_tid,
3685
erts_smp_thr_self())
3686
&& !(system_block_state.allowed_activities & ~allowed_activities));
3687
#ifdef ERTS_ENABLE_LOCK_CHECK
3689
system_block_state.checking = 1;
3690
while (system_block_state.activity_changing)
3691
erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx);
3692
system_block_state.checking = 0;
3693
blkd = !threads_not_under_control();
3696
erts_smp_mtx_unlock(&system_block_state.mtx);
3701
erts_system_block_init(void)
3703
/* Local state... */
3704
system_block_state.emergency = 0;
3705
system_block_state.threads_to_block = 0;
3706
system_block_state.have_blocker = 0;
3707
/* system_block_state.block_tid */
3708
system_block_state.recursive_block = 0;
3709
system_block_state.allowed_activities = 0;
3710
erts_smp_tsd_key_create(&system_block_state.blockable_key);
3711
erts_smp_mtx_init(&system_block_state.mtx, "system_block");
3712
erts_smp_cnd_init(&system_block_state.cnd);
3713
#ifdef ERTS_ENABLE_LOCK_CHECK
3714
system_block_state.activity_changing = 0;
3715
system_block_state.checking = 0;
3718
/* Global state... */
3720
erts_smp_atomic_init(&erts_system_block_state.do_block, 0L);
3721
erts_smp_atomic_init(&erts_system_block_state.in_activity.wait, 0L);
3722
erts_smp_atomic_init(&erts_system_block_state.in_activity.gc, 0L);
3723
erts_smp_atomic_init(&erts_system_block_state.in_activity.io, 0L);
3725
/* Make sure blockable threads unregister when exiting... */
3726
erts_smp_install_exit_handler(erts_unregister_blockable_thread);
3730
#endif /* #ifdef ERTS_SMP */
3259
3734
* Handy functions when using a debugger - don't use in the code!
added
removed
erts/emulator/beam/utils.c
