518 |
|
|
519 |
/* Like malloc but check for no memory and block interrupt input.. */ |
/* Like malloc but check for no memory and block interrupt input.. */ |
520 |
|
|
521 |
|
#ifdef XMALLOC_OVERRUN_CHECK |
522 |
|
|
523 |
|
#define XMALLOC_OVERRUN_CHECK_SIZE 16 |
524 |
|
static char xmalloc_overrun_check_header[XMALLOC_OVERRUN_CHECK_SIZE-4] = |
525 |
|
{ 0x9a, 0x9b, 0xae, 0xaf, |
526 |
|
0xbf, 0xbe, 0xce, 0xcf, |
527 |
|
0xea, 0xeb, 0xec, 0xed }; |
528 |
|
|
529 |
|
static char xmalloc_overrun_check_trailer[XMALLOC_OVERRUN_CHECK_SIZE] = |
530 |
|
{ 0xaa, 0xab, 0xac, 0xad, |
531 |
|
0xba, 0xbb, 0xbc, 0xbd, |
532 |
|
0xca, 0xcb, 0xcc, 0xcd, |
533 |
|
0xda, 0xdb, 0xdc, 0xdd }; |
534 |
|
|
535 |
|
POINTER_TYPE * |
536 |
|
overrun_check_malloc (size) |
537 |
|
size_t size; |
538 |
|
{ |
539 |
|
register char *val; |
540 |
|
|
541 |
|
val = (char *) malloc (size + XMALLOC_OVERRUN_CHECK_SIZE*2); |
542 |
|
if (val) |
543 |
|
{ |
544 |
|
bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4); |
545 |
|
bcopy (&size, val + XMALLOC_OVERRUN_CHECK_SIZE - 4, sizeof (size)); |
546 |
|
val += XMALLOC_OVERRUN_CHECK_SIZE; |
547 |
|
bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE); |
548 |
|
} |
549 |
|
return (POINTER_TYPE *)val; |
550 |
|
} |
551 |
|
|
552 |
|
POINTER_TYPE * |
553 |
|
overrun_check_realloc (block, size) |
554 |
|
POINTER_TYPE *block; |
555 |
|
size_t size; |
556 |
|
{ |
557 |
|
register char *val = (char *)block; |
558 |
|
|
559 |
|
if (val |
560 |
|
&& bcmp (xmalloc_overrun_check_header, |
561 |
|
val - XMALLOC_OVERRUN_CHECK_SIZE, |
562 |
|
XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0) |
563 |
|
{ |
564 |
|
size_t osize; |
565 |
|
bcopy (val - 4, &osize, sizeof (osize)); |
566 |
|
if (bcmp (xmalloc_overrun_check_trailer, |
567 |
|
val + osize, |
568 |
|
XMALLOC_OVERRUN_CHECK_SIZE)) |
569 |
|
abort (); |
570 |
|
val -= XMALLOC_OVERRUN_CHECK_SIZE; |
571 |
|
} |
572 |
|
|
573 |
|
val = (char *) realloc ((POINTER_TYPE *)val, size + XMALLOC_OVERRUN_CHECK_SIZE*2); |
574 |
|
|
575 |
|
if (val) |
576 |
|
{ |
577 |
|
bcopy (xmalloc_overrun_check_header, val, XMALLOC_OVERRUN_CHECK_SIZE - 4); |
578 |
|
bcopy (&size, val + XMALLOC_OVERRUN_CHECK_SIZE - 4, sizeof (size)); |
579 |
|
val += XMALLOC_OVERRUN_CHECK_SIZE; |
580 |
|
bcopy (xmalloc_overrun_check_trailer, val + size, XMALLOC_OVERRUN_CHECK_SIZE); |
581 |
|
} |
582 |
|
return (POINTER_TYPE *)val; |
583 |
|
} |
584 |
|
|
585 |
|
void |
586 |
|
overrun_check_free (block) |
587 |
|
POINTER_TYPE *block; |
588 |
|
{ |
589 |
|
char *val = (char *)block; |
590 |
|
|
591 |
|
if (val |
592 |
|
&& bcmp (xmalloc_overrun_check_header, |
593 |
|
val - XMALLOC_OVERRUN_CHECK_SIZE, |
594 |
|
XMALLOC_OVERRUN_CHECK_SIZE - 4) == 0) |
595 |
|
{ |
596 |
|
size_t osize; |
597 |
|
bcopy (val - 4, &osize, sizeof (osize)); |
598 |
|
if (bcmp (xmalloc_overrun_check_trailer, |
599 |
|
val + osize, |
600 |
|
XMALLOC_OVERRUN_CHECK_SIZE)) |
601 |
|
abort (); |
602 |
|
val -= XMALLOC_OVERRUN_CHECK_SIZE; |
603 |
|
} |
604 |
|
|
605 |
|
free (val); |
606 |
|
} |
607 |
|
|
608 |
|
#undef malloc |
609 |
|
#undef realloc |
610 |
|
#undef free |
611 |
|
#define malloc overrun_check_malloc |
612 |
|
#define realloc overrun_check_realloc |
613 |
|
#define free overrun_check_free |
614 |
|
#endif |
615 |
|
|
616 |
POINTER_TYPE * |
POINTER_TYPE * |
617 |
xmalloc (size) |
xmalloc (size) |
618 |
size_t size; |
size_t size; |
697 |
number of bytes to allocate, TYPE describes the intended use of the |
number of bytes to allocate, TYPE describes the intended use of the |
698 |
allcated memory block (for strings, for conses, ...). */ |
allcated memory block (for strings, for conses, ...). */ |
699 |
|
|
700 |
|
#ifndef USE_LSB_TAG |
701 |
static void *lisp_malloc_loser; |
static void *lisp_malloc_loser; |
702 |
|
#endif |
703 |
|
|
704 |
static POINTER_TYPE * |
static POINTER_TYPE * |
705 |
lisp_malloc (nbytes, type) |
lisp_malloc (nbytes, type) |
1525 |
|
|
1526 |
#endif /* not GC_CHECK_STRING_BYTES */ |
#endif /* not GC_CHECK_STRING_BYTES */ |
1527 |
|
|
1528 |
|
|
1529 |
|
#ifdef GC_CHECK_STRING_OVERRUN |
1530 |
|
#define GC_STRING_EXTRA 4 |
1531 |
|
static char string_overrun_pattern[GC_STRING_EXTRA] = { 0xde, 0xad, 0xbe, 0xef }; |
1532 |
|
#else |
1533 |
|
#define GC_STRING_EXTRA 0 |
1534 |
|
#endif |
1535 |
|
|
1536 |
/* Value is the size of an sdata structure large enough to hold NBYTES |
/* Value is the size of an sdata structure large enough to hold NBYTES |
1537 |
bytes of string data. The value returned includes a terminating |
bytes of string data. The value returned includes a terminating |
1538 |
NUL byte, the size of the sdata structure, and padding. */ |
NUL byte, the size of the sdata structure, and padding. */ |
1620 |
nbytes = SDATA_NBYTES (from); |
nbytes = SDATA_NBYTES (from); |
1621 |
|
|
1622 |
nbytes = SDATA_SIZE (nbytes); |
nbytes = SDATA_SIZE (nbytes); |
1623 |
from_end = (struct sdata *) ((char *) from + nbytes); |
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); |
1624 |
} |
} |
1625 |
} |
} |
1626 |
|
|
1653 |
|
|
1654 |
#endif /* GC_CHECK_STRING_BYTES */ |
#endif /* GC_CHECK_STRING_BYTES */ |
1655 |
|
|
1656 |
|
#ifdef GC_CHECK_STRING_FREE_LIST |
1657 |
|
|
1658 |
|
static void |
1659 |
|
check_string_free_list () |
1660 |
|
{ |
1661 |
|
struct Lisp_String *s; |
1662 |
|
|
1663 |
|
/* Pop a Lisp_String off the free-list. */ |
1664 |
|
s = string_free_list; |
1665 |
|
while (s != NULL) |
1666 |
|
{ |
1667 |
|
if ((unsigned)s < 1024) |
1668 |
|
abort(); |
1669 |
|
s = NEXT_FREE_LISP_STRING (s); |
1670 |
|
} |
1671 |
|
} |
1672 |
|
#else |
1673 |
|
#define check_string_free_list() |
1674 |
|
#endif |
1675 |
|
|
1676 |
/* Return a new Lisp_String. */ |
/* Return a new Lisp_String. */ |
1677 |
|
|
1703 |
total_free_strings += STRING_BLOCK_SIZE; |
total_free_strings += STRING_BLOCK_SIZE; |
1704 |
} |
} |
1705 |
|
|
1706 |
|
check_string_free_list(); |
1707 |
|
|
1708 |
/* Pop a Lisp_String off the free-list. */ |
/* Pop a Lisp_String off the free-list. */ |
1709 |
s = string_free_list; |
s = string_free_list; |
1710 |
string_free_list = NEXT_FREE_LISP_STRING (s); |
string_free_list = NEXT_FREE_LISP_STRING (s); |
1774 |
mallopt (M_MMAP_MAX, 0); |
mallopt (M_MMAP_MAX, 0); |
1775 |
#endif |
#endif |
1776 |
|
|
1777 |
b = (struct sblock *) lisp_malloc (size, MEM_TYPE_NON_LISP); |
b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP); |
1778 |
|
|
1779 |
#ifdef DOUG_LEA_MALLOC |
#ifdef DOUG_LEA_MALLOC |
1780 |
/* Back to a reasonable maximum of mmap'ed areas. */ |
/* Back to a reasonable maximum of mmap'ed areas. */ |
1789 |
else if (current_sblock == NULL |
else if (current_sblock == NULL |
1790 |
|| (((char *) current_sblock + SBLOCK_SIZE |
|| (((char *) current_sblock + SBLOCK_SIZE |
1791 |
- (char *) current_sblock->next_free) |
- (char *) current_sblock->next_free) |
1792 |
< needed)) |
< (needed + GC_STRING_EXTRA))) |
1793 |
{ |
{ |
1794 |
/* Not enough room in the current sblock. */ |
/* Not enough room in the current sblock. */ |
1795 |
b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); |
b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); |
1818 |
s->size = nchars; |
s->size = nchars; |
1819 |
s->size_byte = nbytes; |
s->size_byte = nbytes; |
1820 |
s->data[nbytes] = '\0'; |
s->data[nbytes] = '\0'; |
1821 |
b->next_free = (struct sdata *) ((char *) data + needed); |
#ifdef GC_CHECK_STRING_OVERRUN |
1822 |
|
bcopy(string_overrun_pattern, (char *) data + needed, GC_STRING_EXTRA); |
1823 |
|
#endif |
1824 |
|
b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA); |
1825 |
|
|
1826 |
/* If S had already data assigned, mark that as free by setting its |
/* If S had already data assigned, mark that as free by setting its |
1827 |
string back-pointer to null, and recording the size of the data |
string back-pointer to null, and recording the size of the data |
1926 |
} |
} |
1927 |
} |
} |
1928 |
|
|
1929 |
|
check_string_free_list(); |
1930 |
|
|
1931 |
string_blocks = live_blocks; |
string_blocks = live_blocks; |
1932 |
free_large_strings (); |
free_large_strings (); |
1933 |
compact_small_strings (); |
compact_small_strings (); |
1934 |
|
|
1935 |
|
check_string_free_list(); |
1936 |
} |
} |
1937 |
|
|
1938 |
|
|
2004 |
else |
else |
2005 |
nbytes = SDATA_NBYTES (from); |
nbytes = SDATA_NBYTES (from); |
2006 |
|
|
2007 |
|
#ifdef GC_CHECK_STRING_BYTES |
2008 |
|
if (nbytes > LARGE_STRING_BYTES) |
2009 |
|
abort (); |
2010 |
|
#endif |
2011 |
|
|
2012 |
nbytes = SDATA_SIZE (nbytes); |
nbytes = SDATA_SIZE (nbytes); |
2013 |
from_end = (struct sdata *) ((char *) from + nbytes); |
from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA); |
2014 |
|
|
2015 |
|
#ifdef GC_CHECK_STRING_OVERRUN |
2016 |
|
if (bcmp(string_overrun_pattern, ((char *) from_end) - GC_STRING_EXTRA, GC_STRING_EXTRA)) |
2017 |
|
abort (); |
2018 |
|
#endif |
2019 |
|
|
2020 |
/* FROM->string non-null means it's alive. Copy its data. */ |
/* FROM->string non-null means it's alive. Copy its data. */ |
2021 |
if (from->string) |
if (from->string) |
2022 |
{ |
{ |
2023 |
/* If TB is full, proceed with the next sblock. */ |
/* If TB is full, proceed with the next sblock. */ |
2024 |
to_end = (struct sdata *) ((char *) to + nbytes); |
to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); |
2025 |
if (to_end > tb_end) |
if (to_end > tb_end) |
2026 |
{ |
{ |
2027 |
tb->next_free = to; |
tb->next_free = to; |
2028 |
tb = tb->next; |
tb = tb->next; |
2029 |
tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); |
tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); |
2030 |
to = &tb->first_data; |
to = &tb->first_data; |
2031 |
to_end = (struct sdata *) ((char *) to + nbytes); |
to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA); |
2032 |
} |
} |
2033 |
|
|
2034 |
/* Copy, and update the string's `data' pointer. */ |
/* Copy, and update the string's `data' pointer. */ |
2035 |
if (from != to) |
if (from != to) |
2036 |
{ |
{ |
2037 |
xassert (tb != b || to <= from); |
xassert (tb != b || to <= from); |
2038 |
safe_bcopy ((char *) from, (char *) to, nbytes); |
safe_bcopy ((char *) from, (char *) to, nbytes + GC_STRING_EXTRA); |
2039 |
to->string->data = SDATA_DATA (to); |
to->string->data = SDATA_DATA (to); |
2040 |
} |
} |
2041 |
|
|
2545 |
void |
void |
2546 |
check_cons_list () |
check_cons_list () |
2547 |
{ |
{ |
2548 |
|
#ifdef GC_CHECK_CONS_LIST |
2549 |
struct Lisp_Cons *tail = cons_free_list; |
struct Lisp_Cons *tail = cons_free_list; |
2550 |
|
|
|
#if 0 |
|
2551 |
while (tail) |
while (tail) |
2552 |
tail = *(struct Lisp_Cons **)&tail->cdr; |
tail = *(struct Lisp_Cons **)&tail->cdr; |
2553 |
#endif |
#endif |