[svn:parrot] r46077 - in trunk: . compilers/imcc examples/benchmarks include/parrot src/call src/gc src/pmc src/string

bacek at svn.parrot.org bacek at svn.parrot.org
Tue Apr 27 21:31:09 UTC 2010


Author: bacek
Date: Tue Apr 27 21:31:08 2010
New Revision: 46077
URL: https://trac.parrot.org/parrot/changeset/46077

Log:
Merge branch 'compact_pool_revamp'

Added:
   trunk/examples/benchmarks/stress_strings.pir
Modified:
   trunk/MANIFEST
   trunk/MANIFEST.SKIP
   trunk/compilers/imcc/parser_util.c
   trunk/include/parrot/gc_api.h
   trunk/include/parrot/pobj.h
   trunk/src/call/context.c
   trunk/src/gc/alloc_resources.c
   trunk/src/gc/api.c
   trunk/src/gc/gc_ms.c
   trunk/src/gc/gc_private.h
   trunk/src/gc/mark_sweep.c
   trunk/src/pmc/callcontext.pmc
   trunk/src/string/api.c

Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/MANIFEST	Tue Apr 27 21:31:08 2010	(r46077)
@@ -1,11 +1,12 @@
 # ex: set ro:
 # $Id$
 #
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Apr 24 03:05:21 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Apr 26 12:41:21 2010 UT
 #
 # See below for documentation on the format of this file.
 #
-# See docs/submissions.pod on how to recreate this file after SVN
+# See docs/submissions.pod and the documentation in
+# tools/dev/mk_manifest_and_skip.pl on how to recreate this file after SVN
 # has been told about new or deleted files.
 .gitignore                                                  []
 CREDITS                                                     [main]doc
@@ -563,6 +564,7 @@
 examples/benchmarks/stress2.pl                              [examples]
 examples/benchmarks/stress2.rb                              [examples]
 examples/benchmarks/stress3.pasm                            [examples]
+examples/benchmarks/stress_strings.pir                      [examples]
 examples/benchmarks/vpm.pir                                 [examples]
 examples/benchmarks/vpm.pl                                  [examples]
 examples/benchmarks/vpm.py                                  [examples]

Modified: trunk/MANIFEST.SKIP
==============================================================================
--- trunk/MANIFEST.SKIP	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/MANIFEST.SKIP	Tue Apr 27 21:31:08 2010	(r46077)
@@ -1,6 +1,6 @@
 # ex: set ro:
 # $Id$
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Apr 24 05:11:30 2010 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Apr 26 12:41:21 2010 UT
 #
 # This file should contain a transcript of the svn:ignore properties
 # of the directories in the Parrot subversion repository. (Needed for
@@ -188,6 +188,37 @@
 ^compilers/imcc/imcparser\.h/
 ^compilers/imcc/imcparser\.output$
 ^compilers/imcc/imcparser\.output/
+# generated from svn:ignore of 'compilers/json/'
+^compilers/json/JSON\.pbc$
+^compilers/json/JSON\.pbc/
+# generated from svn:ignore of 'compilers/json/JSON/'
+^compilers/json/JSON/.*\.pbc$
+^compilers/json/JSON/.*\.pbc/
+^compilers/json/JSON/.*\.pir$
+^compilers/json/JSON/.*\.pir/
+# generated from svn:ignore of 'compilers/ncigen/'
+^compilers/ncigen/Makefile$
+^compilers/ncigen/Makefile/
+^compilers/ncigen/ncigen\.pbc$
+^compilers/ncigen/ncigen\.pbc/
+# generated from svn:ignore of 'compilers/ncigen/src/'
+^compilers/ncigen/src/gen_actions\.pir$
+^compilers/ncigen/src/gen_actions\.pir/
+^compilers/ncigen/src/gen_builtins\.pir$
+^compilers/ncigen/src/gen_builtins\.pir/
+^compilers/ncigen/src/gen_grammar\.pir$
+^compilers/ncigen/src/gen_grammar\.pir/
+# generated from svn:ignore of 'compilers/nqp/'
+^compilers/nqp/nqp\.pbc$
+^compilers/nqp/nqp\.pbc/
+# generated from svn:ignore of 'compilers/nqp/bootstrap/'
+^compilers/nqp/bootstrap/gen_actions\.pir$
+^compilers/nqp/bootstrap/gen_actions\.pir/
+^compilers/nqp/bootstrap/nqp\.pbc$
+^compilers/nqp/bootstrap/nqp\.pbc/
+# generated from svn:ignore of 'compilers/nqp/src/'
+^compilers/nqp/src/Grammar_gen\.pir$
+^compilers/nqp/src/Grammar_gen\.pir/
 # generated from svn:ignore of 'compilers/pct/src/PAST/'
 ^compilers/pct/src/PAST/.*\.pbc$
 ^compilers/pct/src/PAST/.*\.pbc/
@@ -523,9 +554,6 @@
 ^runtime/parrot/include/.*\.pasm/
 ^runtime/parrot/include/.*\.pbc$
 ^runtime/parrot/include/.*\.pbc/
-# generated from svn:ignore of 'runtime/parrot/languages/'
-^runtime/parrot/languages/data_json$
-^runtime/parrot/languages/data_json/
 # generated from svn:ignore of 'runtime/parrot/library/'
 ^runtime/parrot/library/.*\.pbc$
 ^runtime/parrot/library/.*\.pbc/
@@ -753,6 +781,8 @@
 # generated from svn:ignore of 'src/gc/'
 ^src/gc/.*\.bundle$
 ^src/gc/.*\.bundle/
+^src/gc/.*\.c$
+^src/gc/.*\.c/
 ^src/gc/.*\.def$
 ^src/gc/.*\.def/
 ^src/gc/.*\.dll$
@@ -862,13 +892,6 @@
 ^t/benchmark/.*\.pasm/
 ^t/benchmark/.*\.pir$
 ^t/benchmark/.*\.pir/
-# generated from svn:ignore of 't/compilers/data_json/'
-^t/compilers/data_json/.*\.pbc$
-^t/compilers/data_json/.*\.pbc/
-^t/compilers/data_json/.*\.pir$
-^t/compilers/data_json/.*\.pir/
-^t/compilers/data_json/.*_pbcexe$
-^t/compilers/data_json/.*_pbcexe/
 # generated from svn:ignore of 't/compilers/imcc/'
 ^t/compilers/imcc/.*\.pbc$
 ^t/compilers/imcc/.*\.pbc/
@@ -899,6 +922,13 @@
 ^t/compilers/imcc/syn/.*\.pir/
 ^t/compilers/imcc/syn/.*_pbcexe.*$
 ^t/compilers/imcc/syn/.*_pbcexe.*/
+# generated from svn:ignore of 't/compilers/json/'
+^t/compilers/json/.*\.pbc$
+^t/compilers/json/.*\.pbc/
+^t/compilers/json/.*\.pir$
+^t/compilers/json/.*\.pir/
+^t/compilers/json/.*_pbcexe$
+^t/compilers/json/.*_pbcexe/
 # generated from svn:ignore of 't/compilers/pct/'
 ^t/compilers/pct/.*\.pbc$
 ^t/compilers/pct/.*\.pbc/

