<commit_before>/*
Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
$Id$

=head1 NAME

src/resources.c - Allocate and deallocate tracked resources

=head1 DESCRIPTION

=head2 Parrot Memory Management Code

=over 4

=cut

*/

#include <assert.h>
#include "parrot/parrot.h"

#define RECLAMATION_FACTOR 0.20
#define MINIMUM_MEMPOOL_SIZE  1
#define MAXIMUM_MEMPOOL_SIZE  8
#define WE_WANT_EVER_GROWING_ALLOCATIONS
typedef void (*compact_f) (Interp *, struct Memory_Pool *);

/*

=item C<static void *
alloc_new_block(Interp *interpreter,
        size_t size, struct Memory_Pool *pool)>

Allocate a new memory block. We allocate the larger of however much was
asked for or the default size, whichever's larger.

=cut

*/

static void *
alloc_new_block(Interp *interpreter,
        size_t size, struct Memory_Pool *pool)
{
    size_t alloc_size;
    struct Memory_Block *new_block;

    if (pool) {
        alloc_size = (size > pool->minimum_block_size)
                ? size : pool->minimum_block_size;
    }
    else {
        alloc_size = size;
    }

    /* Allocate a new block. Header info's on the front, plus a fudge factor
     * for good measure */
    new_block = mem_internal_allocate_zeroed(sizeof(struct Memory_Block) +
            alloc_size + 32);
    if (!new_block) {
        fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size+32);
        exit(1);
        return NULL;
    }

    new_block->free = alloc_size;
    new_block->size = alloc_size;
    SET_NULL(new_block->next);
    new_block->start = (char *)new_block + sizeof(struct Memory_Block);
    new_block->top = new_block->start;

    /* Note that we've allocated it */
    interpreter->arena_base->memory_allocated += alloc_size;

    /* If this is for a public pool, add it to the list */
    new_block->prev = pool->top_block;
    /* If we're not first, then tack us on the list */
    if (pool->top_block) {
        pool->top_block->next = new_block;
    }
    pool->top_block = new_block;
    pool->total_allocated += alloc_size;

    return new_block;
}

/*

=item C<static void *
mem_allocate(Interp *interpreter, size_t *req_size,
        struct Memory_Pool *pool, size_t align_1)>

Allocates memory for headers.

Alignment problems:  C<align_1> sets the size, but not the alignment of the
memory block we are about to allocate.  The alignment of I<this> block is
currently determined by the C<align_1> sent in by the I<previous> allocation.
See L<http://archive.develooper.com/perl6-internals%40perl.org/msg12310.html>
for details. Currently, we work around it by forcing all the C<*ALIGNMENT>
C<#define>s in F<E<lt>include/parrot/I<file>.hE<gt>> to be the same.

=cut

*/

static size_t
aligned_size(size_t size, size_t align)
{
    /* Ensure that our minimum size requirements are met, so that we have room
     * for a forwarding COW pointer */
    if (size < sizeof(void *))
        size = sizeof(void *);

    /* Make sure we have room for the buffer's tail flags, also used by the
     * COW logic to detect moved buffers */
    size += sizeof(struct Buffer_Tail);

    /* Round up to requested alignment */
    size = (size + align) & ~align;
    return size;
}

static void *
mem_allocate(Interp *interpreter, size_t *req_size,
        struct Memory_Pool *pool, size_t align_1)
{
    char *return_val;
    size_t size = aligned_size(*req_size, align_1);