Modified: trunk/compilers/imcc/parser_util.c
==============================================================================
--- trunk/compilers/imcc/parser_util.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/compilers/imcc/parser_util.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -383,14 +383,9 @@
     int emit)
 {
     ASSERT_ARGS(INS)
-    int i, op, len;
-    int dirs = 0;
-    Instruction *ins;
-    op_info_t   *op_info;
-    char fullname[64] = "", format[128] = "";
 
     if (STREQ(name, ".annotate")) {
-        ins = _mk_instruction(name, "", n, r, 0);
+        Instruction *ins = _mk_instruction(name, "", n, r, 0);
         if (emit)
             return emitb(interp, unit, ins);
         else
@@ -402,176 +397,183 @@
     ||  (STREQ(name, "get_params"))
     ||  (STREQ(name, "set_returns")))
         return var_arg_ins(interp, unit, name, r, n, emit);
+    else {
+        Instruction *ins;
+        int i, op, len;
+        int dirs = 0;
+        op_info_t   *op_info;
+        char fullname[64] = "", format[128] = "";
 
-    op_fullname(fullname, name, r, n, keyvec);
-    op = interp->op_lib->op_code(interp, fullname, 1);
-
-    /* maybe we have a fullname */
-    if (op < 0)
-        op = interp->op_lib->op_code(interp, name, 1);
-
-    /* still wrong, try reverse compare */
-    if (op < 0) {
-        const char * const n_name = try_rev_cmp(name, r);
-        if (n_name) {
-            name = n_name;
-            op_fullname(fullname, name, r, n, keyvec);
-            op   = interp->op_lib->op_code(interp, fullname, 1);
-        }
-    }
-
-    /* still wrong, try to find an existing op */
-    if (op < 0)
-        op = try_find_op(interp, unit, name, r, n, keyvec, emit);
-
-    if (op < 0) {
-        int ok = 0;
+        op_fullname(fullname, name, r, n, keyvec);
+        op = interp->op_lib->op_code(interp, fullname, 1);
 
-        /* check mixed constants */
-        ins = IMCC_subst_constants_umix(interp, unit, name, r, n + 1);
-        if (ins)
-            goto found_ins;
+        /* maybe we have a fullname */
+        if (op < 0)
+            op = interp->op_lib->op_code(interp, name, 1);
+
+        /* still wrong, try reverse compare */
+        if (op < 0) {
+            const char * const n_name = try_rev_cmp(name, r);
+            if (n_name) {
+                name = n_name;
+                op_fullname(fullname, name, r, n, keyvec);
+                op   = interp->op_lib->op_code(interp, fullname, 1);
+            }
+        }
+
+        /* still wrong, try to find an existing op */
+        if (op < 0)
+            op = try_find_op(interp, unit, name, r, n, keyvec, emit);
 
-        /* and finally multiple constants */
-        ins = IMCC_subst_constants(interp, unit, name, r, n + 1, &ok);
+        if (op < 0) {
+            int ok = 0;
 
-        if (ok) {
+            /* check mixed constants */
+            ins = IMCC_subst_constants_umix(interp, unit, name, r, n + 1);
             if (ins)
                 goto found_ins;
-            else
-                return NULL;
-        }
-    }
-    else
-        strcpy(fullname, name);
 
-    if (op < 0)
-        IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
-                    "The opcode '%s' (%s<%d>) was not found. "
-                    "Check the type and number of the arguments",
-                    fullname, name, n);
-
-    op_info = &interp->op_info_table[op];
-    *format = '\0';
-
-    /* info->op_count is args + 1
-     * build instruction format
-     * set LV_in / out flags */
-    if (n != op_info->op_count - 1)
-        IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
-                "arg count mismatch: op #%d '%s' needs %d given %d",
-                op, fullname, op_info->op_count-1, n);
-
-    /* XXX Speed up some by keep track of the end of format ourselves */
-    for (i = 0; i < n; i++) {
-        switch (op_info->dirs[i]) {
-          case PARROT_ARGDIR_INOUT:
-            dirs |= 1 << (16 + i);
-            /* go on */
-          case PARROT_ARGDIR_IN:
-            dirs |= 1 << i ;
-            break;
-
-          case PARROT_ARGDIR_OUT:
-            dirs |= 1 << (16 + i);
-            break;
-
-          default:
-            PARROT_ASSERT(0);
-        };
-
-        if (keyvec & KEY_BIT(i)) {
-            /* XXX Assert that len > 2 */
-            len          = strlen(format) - 2;
-            PARROT_ASSERT(len >= 0);
-            format[len]  = '\0';
-            strcat(format, "[%s], ");
+            /* and finally multiple constants */
+            ins = IMCC_subst_constants(interp, unit, name, r, n + 1, &ok);
+
+            if (ok) {
+                if (ins)
+                    goto found_ins;
+                else
+                    return NULL;
+            }
         }
-        else if (r[i]->set == 'K')
-            strcat(format, "[%s], ");
         else
-            strcat(format, "%s, ");
-    }
+            strcpy(fullname, name);
 
-    len = strlen(format);
-    if (len >= 2)
-        len -= 2;
+        if (op < 0)
+            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
+                        "The opcode '%s' (%s<%d>) was not found. "
+                        "Check the type and number of the arguments",
+                        fullname, name, n);
+
+        op_info = &interp->op_info_table[op];
+        *format = '\0';
+
+        /* info->op_count is args + 1
+         * build instruction format
+         * set LV_in / out flags */
+        if (n != op_info->op_count - 1)
+            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
+                    "arg count mismatch: op #%d '%s' needs %d given %d",
+                    op, fullname, op_info->op_count-1, n);
 
-    format[len] = '\0';
+        /* XXX Speed up some by keep track of the end of format ourselves */
+        for (i = 0; i < n; i++) {
+            switch (op_info->dirs[i]) {
+              case PARROT_ARGDIR_INOUT:
+                dirs |= 1 << (16 + i);
+                /* go on */
+              case PARROT_ARGDIR_IN:
+                dirs |= 1 << i ;
+                break;
+
+              case PARROT_ARGDIR_OUT:
+                dirs |= 1 << (16 + i);
+                break;
+
+              default:
+                PARROT_ASSERT(0);
+            };
+
+            if (keyvec & KEY_BIT(i)) {
+                /* XXX Assert that len > 2 */
+                len          = strlen(format) - 2;
+                PARROT_ASSERT(len >= 0);
+                format[len]  = '\0';
+                strcat(format, "[%s], ");
+            }
+            else if (r[i]->set == 'K')
+                strcat(format, "[%s], ");
+            else
+                strcat(format, "%s, ");
+        }
 
-    if (fmt && *fmt) {
-        strncpy(format, fmt, sizeof (format) - 1);
-        format[sizeof (format) - 1] = '\0';
-    }
+        len = strlen(format);
+        if (len >= 2)
+            len -= 2;
 
-    IMCC_debug(interp, DEBUG_PARSER, "%s %s\t%s\n", name, format, fullname);
+        format[len] = '\0';
 
-    /* make the instruction */
-    ins         = _mk_instruction(name, format, n, r, dirs);
-    ins->keys  |= keyvec;
+        if (fmt && *fmt) {
+            strncpy(format, fmt, sizeof (format) - 1);
+            format[sizeof (format) - 1] = '\0';
+        }
 
-    /* fill in oplib's info */
-    ins->opnum  = op;
-    ins->opsize = n + 1;
+        IMCC_debug(interp, DEBUG_PARSER, "%s %s\t%s\n", name, format, fullname);
 
-    /* mark end as absolute branch */
-    if (STREQ(name, "end") || STREQ(name, "ret")) {
-        ins->type |= ITBRANCH | IF_goto;
-    }
-    else if (STREQ(name, "warningson")) {
-        /* emit a debug seg, if this op is seen */
-        PARROT_WARNINGS_on(interp, PARROT_WARNINGS_ALL_FLAG);
-    }
-    else if (STREQ(name, "yield")) {
-        if (!IMCC_INFO(interp)->cur_unit->instructions->symregs[0])
-            IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
-                "Cannot yield from non-continuation\n");
+        /* make the instruction */
+        ins         = _mk_instruction(name, format, n, r, dirs);
+        ins->keys  |= keyvec;
 
-        IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->pcc_sub->calls_a_sub
-            |= 1 | ITPCCYIELD;
-    }
-    else if ((strncmp(name, "invoke", 6) == 0) ||
-             (strncmp(name, "callmethod", 10) == 0)) {
-        if (IMCC_INFO(interp)->cur_unit->type & IMC_PCCSUB)
-            IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->pcc_sub->calls_a_sub |= 1;
-    }
-
-    /* set up branch flags
-     * mark registers that are labels */
-    for (i = 0; i < op_info->op_count - 1; i++) {
-        if (op_info->labels[i])
-            ins->type |= ITBRANCH | (1 << i);
-        else {
-            if (r[i]->type == VTADDRESS)
+        /* fill in oplib's info */
+        ins->opnum  = op;
+        ins->opsize = n + 1;
+
+        /* mark end as absolute branch */
+        if (STREQ(name, "end") || STREQ(name, "ret")) {
+            ins->type |= ITBRANCH | IF_goto;
+        }
+        else if (STREQ(name, "warningson")) {
+            /* emit a debug seg, if this op is seen */
+            PARROT_WARNINGS_on(interp, PARROT_WARNINGS_ALL_FLAG);
+        }
+        else if (STREQ(name, "yield")) {
+            if (!IMCC_INFO(interp)->cur_unit->instructions->symregs[0])
                 IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
-                        "undefined identifier '%s'\n", r[i]->name);
+                    "Cannot yield from non-continuation\n");
+
+            IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->pcc_sub->calls_a_sub
+                |= 1 | ITPCCYIELD;
         }
-    }
+        else if ((strncmp(name, "invoke", 6) == 0) ||
+                 (strncmp(name, "callmethod", 10) == 0)) {
+            if (IMCC_INFO(interp)->cur_unit->type & IMC_PCCSUB)
+                IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->pcc_sub->calls_a_sub |= 1;
+        }
+
+        /* set up branch flags
+         * mark registers that are labels */
+        for (i = 0; i < op_info->op_count - 1; i++) {
+            if (op_info->labels[i])
+                ins->type |= ITBRANCH | (1 << i);
+            else {
+                if (r[i]->type == VTADDRESS)
+                    IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
+                            "undefined identifier '%s'\n", r[i]->name);
+            }
+        }
+
+        if (op_info->jump) {
+            ins->type |= ITBRANCH;
+            /* TODO use opnum constants */
+            if (STREQ(name, "branch")
+            ||  STREQ(name, "tailcall")
+            ||  STREQ(name, "returncc"))
+                ins->type |= IF_goto;
+            else if (STREQ(fullname, "jump_i")
+                 ||  STREQ(fullname, "branch_i"))
+                IMCC_INFO(interp)->dont_optimize = 1;
+        }
+        else if (STREQ(name, "set") && n == 2) {
+            /* set Px, Py: both PMCs have the same address */
+            if (r[0]->set == r[1]->set && REG_NEEDS_ALLOC(r[1]))
+                ins->type |= ITALIAS;
+        }
+        else if (STREQ(name, "compile"))
+            ++IMCC_INFO(interp)->has_compile;
 
-    if (op_info->jump) {
-        ins->type |= ITBRANCH;
-        /* TODO use opnum constants */
-        if (STREQ(name, "branch")
-        ||  STREQ(name, "tailcall")
-        ||  STREQ(name, "returncc"))
-            ins->type |= IF_goto;
-        else if (STREQ(fullname, "jump_i")
-             ||  STREQ(fullname, "branch_i"))
-            IMCC_INFO(interp)->dont_optimize = 1;
-    }
-    else if (STREQ(name, "set") && n == 2) {
-        /* set Px, Py: both PMCs have the same address */
-        if (r[0]->set == r[1]->set && REG_NEEDS_ALLOC(r[1]))
-            ins->type |= ITALIAS;
-    }
-    else if (STREQ(name, "compile"))
-        ++IMCC_INFO(interp)->has_compile;
-
-  found_ins:
-    if (emit)
-        emitb(interp, unit, ins);
+      found_ins:
+        if (emit)
+            emitb(interp, unit, ins);
 
-    return ins;
+        return ins;
+    }
 }
 
 extern void* yy_scan_string(const char *);

Added: trunk/examples/benchmarks/stress_strings.pir
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/examples/benchmarks/stress_strings.pir	Tue Apr 27 21:31:08 2010	(r46077)
@@ -0,0 +1,43 @@
+# Copyright (C) 2010, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+examples/benchmarks/stress_strings.pir - GC strings stress-testing
+
+=head1 SYNOPSIS
+
+    % time ./parrot examples/benchmarks/stress_strings.pir
+
+=head1 DESCRIPTION
+
+Create a lots of strings. Some of them are long-lived, most of them are short lived.
+
+Main purpose - test compact_pool performance.
+
+=cut
+
+.sub 'main' :main
+    .local pmc rsa # array of long lived strings.
+
+    .local int i
+
+    rsa = new ['ResizableStringArray']
+    i = 0
+  loop:
+    $S0 = i         # allocate new string
+    $I0 = i % 10    # every 10th string is longlived
+    if $I0 goto inc_i
+    push rsa, $S0
+  inc_i:
+    inc i
+    if i < 10000000 goto loop
+
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

Modified: trunk/include/parrot/gc_api.h
==============================================================================
--- trunk/include/parrot/gc_api.h	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/include/parrot/gc_api.h	Tue Apr 27 21:31:08 2010	(r46077)
@@ -31,6 +31,8 @@
 #define WORD_ALIGN_1 (sizeof (void *) - 1)
 #define WORD_ALIGN_MASK ~WORD_ALIGN_1
 
+#define ALIGNED_STRING_SIZE(len) (((len) + sizeof (void*) + WORD_ALIGN_1) & WORD_ALIGN_MASK)
+
 /* pool iteration */
 typedef enum {
     POOL_PMC    = 0x01,

Modified: trunk/include/parrot/pobj.h
==============================================================================
--- trunk/include/parrot/pobj.h	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/include/parrot/pobj.h	Tue Apr 27 21:31:08 2010	(r46077)
@@ -55,10 +55,11 @@
 /* Given a pointer to the buffer, find the ref_count and the actual start of
    the allocated space. Setting ref_count is clunky because we avoid lvalue
    casts. */
-#define Buffer_alloc_offset sizeof (INTVAL)
+#define Buffer_alloc_offset sizeof (void*)
 #define Buffer_bufallocstart(b)  ((char *)Buffer_bufstart(b) - Buffer_alloc_offset)
-#define Buffer_bufrefcount(b)    (*(INTVAL *)Buffer_bufallocstart(b))
 #define Buffer_bufrefcountptr(b) ((INTVAL *)Buffer_bufallocstart(b))
+#define Buffer_pool(b) ((Memory_Block *)( *(INTVAL*)(Buffer_bufallocstart(b)) & ~3 ))
+#define Buffer_poolptr(b) ((Memory_Block **)Buffer_bufallocstart(b))
 
 
 typedef enum {

Modified: trunk/src/call/context.c
==============================================================================
--- trunk/src/call/context.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/call/context.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -523,18 +523,12 @@
 {
     ASSERT_ARGS(Parrot_pcc_free_registers)
     Parrot_CallContext_attributes * const ctx = PARROT_CALLCONTEXT(pmcctx);
-    size_t reg_size;
 
-    if (!ctx)
-        return;
-
-    reg_size = Parrot_pcc_calculate_registers_size(interp, ctx->n_regs_used);
-    if (!reg_size)
-        return;
-
-    /* Free registers */
-    Parrot_gc_free_fixed_size_storage(interp, reg_size, ctx->registers);
+    const size_t reg_size =
+        Parrot_pcc_calculate_registers_size(interp, ctx->n_regs_used);
 
+    if (reg_size)
+        Parrot_gc_free_fixed_size_storage(interp, reg_size, ctx->registers);
 }
 
 

Modified: trunk/src/gc/alloc_resources.c
==============================================================================
--- trunk/src/gc/alloc_resources.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/gc/alloc_resources.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -90,14 +90,19 @@
         FUNC_MODIFIES(*new_block);
 
 static void free_pool(ARGFREE(Fixed_Size_Pool *pool));
+static int is_block_almost_full(ARGIN(const Memory_Block *block))
+        __attribute__nonnull__(1);
+
 PARROT_WARN_UNUSED_RESULT
 PARROT_CANNOT_RETURN_NULL
 static char * move_one_buffer(PARROT_INTERP,
+    ARGIN(Memory_Block *pool),
     ARGMOD(Buffer *old_buf),
     ARGMOD(char *new_pool_ptr))
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
         __attribute__nonnull__(3)
+        __attribute__nonnull__(4)
         FUNC_MODIFIES(*old_buf)
         FUNC_MODIFIES(*new_pool_ptr);
 
@@ -168,8 +173,11 @@
     , PARROT_ASSERT_ARG(pool) \
     , PARROT_ASSERT_ARG(new_block))
 #define ASSERT_ARGS_free_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
+#define ASSERT_ARGS_is_block_almost_full __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(block))
 #define ASSERT_ARGS_move_one_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
+    , PARROT_ASSERT_ARG(pool) \
     , PARROT_ASSERT_ARG(old_buf) \
     , PARROT_ASSERT_ARG(new_pool_ptr))
 #define ASSERT_ARGS_new_memory_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
@@ -455,6 +463,7 @@
 
     /* Snag a block big enough for everything */
     total_size = pad_pool_size(pool);
+
     alloc_new_block(mem_pools, total_size, pool, "inside compact");
 
     new_block = pool->top_block;
@@ -480,7 +489,14 @@
             const size_t objects_end = cur_buffer_arena->used;
 
             for (i = objects_end; i; --i) {
-                cur_spot = move_one_buffer(interp, b, cur_spot);
+
+                if (Buffer_buflen(b) && PObj_is_movable_TESTALL(b)) {
+                    Memory_Block *old_block = Buffer_pool(b);
+
+                    if (!is_block_almost_full(old_block))
+                        cur_spot = move_one_buffer(interp, new_block, b, cur_spot);
+                }
+
                 b = (Buffer *)((char *)b + object_size);
             }
         }