    /* we always should have one block at least */<commit_msg>Buffer allocation - more docs<commit_after>/*
Copyright: 2001-2003 The Perl Foundation.  All Rights Reserved.
$Id$

=head1 NAME

src/resources.c - Allocate and deallocate tracked resources

=head1 DESCRIPTION

=head2 Parrot Memory Management Code

=over 4

=cut

*/

#include <assert.h>
#include "parrot/parrot.h"

#define RECLAMATION_FACTOR 0.20
#define MINIMUM_MEMPOOL_SIZE  1
#define MAXIMUM_MEMPOOL_SIZE  8
#define WE_WANT_EVER_GROWING_ALLOCATIONS
typedef void (*compact_f) (Interp *, struct Memory_Pool *);

/*

=item C<static void *
alloc_new_block(Interp *interpreter,
        size_t size, struct Memory_Pool *pool)>

Allocate a new memory block. We allocate the larger of however much was
asked for or the default size, whichever's larger.

=cut

*/

static void *
alloc_new_block(Interp *interpreter,
        size_t size, struct Memory_Pool *pool)
{
    size_t alloc_size;
    struct Memory_Block *new_block;

    if (pool) {
        alloc_size = (size > pool->minimum_block_size)
                ? size : pool->minimum_block_size;
    }
    else {
        alloc_size = size;
    }

    /* Allocate a new block. Header info's on the front, plus a fudge factor
     * for good measure */
    new_block = mem_internal_allocate_zeroed(sizeof(struct Memory_Block) +
            alloc_size + 32);
    if (!new_block) {
        fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size+32);
        exit(1);
        return NULL;
    }

    new_block->free = alloc_size;
    new_block->size = alloc_size;
    SET_NULL(new_block->next);
    new_block->start = (char *)new_block + sizeof(struct Memory_Block);
    new_block->top = new_block->start;

    /* Note that we've allocated it */
    interpreter->arena_base->memory_allocated += alloc_size;

    /* If this is for a public pool, add it to the list */
    new_block->prev = pool->top_block;
    /* If we're not first, then tack us on the list */
    if (pool->top_block) {
        pool->top_block->next = new_block;
    }
    pool->top_block = new_block;
    pool->total_allocated += alloc_size;

    return new_block;
}

/*

=item C<static void *
mem_allocate(Interp *interpreter, size_t *req_size,
        struct Memory_Pool *pool, size_t align_1)>

Allocates memory for headers.

Alignment problems:  C<align_1> sets the size, but not the alignment of the
memory block we are about to allocate.  The alignment of I<this> block is
currently determined by the C<align_1> sent in by the I<previous> allocation.
See L<http://archive.develooper.com/perl6-internals%40perl.org/msg12310.html>
for details. Currently, we work around it by forcing all the C<*ALIGNMENT>
C<#define>s in F<E<lt>include/parrot/I<file>.hE<gt>> to be the same.

TODO this needs fixes - 12 bytes overhead is by far too much.

- return aligned pointer *if needed*
- return strings et al at unaligned i.e. void* boundaries 
- remember alignment in a buffer header bit
  use this in compaction code
- reduce alignment to a reasonable value i.e. MALLOC_ALIGNMENT  
  aka 2*sizeof(size_t) or just 8 (TODO make a config hint)

Buffer memory layout:

                    +-----------------+  
                    |  ref_count   |f |    # GC header
  obj->bufstart  -> +-----------------+
                    |  data           |
                    v                 v

 * if PObj_is_COWable is set, then we have
   - a ref_count, {inc,dec}remented by 2 always
   - the lo bit 'f' means 'is being forwarded" - what currently TAIL_flag is

 * if PObj_align_FLAG is set, obj->bufstart is aligned like discussed above  
 * obj->buflen is the usable length excluding the optional GC part.

=cut

*/

static size_t
aligned_size(size_t size, size_t align)
{
    /* Ensure that our minimum size requirements are met, so that we have room
     * for a forwarding COW pointer */
    if (size < sizeof(void *))
        size = sizeof(void *);

    /* Make sure we have room for the buffer's tail flags, also used by the
     * COW logic to detect moved buffers */
    size += sizeof(struct Buffer_Tail);

    /* Round up to requested alignment */
    size = (size + align) & ~align;
    return size;
}

static void *
mem_allocate(Interp *interpreter, size_t *req_size,
        struct Memory_Pool *pool, size_t align_1)
{
    char *return_val;
    size_t size = aligned_size(*req_size, align_1);

    /* we always should have one block at least */
{'fraction_non_alphanumeric': 0.09947375176485689, 'fraction_numerical': 0.009626492106276472, 'mean_word_length': 3.02687338501292, 'pattern_counts': {'":': 0, '<': 33, '<?xml version=': 0, '>': 71, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 1, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '7342621', 'n_tokens_mistral': 2604, 'n_tokens_neox': 2482, 'n_words': 821}