@@ -534,34 +550,37 @@
 pad_pool_size(ARGIN(const Variable_Size_Pool *pool))
 {
     ASSERT_ARGS(pad_pool_size)
-    const Memory_Block *cur_block = pool->top_block;
+    Memory_Block *cur_block = pool->top_block;
 
-    UINTVAL total_size = 0;
+    UINTVAL total_size   = 0;
+#if RESOURCE_DEBUG
+    size_t  total_blocks = 0;
+#endif
 
     while (cur_block) {
-        total_size += (cur_block->size - cur_block->free);
+        total_size += cur_block->size - cur_block->freed - cur_block->free;
         cur_block   = cur_block->prev;
+#if RESOURCE_DEBUG
+        ++total_blocks;
+#endif
     }
 
-    /*
-     * XXX for some reason the guarantee isn't correct
-     *     TODO check why
-     */
-
-    /* total_size -= pool->guaranteed_reclaimable; */
-
     /* this makes for ever increasing allocations but fewer collect runs */
 #if WE_WANT_EVER_GROWING_ALLOCATIONS
     total_size += pool->minimum_block_size;
 #endif
 
+#if RESOURCE_DEBUG
+    fprintf(stderr, "Total blocks: %d\n", total_blocks);
+#endif
+
     return total_size;
 }
 
 /*
 
-=item C<static char * move_one_buffer(PARROT_INTERP, Buffer *old_buf, char
-*new_pool_ptr)>
+=item C<static char * move_one_buffer(PARROT_INTERP, Memory_Block *pool, Buffer
+*old_buf, char *new_pool_ptr)>
 
 The compact_pool operation collects disjointed blocks of memory allocated on a
 given pool's free list into one large block of memory. Once the new larger
@@ -575,87 +594,85 @@
 PARROT_WARN_UNUSED_RESULT
 PARROT_CANNOT_RETURN_NULL
 static char *
-move_one_buffer(PARROT_INTERP, ARGMOD(Buffer *old_buf), ARGMOD(char *new_pool_ptr))
+move_one_buffer(PARROT_INTERP, ARGIN(Memory_Block *pool),
+        ARGMOD(Buffer *old_buf), ARGMOD(char *new_pool_ptr))
 {
     ASSERT_ARGS(move_one_buffer)
-    /* ! (on_free_list | constant | external | sysmem) */
-    if (Buffer_buflen(old_buf) && PObj_is_movable_TESTALL(old_buf)) {
-        INTVAL *flags = NULL;
-        ptrdiff_t offset = 0;
+
+    INTVAL       *flags     = NULL;
+    ptrdiff_t     offset    = 0;
+    Memory_Block *old_block = NULL;
 #if RESOURCE_DEBUG
-        if (Buffer_buflen(old_buf) >= RESOURCE_DEBUG_SIZE)
-            debug_print_buf(interp, old_buf);
+    if (Buffer_buflen(old_buf) >= RESOURCE_DEBUG_SIZE)
+        debug_print_buf(interp, old_buf);
 #else
-        UNUSED(interp);
+    UNUSED(interp);
 #endif
 
-        /* we can't perform the math all the time, because
-         * strstart might be in unallocated memory */
-        if (PObj_is_COWable_TEST(old_buf)) {
-            flags = Buffer_bufrefcountptr(old_buf);
-
-            if (PObj_is_string_TEST(old_buf)) {
-                offset = (ptrdiff_t)((STRING *)old_buf)->strstart -
-                    (ptrdiff_t)Buffer_bufstart(old_buf);
-            }
+    /* we can't perform the math all the time, because
+        * strstart might be in unallocated memory */
+    if (PObj_is_COWable_TEST(old_buf)) {
+        flags = Buffer_bufrefcountptr(old_buf);
+        old_block = Buffer_pool(old_buf);
+
+        if (PObj_is_string_TEST(old_buf)) {
+            offset = (ptrdiff_t)((STRING *)old_buf)->strstart -
+                (ptrdiff_t)Buffer_bufstart(old_buf);
         }
+    }
 
-        /* buffer has already been moved; just change the header */
-        if (flags && (*flags & Buffer_shared_FLAG)
-                  && (*flags & Buffer_moved_FLAG)) {
-            /* Find out who else references our data */
-            Buffer * const hdr = *((Buffer **)Buffer_bufstart(old_buf));
+    /* buffer has already been moved; just change the header */
+    if (flags && (*flags & Buffer_shared_FLAG)
+              && (*flags & Buffer_moved_FLAG)) {
+        /* Find out who else references our data */
+        Buffer * const hdr = *((Buffer **)Buffer_bufstart(old_buf));
+
+        PARROT_ASSERT(PObj_is_COWable_TEST(old_buf));
+
+        /* Make sure they know that we own it too */
+        /* Set Buffer_shared_FLAG in new buffer */
+        *Buffer_bufrefcountptr(hdr) |= Buffer_shared_FLAG;
+
+        /* Now make sure we point to where the other guy does */
+        Buffer_bufstart(old_buf) = Buffer_bufstart(hdr);
+
+        /* And if we're a string, update strstart */
+        /* Somewhat of a hack, but if we get per-pool
+            * collections, it should help ease the pain */
+        if (PObj_is_string_TEST(old_buf))
+            ((STRING *)old_buf)->strstart =
+                (char *)Buffer_bufstart(old_buf) + offset;
+    }
+    else {
+        new_pool_ptr = aligned_mem(old_buf, new_pool_ptr);
 
-            PARROT_ASSERT(PObj_is_COWable_TEST(old_buf));
+        /* Copy our memory to the new pool */
+        memcpy(new_pool_ptr, Buffer_bufstart(old_buf),
+                                Buffer_buflen(old_buf));
 
-            /* Make sure they know that we own it too */
-            /* Set Buffer_shared_FLAG in new buffer */
-            *Buffer_bufrefcountptr(hdr) |= Buffer_shared_FLAG;
-
-            /* Now make sure we point to where the other guy does */
-            Buffer_bufstart(old_buf) = Buffer_bufstart(hdr);
-
-            /* And if we're a string, update strstart */
-            /* Somewhat of a hack, but if we get per-pool
-             * collections, it should help ease the pain */
-            if (PObj_is_string_TEST(old_buf))
-                ((STRING *)old_buf)->strstart =
-                    (char *)Buffer_bufstart(old_buf) + offset;
-        }
-        else {
-            new_pool_ptr = aligned_mem(old_buf, new_pool_ptr);
+        /* If we're shared */
+        if (flags && (*flags & Buffer_shared_FLAG)) {
+            PARROT_ASSERT(PObj_is_COWable_TEST(old_buf));
 
-            /* Copy our memory to the new pool */
-            memcpy(new_pool_ptr, Buffer_bufstart(old_buf),
-                                 Buffer_buflen(old_buf));
-
-            /* If we're shared */
-            if (flags && (*flags & Buffer_shared_FLAG)) {
-                PARROT_ASSERT(PObj_is_COWable_TEST(old_buf));
-
-                /* Let the old buffer know how to find us */
-                *((Buffer **)Buffer_bufstart(old_buf)) = old_buf;
-
-                /* Finally, let the tail know that we've moved, so
-                 * that any other references can know to look for
-                 * us and not re-copy */
-                *flags |= Buffer_moved_FLAG;
-            }
+            /* Let the old buffer know how to find us */
+            *((Buffer **)Buffer_bufstart(old_buf)) = old_buf;
 
-            Buffer_bufstart(old_buf) = new_pool_ptr;
+            /* Finally, let the tail know that we've moved, so
+                * that any other references can know to look for
+                * us and not re-copy */
+            *flags |= Buffer_moved_FLAG;
+        }
 
-            /* No guarantees that our data is still shared, so
-                * assume not, and let the above code fix-up */
-            /* Drop shared FLAG in new buffer */
-            *Buffer_bufrefcountptr(old_buf) &= ~Buffer_shared_FLAG;
+        Buffer_bufstart(old_buf) = new_pool_ptr;
 
+        /* Remember new pool inside */
+        *Buffer_poolptr(old_buf) = pool;
 
-            if (PObj_is_string_TEST(old_buf))
-                ((STRING *)old_buf)->strstart =
-                     (char *)Buffer_bufstart(old_buf) + offset;
+        if (PObj_is_string_TEST(old_buf))
+            ((STRING *)old_buf)->strstart =
+                    (char *)Buffer_bufstart(old_buf) + offset;
 
-            new_pool_ptr += Buffer_buflen(old_buf);
-        }
+        new_pool_ptr += Buffer_buflen(old_buf);
     }
 
     return new_pool_ptr;
@@ -686,24 +703,37 @@
         UINTVAL total_size)
 {
     ASSERT_ARGS(free_old_mem_blocks)
-    Memory_Block *cur_block = new_block->prev;
+    Memory_Block *prev_block = new_block;
+    Memory_Block *cur_block  = new_block->prev;
+    size_t i;
 
     PARROT_ASSERT(new_block == pool->top_block);
 
     while (cur_block) {
         Memory_Block * const next_block = cur_block->prev;
 
-        /* Note that we don't have it any more */
-        mem_pools->memory_allocated -= cur_block->size;
+        if (is_block_almost_full(cur_block)) {
+            /* Skip block */
+            prev_block = cur_block;
+            cur_block  = next_block;
+        }
+        else {
+            /* Note that we don't have it any more */
+            mem_pools->memory_allocated -= cur_block->size;
 
-        /* We know the pool body and pool header are a single chunk, so
-         * this is enough to get rid of 'em both */
-        mem_internal_free(cur_block);
-        cur_block = next_block;
+            /* We know the pool body and pool header are a single chunk, so
+             * this is enough to get rid of 'em both */
+            mem_internal_free(cur_block);
+            cur_block        = next_block;
+
+            /* Unlink it from list */
+            prev_block->prev = next_block;
+        }
     }
 
-    /* Set our new pool as the only pool */
-    new_block->prev       = NULL;
+    /* Terminate list */
+    prev_block->prev = NULL;
+
 
     /* ANR: I suspect this should be set to new_block->size, instead of passing
      * in the raw value of total_size, because alloc_new_block pads the size of
@@ -716,49 +746,45 @@
 
 /*
 
-=item C<char * aligned_mem(const Buffer *buffer, char *mem)>
+=item C<static int is_block_almost_full(const Memory_Block *block)>
 
-Returns a pointer to the aligned allocated storage for Buffer C<buffer>,
-which might not be the same as the pointer to C<buffer> because of
-memory alignment.
+Tests if the block is almost full and should be skipped during compacting.
+
+Returns true if less that 20% of block is available
 
 =cut
 
 */
 
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-char *
-aligned_mem(SHIM(const Buffer *buffer), ARGIN(char *mem))
+static int
+is_block_almost_full(ARGIN(const Memory_Block *block))
 {
-    ASSERT_ARGS(aligned_mem)
-    mem += sizeof (void *);
-    mem  = (char *)(((unsigned long)(mem + WORD_ALIGN_1)) & WORD_ALIGN_MASK);
-
-    return mem;
+    ASSERT_ARGS(is_block_almost_full)
+    return (block->free + block->freed) < block->size * 0.2;
 }
 
 /*
 
-=item C<size_t aligned_string_size(size_t len)>
+=item C<char * aligned_mem(const Buffer *buffer, char *mem)>
 
-Determines the size of a string of length C<len> in RAM, accounting for
-alignment.
+Returns a pointer to the aligned allocated storage for Buffer C<buffer>,
+which might not be the same as the pointer to C<buffer> because of
+memory alignment.
 
 =cut
 
 */
 
-PARROT_CONST_FUNCTION
+PARROT_CANNOT_RETURN_NULL
 PARROT_WARN_UNUSED_RESULT
-size_t
-aligned_string_size(size_t len)
+char *
+aligned_mem(SHIM(const Buffer *buffer), ARGIN(char *mem))
 {
-    ASSERT_ARGS(aligned_string_size)
+    ASSERT_ARGS(aligned_mem)
+    mem += sizeof (void *);
+    mem  = (char *)(((unsigned long)(mem + WORD_ALIGN_1)) & WORD_ALIGN_MASK);
 
-    len += sizeof (void *);
-    len  = (len + WORD_ALIGN_1) & WORD_ALIGN_MASK;
-    return len;
+    return mem;
 }
 
 /*

Modified: trunk/src/gc/api.c
==============================================================================
--- trunk/src/gc/api.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/gc/api.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -342,6 +342,7 @@
     PObj_get_FLAGS(pmc) = PObj_is_PMC_FLAG|flags;
     pmc->vtable         = NULL;
     PMC_data(pmc)       = NULL;
+    PMC_metadata(pmc)   = PMCNULL;
 
     return pmc;
 }

Modified: trunk/src/gc/gc_ms.c
==============================================================================
--- trunk/src/gc/gc_ms.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/gc/gc_ms.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -70,6 +70,12 @@
 PARROT_CANNOT_RETURN_NULL
 static void * gc_ms_allocate_memory_chunk_zeroed(SHIM_INTERP, size_t size);
 
+PARROT_CANNOT_RETURN_NULL
+static void * gc_ms_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
+        __attribute__nonnull__(1)
+        __attribute__nonnull__(2)
+        FUNC_MODIFIES(*pmc);
+
 PARROT_CAN_RETURN_NULL
 static PMC* gc_ms_allocate_pmc_header(PARROT_INTERP, UINTVAL flags)
         __attribute__nonnull__(1);
@@ -215,6 +221,35 @@
 static void gc_ms_unblock_GC_sweep(PARROT_INTERP)
         __attribute__nonnull__(1);
 
+static void Parrot_gc_allocate_new_attributes_arena(
+    ARGMOD(PMC_Attribute_Pool *pool))
+        __attribute__nonnull__(1)
+        FUNC_MODIFIES(*pool);
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_MALLOC
+static PMC_Attribute_Pool * Parrot_gc_create_attrib_pool(size_t attrib_idx);
+
+PARROT_CANNOT_RETURN_NULL
+static PMC_Attribute_Pool * Parrot_gc_get_attribute_pool(SHIM_INTERP,
+    ARGMOD(Memory_Pools *mem_pools),
+    size_t attrib_size)
+        __attribute__nonnull__(2)
+        FUNC_MODIFIES(*mem_pools);
+
+PARROT_CANNOT_RETURN_NULL
+static void * Parrot_gc_get_attributes_from_pool(PARROT_INTERP,
+    ARGMOD(PMC_Attribute_Pool * pool))
+        __attribute__nonnull__(1)
+        __attribute__nonnull__(2)
+        FUNC_MODIFIES(* pool);
+
+static void Parrot_gc_initialize_fixed_size_pools(SHIM_INTERP,
+    ARGMOD(Memory_Pools *mem_pools),
+    size_t init_num_pools)
+        __attribute__nonnull__(2)
+        FUNC_MODIFIES(*mem_pools);
+
 #define ASSERT_ARGS_gc_ms_active_sized_buffers __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(mem_pools))
 #define ASSERT_ARGS_gc_ms_add_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
@@ -233,6 +268,9 @@
 #define ASSERT_ARGS_gc_ms_allocate_memory_chunk __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 #define ASSERT_ARGS_gc_ms_allocate_memory_chunk_zeroed \
      __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
+#define ASSERT_ARGS_gc_ms_allocate_pmc_attributes __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(interp) \
+    , PARROT_ASSERT_ARG(pmc))
 #define ASSERT_ARGS_gc_ms_allocate_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp))
 #define ASSERT_ARGS_gc_ms_allocate_string_header __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
@@ -308,6 +346,19 @@
        PARROT_ASSERT_ARG(interp))
 #define ASSERT_ARGS_gc_ms_unblock_GC_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp))
+#define ASSERT_ARGS_Parrot_gc_allocate_new_attributes_arena \
+     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(pool))
+#define ASSERT_ARGS_Parrot_gc_create_attrib_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
+#define ASSERT_ARGS_Parrot_gc_get_attribute_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(mem_pools))
+#define ASSERT_ARGS_Parrot_gc_get_attributes_from_pool \
+     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(interp) \
+    , PARROT_ASSERT_ARG(pool))
+#define ASSERT_ARGS_Parrot_gc_initialize_fixed_size_pools \
+     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
+       PARROT_ASSERT_ARG(mem_pools))
 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 /* HEADERIZER END: static */
 
@@ -480,9 +531,6 @@
     pt_gc_start_mark(interp);
     Parrot_gc_run_init(interp, interp->mem_pools);
 
-    /* compact STRING pools to collect free headers and allocated buffers */
-    Parrot_gc_compact_memory_pool(interp);
-
     /* Now go trace the PMCs. returning true means we did a complete trace.
        false means it was a lazy trace. */
     if (gc_ms_trace_active_PMCs(interp, (flags & GC_trace_stack_FLAG)
@@ -503,6 +551,9 @@
         Parrot_gc_clear_live_bits(interp, mem_pools->pmc_pool);
     }
 
+    /* compact STRING pools to collect free headers and allocated buffers */
+    Parrot_gc_compact_memory_pool(interp);
+
     pt_gc_stop_mark(interp);
 
     /* Note it */
@@ -615,7 +666,7 @@
             ? interp->mem_pools->constant_pmc_pool
             : interp->mem_pools->pmc_pool;
 
-    return (PMC*)pool->get_free_object(interp, interp->mem_pools, pool);
+    return (PMC *)pool->get_free_object(interp, interp->mem_pools, pool);
 }
 
 /*
@@ -661,7 +712,9 @@
             ? interp->mem_pools->constant_string_header_pool
             : interp->mem_pools->string_header_pool;
 
-    return (STRING *)pool->get_free_object(interp, interp->mem_pools, pool);
+    STRING *s = (STRING *)pool->get_free_object(interp, interp->mem_pools, pool);
+    memset(s, 0, sizeof (STRING));
+    return s;
 }
 
 
@@ -735,7 +788,190 @@
 
 /*
 
-=item C<void * gc_ms_allocate_pmc_attributes(PARROT_INTERP, PMC *pmc)>
+=over 4
+
+=item C<static void * Parrot_gc_get_attributes_from_pool(PARROT_INTERP,
+PMC_Attribute_Pool * pool)>
+
+Get a new fixed-size storage space from the given pool. The pool contains
+information on the size of the item to allocate already.
+
+=item C<static void Parrot_gc_allocate_new_attributes_arena(PMC_Attribute_Pool
+*pool)>
+
+Allocate a new arena of fixed-sized data structures for the given pool.
+
+=item C<static void Parrot_gc_initialize_fixed_size_pools(PARROT_INTERP,
+Memory_Pools *mem_pools, size_t init_num_pools)>
+
+Initialize the pools (zeroize)
+
+=item C<static PMC_Attribute_Pool * Parrot_gc_get_attribute_pool(PARROT_INTERP,
+Memory_Pools *mem_pools, size_t attrib_size)>
+
+Find a fixed-sized data structure pool given the size of the object to
+allocate. If the pool does not exist, create it.
+
+=item C<static PMC_Attribute_Pool * Parrot_gc_create_attrib_pool(size_t
+attrib_idx)>
+
+Create a new pool for fixed-sized data items with the given C<attrib_size>.
+
+=back
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+static void *
+Parrot_gc_get_attributes_from_pool(PARROT_INTERP, ARGMOD(PMC_Attribute_Pool * pool))
+{
+    ASSERT_ARGS(Parrot_gc_get_attributes_from_pool)
+    PMC_Attribute_Free_List *item;
+
+#if GC_USE_LAZY_ALLOCATOR
+    if (pool->free_list) {
+        item            = pool->free_list;
+        pool->free_list = item->next;
+    }
+    else if (pool->newfree) {
+        item          = pool->newfree;
+        pool->newfree = (PMC_Attribute_Free_List *)
+                        ((char *)(pool->newfree) + pool->attr_size);
+        if (pool->newfree >= pool->newlast)
+            pool->newfree = NULL;
+    }
+    else {
+        Parrot_gc_allocate_new_attributes_arena(pool);
+        return Parrot_gc_get_attributes_from_pool(interp, pool);
+    }
+#else
+    if (pool->free_list == NULL)
+        Parrot_gc_allocate_new_attributes_arena(pool);
+    item            = pool->free_list;
+    pool->free_list = item->next;
+#endif
+
+    pool->num_free_objects--;
+    return (void *)item;
+}
+
+
+static void
+Parrot_gc_allocate_new_attributes_arena(ARGMOD(PMC_Attribute_Pool *pool))
+{
+    ASSERT_ARGS(Parrot_gc_allocate_new_attributes_arena)
+    PMC_Attribute_Free_List *next;
+
+    const size_t num_items  = pool->objects_per_alloc;
+    const size_t item_size  = pool->attr_size;
+    const size_t item_space = item_size * num_items;
+    const size_t total_size = sizeof (PMC_Attribute_Arena) + item_space;
+
+    PMC_Attribute_Arena * const new_arena = (PMC_Attribute_Arena *)mem_internal_allocate(
+        total_size);
+
+    new_arena->prev = NULL;
+    new_arena->next = pool->top_arena;
+    pool->top_arena = new_arena;
+    next            = (PMC_Attribute_Free_List *)(new_arena + 1);
+
+#if GC_USE_LAZY_ALLOCATOR
+    pool->newfree   = next;
+    pool->newlast   = (PMC_Attribute_Free_List *)((char *)next + item_space);
+#else
+    pool->free_list = next;
+    for (i = 0; i < num_items; i++) {
+        list        = next;
+        list->next  = (PMC_Attribute_Free_List *)((char *)list + item_size);
+        next        = list->next;
+    }
+    list->next      = pool->free_list;
+#endif
+
+    pool->num_free_objects += num_items;
+    pool->total_objects    += num_items;
+}
+
+static void
+Parrot_gc_initialize_fixed_size_pools(SHIM_INTERP,
+        ARGMOD(Memory_Pools *mem_pools),
+        size_t init_num_pools)
+{
+    ASSERT_ARGS(Parrot_gc_initialize_fixed_size_pools)
+    PMC_Attribute_Pool **pools;
+    const size_t total_size = (init_num_pools + 1) * sizeof (void *);
+
+    pools = (PMC_Attribute_Pool **)mem_internal_allocate(total_size);
+    memset(pools, 0, total_size);
+
+    mem_pools->attrib_pools = pools;
+    mem_pools->num_attribs = init_num_pools;
+}
+
+
+PARROT_CANNOT_RETURN_NULL
+static PMC_Attribute_Pool *
+Parrot_gc_get_attribute_pool(SHIM_INTERP,
+        ARGMOD(Memory_Pools *mem_pools),
+        size_t attrib_size)
+{
+    ASSERT_ARGS(Parrot_gc_get_attribute_pool)
+
+    PMC_Attribute_Pool **pools = mem_pools->attrib_pools;
+    const size_t         idx   = (attrib_size < sizeof (void *))
+                               ? 0
+                               : attrib_size - sizeof (void *);
+
+    if (mem_pools->num_attribs <= idx) {
+        const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
+        const size_t total_size   = total_length * sizeof (void *);
+        const size_t current_size = mem_pools->num_attribs;
+        const size_t diff         = total_length - current_size;
+
+        pools = (PMC_Attribute_Pool **)mem_internal_realloc(pools, total_size);
+        memset(pools + current_size, 0, diff * sizeof (void *));
+        mem_pools->attrib_pools = pools;
+        mem_pools->num_attribs = total_length;
+    }
+
+    if (!pools[idx]) {
+        PMC_Attribute_Pool * const pool = Parrot_gc_create_attrib_pool(idx);
+        /* Create the first arena now, so we don't have to check for it later */
+        Parrot_gc_allocate_new_attributes_arena(pool);
+        pools[idx] = pool;
+    }
+
+    return pools[idx];
+}
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_MALLOC
+static PMC_Attribute_Pool *
+Parrot_gc_create_attrib_pool(size_t attrib_idx)
+{
+    ASSERT_ARGS(Parrot_gc_create_attrib_pool)
+    const size_t attrib_size = attrib_idx + sizeof (void *);
+    const size_t num_objs_raw =
+        (GC_FIXED_SIZE_POOL_SIZE - sizeof (PMC_Attribute_Arena)) / attrib_size;
+    const size_t num_objs = (num_objs_raw == 0)?(1):(num_objs_raw);
+    PMC_Attribute_Pool * const newpool = mem_internal_allocate_typed(PMC_Attribute_Pool);
+
+    newpool->attr_size         = attrib_size;
+    newpool->total_objects     = 0;
+    newpool->objects_per_alloc = num_objs;
+    newpool->num_free_objects  = 0;
+    newpool->free_list         = NULL;
+    newpool->top_arena         = NULL;
+
+    return newpool;
+}
+
+
+/*
+
+=item C<static void * gc_ms_allocate_pmc_attributes(PARROT_INTERP, PMC *pmc)>
 
 Allocates a new attribute structure for a PMC if it has the auto_attrs flag
 set.
@@ -745,7 +981,7 @@
 */
 
 PARROT_CANNOT_RETURN_NULL
-void *
+static void *
 gc_ms_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
 {
     ASSERT_ARGS(gc_ms_allocate_pmc_attributes)
@@ -834,12 +1070,15 @@
     ARGOUT(Buffer *buffer), size_t size)
 {
     ASSERT_ARGS(gc_ms_allocate_buffer_storage)
-    const size_t new_size   = aligned_string_size(size);
+    const size_t new_size   = ALIGNED_STRING_SIZE(size);
 
     Buffer_bufstart(buffer) = (void *)aligned_mem(buffer,
         (char *)mem_allocate(interp,
         interp->mem_pools, new_size, interp->mem_pools->memory_pool));
 
+    /* Save pool used to allocate into buffer header */
+    *Buffer_poolptr(buffer) = interp->mem_pools->memory_pool->top_block;
+
     Buffer_buflen(buffer)   = new_size - sizeof (void *);
 }
 
@@ -880,8 +1119,8 @@
      * normally, which play ping pong with buffers.
      * The normal case is therefore always to allocate a new block
      */
-    new_size = aligned_string_size(newsize);
-    old_size = aligned_string_size(Buffer_buflen(buffer));
+    new_size = ALIGNED_STRING_SIZE(newsize);
+    old_size = ALIGNED_STRING_SIZE(Buffer_buflen(buffer));
     needed   = new_size - old_size;
 
     if ((pool->top_block->free >= needed)
@@ -907,6 +1146,9 @@
     new_size -= sizeof (void *);
 
     Buffer_buflen(buffer) = new_size;
+
+    /* Save pool used to allocate into buffer header */
+    *Buffer_poolptr(buffer) = interp->mem_pools->memory_pool->top_block;
 }
 
 /*
@@ -942,12 +1184,15 @@
                 ? interp->mem_pools->constant_string_pool
                 : interp->mem_pools->memory_pool;
 
-    new_size = aligned_string_size(size);
+    new_size = ALIGNED_STRING_SIZE(size);
     mem      = (char *)mem_allocate(interp, interp->mem_pools, new_size, pool);
     mem     += sizeof (void *);
 
     Buffer_bufstart(str) = str->strstart = mem;
     Buffer_buflen(str)   = new_size - sizeof (void *);
+
+    /* Save pool used to allocate into buffer header */
+    *Buffer_poolptr(str) = pool->top_block;
 }
 
 /*
@@ -986,8 +1231,8 @@
      * - if the passed strings buffer is the last string in the pool and
      * - if there is enough size, we can just move the pool's top pointer
      */
-    new_size = aligned_string_size(newsize);
-    old_size = aligned_string_size(Buffer_buflen(str));
+    new_size = ALIGNED_STRING_SIZE(newsize);
+    old_size = ALIGNED_STRING_SIZE(Buffer_buflen(str));
     needed   = new_size - old_size;
 
     if (pool->top_block->free >= needed
@@ -1016,6 +1261,9 @@
      * those bugs, this can be removed which would make things cheaper */
     if (copysize)
         memcpy(mem, oldmem, copysize);
+
+    /* Save pool used to allocate into buffer header */
+    *Buffer_poolptr(str) = pool->top_block;
 }
 
 /*
@@ -1370,9 +1618,6 @@
     pool->free_list = ((GC_MS_PObj_Wrapper*)ptr)->next_ptr;
 #endif
 
-    /* PObj_flags_SETTO(ptr, 0); */
-    memset(ptr, 0, pool->object_size);
-
     --pool->num_free_objects;
 
     return ptr;

Modified: trunk/src/gc/gc_private.h
==============================================================================
--- trunk/src/gc/gc_private.h	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/gc/gc_private.h	Tue Apr 27 21:31:08 2010	(r46077)
@@ -171,6 +171,9 @@
     struct Memory_Block *next;
     char *start;
     char *top;
+
+    /* Amount of freed memory. Used in compact_pool */
+    size_t freed;
 } Memory_Block;
 
 typedef struct Variable_Size_Pool {
@@ -393,26 +396,6 @@
     ARGIN(const Fixed_Size_Pool *pool))
         __attribute__nonnull__(2);
 
-PARROT_CANNOT_RETURN_NULL
-PMC_Attribute_Pool * Parrot_gc_get_attribute_pool(SHIM_INTERP,
-    ARGMOD(Memory_Pools *mem_pools),
-    size_t attrib_size)
-        __attribute__nonnull__(2)
-        FUNC_MODIFIES(*mem_pools);
-
-PARROT_CANNOT_RETURN_NULL
-void * Parrot_gc_get_attributes_from_pool(PARROT_INTERP,
-    ARGMOD(PMC_Attribute_Pool * pool))
-        __attribute__nonnull__(1)
-        __attribute__nonnull__(2)
-        FUNC_MODIFIES(* pool);
-
-void Parrot_gc_initialize_fixed_size_pools(SHIM_INTERP,
-    ARGMOD(Memory_Pools *mem_pools),
-    size_t init_num_pools)
-        __attribute__nonnull__(2)
-        FUNC_MODIFIES(*mem_pools);
-
 void Parrot_gc_run_init(SHIM_INTERP, ARGMOD(Memory_Pools *mem_pools))
         __attribute__nonnull__(2)
         FUNC_MODIFIES(*mem_pools);
@@ -459,15 +442,6 @@
     , PARROT_ASSERT_ARG(new_arena))
 #define ASSERT_ARGS_Parrot_gc_clear_live_bits __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(pool))
-#define ASSERT_ARGS_Parrot_gc_get_attribute_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(mem_pools))
-#define ASSERT_ARGS_Parrot_gc_get_attributes_from_pool \
-     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(interp) \
-    , PARROT_ASSERT_ARG(pool))
-#define ASSERT_ARGS_Parrot_gc_initialize_fixed_size_pools \
-     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(mem_pools))
 #define ASSERT_ARGS_Parrot_gc_run_init __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(mem_pools))
 #define ASSERT_ARGS_Parrot_gc_sweep_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
@@ -489,10 +463,6 @@
 char * aligned_mem(SHIM(const Buffer *buffer), ARGIN(char *mem))
         __attribute__nonnull__(2);
 
-PARROT_CONST_FUNCTION
-PARROT_WARN_UNUSED_RESULT
-size_t aligned_string_size(size_t len);
-
 void check_buffer_ptr(
     ARGMOD(Buffer * pobj),
     ARGMOD(Variable_Size_Pool * pool))
@@ -557,7 +527,6 @@
 
 #define ASSERT_ARGS_aligned_mem __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(mem))
-#define ASSERT_ARGS_aligned_string_size __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 #define ASSERT_ARGS_check_buffer_ptr __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(pobj) \
     , PARROT_ASSERT_ARG(pool))
@@ -596,12 +565,6 @@
 void * gc_ms_allocate_fixed_size_storage(PARROT_INTERP, size_t size)
         __attribute__nonnull__(1);
 
-PARROT_CANNOT_RETURN_NULL
-void * gc_ms_allocate_pmc_attributes(PARROT_INTERP, ARGMOD(PMC *pmc))
-        __attribute__nonnull__(1)
-        __attribute__nonnull__(2)
-        FUNC_MODIFIES(*pmc);
-
 void gc_ms_allocate_string_storage(PARROT_INTERP,
     ARGOUT(STRING *str),
     size_t size)
@@ -635,9 +598,6 @@
 #define ASSERT_ARGS_gc_ms_allocate_fixed_size_storage \
      __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp))
-#define ASSERT_ARGS_gc_ms_allocate_pmc_attributes __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(interp) \
-    , PARROT_ASSERT_ARG(pmc))
 #define ASSERT_ARGS_gc_ms_allocate_string_storage __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(str))

Modified: trunk/src/gc/mark_sweep.c
==============================================================================
--- trunk/src/gc/mark_sweep.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/gc/mark_sweep.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -77,15 +77,6 @@
         __attribute__nonnull__(2)
         FUNC_MODIFIES(*mem_pools);
 
-static void Parrot_gc_allocate_new_attributes_arena(
-    ARGMOD(PMC_Attribute_Pool *pool))
-        __attribute__nonnull__(1)
-        FUNC_MODIFIES(*pool);
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_MALLOC
-static PMC_Attribute_Pool * Parrot_gc_create_attrib_pool(size_t attrib_idx);
-
 #define ASSERT_ARGS_free_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(pool) \
     , PARROT_ASSERT_ARG(b))
@@ -102,10 +93,6 @@
 #define ASSERT_ARGS_new_string_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(mem_pools))
-#define ASSERT_ARGS_Parrot_gc_allocate_new_attributes_arena \
-     __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
-       PARROT_ASSERT_ARG(pool))
-#define ASSERT_ARGS_Parrot_gc_create_attrib_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = (0)
 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 /* HEADERIZER END: static */
 
@@ -704,6 +691,30 @@
     ASSERT_ARGS(free_buffer)
     Variable_Size_Pool * const mem_pool = (Variable_Size_Pool *)pool->mem_pool;
 
+    /* If there is no allocated buffer - bail out */
+    if (!Buffer_buflen(b))
+        return;
+
+    /* XXX Jarkko reported that on irix pool->mem_pool was NULL, which really
+     * shouldn't happen */
+    if (mem_pool) {
+        /* Update Memory_Block usage */
+        if (PObj_is_movable_TESTALL(b)) {
+            INTVAL *buffer_flags = Buffer_bufrefcountptr(b);
+
+            /* Mask low 2 bits used for flags */
+            Memory_Block * block = Buffer_pool(b);
+
+            PARROT_ASSERT(block);
+
+            /* We can have shared buffers. Don't count them (yet) */
+            if (!(*buffer_flags & Buffer_shared_FLAG)) {
+                block->freed  += ALIGNED_STRING_SIZE(Buffer_buflen(b));
+            }
+
+        }
+    }
+
     Buffer_buflen(b) = 0;
 }
 
@@ -890,188 +901,6 @@
     return 0;
 }
 
-/*
-
-=over 4
-
-=item C<void * Parrot_gc_get_attributes_from_pool(PARROT_INTERP,
-PMC_Attribute_Pool * pool)>
-
-Get a new fixed-size storage space from the given pool. The pool contains
-information on the size of the item to allocate already.
-
-=item C<static void Parrot_gc_allocate_new_attributes_arena(PMC_Attribute_Pool
-*pool)>
-
-Allocate a new arena of fixed-sized data structures for the given pool.
-
-=item C<void Parrot_gc_initialize_fixed_size_pools(PARROT_INTERP, Memory_Pools
-*mem_pools, size_t init_num_pools)>
-
-Initialize the pools (zeroize)
-
-=item C<PMC_Attribute_Pool * Parrot_gc_get_attribute_pool(PARROT_INTERP,
-Memory_Pools *mem_pools, size_t attrib_size)>
-
-Find a fixed-sized data structure pool given the size of the object to
-allocate. If the pool does not exist, create it.
-
-=item C<static PMC_Attribute_Pool * Parrot_gc_create_attrib_pool(size_t
-attrib_idx)>
-
-Create a new pool for fixed-sized data items with the given C<attrib_size>.
-
-=back
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-void *
-Parrot_gc_get_attributes_from_pool(PARROT_INTERP, ARGMOD(PMC_Attribute_Pool * pool))
-{
-    ASSERT_ARGS(Parrot_gc_get_attributes_from_pool)
-    PMC_Attribute_Free_List *item;
-
-#if GC_USE_LAZY_ALLOCATOR
-    if (pool->free_list) {
-        item            = pool->free_list;
-        pool->free_list = item->next;
-    }
-    else if (pool->newfree) {
-        item          = pool->newfree;
-        pool->newfree = (PMC_Attribute_Free_List *)
-                        ((char *)(pool->newfree) + pool->attr_size);
-        if (pool->newfree >= pool->newlast)
-            pool->newfree = NULL;
-    }
-    else {
-        Parrot_gc_allocate_new_attributes_arena(pool);
-        return Parrot_gc_get_attributes_from_pool(interp, pool);
-    }
-#else
-    if (pool->free_list == NULL)
-        Parrot_gc_allocate_new_attributes_arena(pool);
-    item            = pool->free_list;
-    pool->free_list = item->next;
-#endif
-
-    pool->num_free_objects--;
-    return (void *)item;
-}
-
-
-static void
-Parrot_gc_allocate_new_attributes_arena(ARGMOD(PMC_Attribute_Pool *pool))
-{
-    ASSERT_ARGS(Parrot_gc_allocate_new_attributes_arena)
-    PMC_Attribute_Free_List *next;
-
-    const size_t num_items  = pool->objects_per_alloc;
-    const size_t item_size  = pool->attr_size;
-    const size_t item_space = item_size * num_items;
-    const size_t total_size = sizeof (PMC_Attribute_Arena) + item_space;
-
-    PMC_Attribute_Arena * const new_arena = (PMC_Attribute_Arena *)mem_internal_allocate(
-        total_size);
-
-    new_arena->prev = NULL;
-    new_arena->next = pool->top_arena;
-    pool->top_arena = new_arena;
-    next            = (PMC_Attribute_Free_List *)(new_arena + 1);
-
-#if GC_USE_LAZY_ALLOCATOR
-    pool->newfree   = next;
-    pool->newlast   = (PMC_Attribute_Free_List *)((char *)next + item_space);
-#else
-    pool->free_list = next;
-    for (i = 0; i < num_items; i++) {
-        list        = next;
-        list->next  = (PMC_Attribute_Free_List *)((char *)list + item_size);
-        next        = list->next;
-    }
-    list->next      = pool->free_list;
-#endif
-
-    pool->num_free_objects += num_items;
-    pool->total_objects    += num_items;
-}
-
-void
-Parrot_gc_initialize_fixed_size_pools(SHIM_INTERP,
-        ARGMOD(Memory_Pools *mem_pools),
-        size_t init_num_pools)
-{
-    ASSERT_ARGS(Parrot_gc_initialize_fixed_size_pools)
-    PMC_Attribute_Pool **pools;
-    const size_t total_size = (init_num_pools + 1) * sizeof (void *);
-
-    pools = (PMC_Attribute_Pool **)mem_internal_allocate(total_size);
-    memset(pools, 0, total_size);
-
-    mem_pools->attrib_pools = pools;
-    mem_pools->num_attribs = init_num_pools;
-}
-
-
-PARROT_CANNOT_RETURN_NULL
-PMC_Attribute_Pool *
-Parrot_gc_get_attribute_pool(SHIM_INTERP,
-        ARGMOD(Memory_Pools *mem_pools),
-        size_t attrib_size)
-{
-    ASSERT_ARGS(Parrot_gc_get_attribute_pool)
-
-    PMC_Attribute_Pool **pools = mem_pools->attrib_pools;
-    const size_t         idx   = (attrib_size < sizeof (void *))
-                               ? 0
-                               : attrib_size - sizeof (void *);
-
-    if (mem_pools->num_attribs <= idx) {
-        const size_t total_length = idx + GC_ATTRIB_POOLS_HEADROOM;
-        const size_t total_size   = total_length * sizeof (void *);
-        const size_t current_size = mem_pools->num_attribs;
-        const size_t diff         = total_length - current_size;
-
-        pools = (PMC_Attribute_Pool **)mem_internal_realloc(pools, total_size);
-        memset(pools + current_size, 0, diff * sizeof (void *));
-        mem_pools->attrib_pools = pools;
-        mem_pools->num_attribs = total_length;
-    }
-
-    if (!pools[idx]) {
-        PMC_Attribute_Pool * const pool = Parrot_gc_create_attrib_pool(idx);
-        /* Create the first arena now, so we don't have to check for it later */
-        Parrot_gc_allocate_new_attributes_arena(pool);
-        pools[idx] = pool;
-    }
-
-    return pools[idx];
-}
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_MALLOC
-static PMC_Attribute_Pool *
-Parrot_gc_create_attrib_pool(size_t attrib_idx)
-{
-    ASSERT_ARGS(Parrot_gc_create_attrib_pool)
-    const size_t attrib_size = attrib_idx + sizeof (void *);
-    const size_t num_objs_raw =
-        (GC_FIXED_SIZE_POOL_SIZE - sizeof (PMC_Attribute_Arena)) / attrib_size;
-    const size_t num_objs = (num_objs_raw == 0)?(1):(num_objs_raw);
-    PMC_Attribute_Pool * const newpool = mem_internal_allocate_typed(PMC_Attribute_Pool);
-
-    newpool->attr_size         = attrib_size;
-    newpool->total_objects     = 0;
-    newpool->objects_per_alloc = num_objs;
-    newpool->num_free_objects  = 0;
-    newpool->free_list         = NULL;
-    newpool->top_arena         = NULL;
-
-    return newpool;
-}
-
 
 /*
 

Modified: trunk/src/pmc/callcontext.pmc
==============================================================================
--- trunk/src/pmc/callcontext.pmc	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/pmc/callcontext.pmc	Tue Apr 27 21:31:08 2010	(r46077)
@@ -929,10 +929,13 @@
 
     VTABLE void push_integer(INTVAL value) {
         Pcc_cell *cells;
-        INTVAL    num_pos;
+        INTVAL    num_pos, allocated_positionals;
 
         GET_ATTR_num_positionals(INTERP, SELF, num_pos);
-        ensure_positionals_storage(INTERP, SELF, num_pos + 1);
+        GET_ATTR_allocated_positionals(interp, SELF, allocated_positionals);
+
+        if (num_pos + 1 > allocated_positionals)
+            ensure_positionals_storage(INTERP, SELF, num_pos + 1);
 
         GET_ATTR_positionals(INTERP, SELF, cells);
         cells[num_pos].u.i      = value;
@@ -968,10 +971,13 @@
 
     VTABLE void push_pmc(PMC *value) {
         Pcc_cell *cells;
-        INTVAL    num_pos;
+        INTVAL    num_pos, allocated_positionals;
 
         GET_ATTR_num_positionals(INTERP, SELF, num_pos);
-        ensure_positionals_storage(INTERP, SELF, num_pos + 1);
+        GET_ATTR_allocated_positionals(interp, SELF, allocated_positionals);
+
+        if (num_pos + 1 > allocated_positionals)
+            ensure_positionals_storage(INTERP, SELF, num_pos + 1);
 
         GET_ATTR_positionals(INTERP, SELF, cells);
         cells[num_pos].u.p      = value;

Modified: trunk/src/string/api.c
==============================================================================
--- trunk/src/string/api.c	Tue Apr 27 20:46:56 2010	(r46076)
+++ trunk/src/string/api.c	Tue Apr 27 21:31:08 2010	(r46077)
@@ -652,18 +652,17 @@
     ASSERT_ARGS(string_make)
     const CHARSET *charset;
 
-    if (!charset_name)
-        charset_name = "ascii";
-
-    charset = Parrot_find_charset(interp, charset_name);
-
-    if (!charset)
-        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
-            "Can't make '%s' charset strings", charset_name);
+    if (charset_name) {
+        charset = Parrot_find_charset(interp, charset_name);
+        if (!charset)
+            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+                "Can't make '%s' charset strings", charset_name);
+    }
+    else
+        charset = Parrot_get_charset(interp, 0);
 
     return Parrot_str_new_init(interp, buffer, len,
         charset->preferred_encoding, charset, flags);
-
 }
 
 
@@ -768,9 +767,8 @@
         else
             s->strlen = CHARSET_CODEPOINTS(interp, s);
     }
-    else {
+    else
         s->strlen = s->bufused = 0;
-    }
 
     return s;
 }
@@ -3187,7 +3185,7 @@
     if (minus)
         *--p = '-';
 
-    return string_make(interp, p, (UINTVAL)(tail - p), "ascii", 0);
+    return string_make(interp, p, (UINTVAL)(tail - p), NULL, 0);
 }
 
 


More information about the parrot-commits mailing list