# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #27904]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=27904 >


Here is the next attempt, diffstat against CVS is below:

- has now freelist handling
- doesn't use managed memory anymore

User, control and pad stack are still handled in stack_common.c. This is 
easily changable, *if* we finally know, how these stacks should look like.

Test imcc/t/syn/pcc_16 is failing due to a DOD bug that got exposed by 
these changes. This test uses lexicals a coroutine and exceptions. 
Somewhere the interpreter context is messed up, so that it contains 
illegal PMC pointers.

leo

$ diffstat -w 70 stack-items-2.patch
  classes/closure.pmc          |    3
  classes/coroutine.pmc        |    2
  imcc/pcc.c                   |    8 -
  include/parrot/interpreter.h |    1
  include/parrot/register.h    |    2
  include/parrot/stacks.h      |   18 +-
  src/debug.c                  |   24 +--
  src/dod.c                    |    1
  src/register.c               |   62 +++-------
  src/stack_common.c           |  201 ++++++++++++++-------------------
  src/stacks.c                 |   78 ++++--------
  src/sub.c                    |   46 +++----
  t/op/stacks.t                |    4
  t/pmc/eval.t                 |    4
  14 files changed, 184 insertions(+), 270 deletions(-)
--- parrot/classes/closure.pmc  Sun Feb 22 19:54:30 2004
+++ parrot-leo/classes/closure.pmc      Tue Mar 23 10:21:04 2004
@@ -89,8 +89,7 @@
         struct Parrot_Sub * sub;
         PMC* ret = SUPER();
         sub = PMC_sub(ret);
-        sub->ctx.pad_stack = stack_copy(interpreter,
-            PMC_sub(SELF)->ctx.pad_stack);
+        sub->ctx.pad_stack = PMC_sub(SELF)->ctx.pad_stack;
         return ret;
     }
 
--- parrot/classes/coroutine.pmc        Sun Feb 22 19:54:30 2004
+++ parrot-leo/classes/coroutine.pmc    Tue Mar 23 12:08:35 2004
@@ -73,7 +73,7 @@
     void mark () {
         struct Parrot_Coroutine *c = (struct Parrot_Coroutine *)PMC_sub(SELF);
         mark_stack(INTERP, c->co_control_stack);
-        mark_stack(INTERP, c->co_pad_stack);
+        /* mark_stack(INTERP, c->co_pad_stack); */
         SUPER();    /* mark rest */
     }
 }
--- parrot/imcc/pcc.c   Mon Mar 22 17:43:49 2004
+++ parrot-leo/imcc/pcc.c       Tue Mar 23 12:01:06 2004
@@ -935,16 +935,16 @@
     ins = set_I_const(interp, unit, ins, 4, 0);
 #endif
     /*
+     * emit a savetop for now
+     */
+    ins = insINS(interp, unit, ins, "savetop", regs, 0);
+    /*
      * if we reuse the continuation, update it
      */
     if (!sub->pcc_sub->nci)
         if (!need_cc)
             ins = insINS(interp, unit, ins, "updatecc", regs, 0);
-    /*
-     * emit a savetop for now
-     */
     /* restore self */
-    ins = insINS(interp, unit, ins, "savetop", regs, 0);
     if (meth_call) {
         regs[0] = s0;
         n = 0;
--- parrot/include/parrot/interpreter.h Sun Mar 21 12:08:07 2004
+++ parrot-leo/include/parrot/interpreter.h     Wed Mar 24 08:48:53 2004
@@ -172,6 +172,7 @@
                                          * area */
     struct Arenas *arena_base;          /* Pointer to this interpreter's
                                          * arena */
+    void      *stack_chunk_cache;       /* stack chunk recycling */
     PMC *class_hash;                    /* Hash of classes */
     struct _ParrotIOData *piodata;              /* interpreter's IO system */
 
--- parrot/include/parrot/register.h    Sat Feb 21 20:15:11 2004
+++ parrot-leo/include/parrot/register.h        Wed Mar 24 11:29:51 2004
@@ -72,8 +72,6 @@
                              struct Stack_Chunk* stack);
 void mark_string_register_stack(struct Parrot_Interp* interpreter,
                                 struct Stack_Chunk* stack);
-void mark_register_stack(struct Parrot_Interp* interpreter,
-                         struct Stack_Chunk* stack);
 
 #endif /* PARROT_REGISTER_H */
 
--- parrot/include/parrot/stacks.h      Sat Feb 21 19:10:24 2004
+++ parrot-leo/include/parrot/stacks.h  Wed Mar 24 11:35:06 2004
@@ -15,8 +15,7 @@
 
 #include "parrot/parrot.h"
 
-#define STACK_CHUNK_DEPTH 256
-#define STACK_CHUNK_LIMIT 1000
+#define STACK_CHUNK_LIMIT 100000
 
 typedef struct Stack_Entry {
     UnionVal entry;
@@ -25,17 +24,16 @@
 } Stack_Entry_t;
 
 typedef struct Stack_Chunk {
-    pobj_t obj;
-    size_t used;
-    int n_chunks;
-    int chunk_limit;
     size_t item_size;
-    size_t items_per_chunk;
     const char * name;
-    struct Stack_Chunk *next;
     struct Stack_Chunk *prev;
+    struct Stack_Chunk *free_p;
+    char data;
 } Stack_Chunk_t;
 
+#define STACK_DATAP(chunk) (void*)&(chunk)->data
+#define STACK_ITEMSIZE(chunk) (chunk)->item_size
+
 
 typedef void (*Stack_cleanup_method)(Stack_Entry_t *);
 
@@ -47,9 +45,7 @@
 /*
  * stack_common functions
  */
-Stack_Chunk_t * cst_new_stack(Parrot_Interp, const char *name, size_t, size_t);
-Stack_Chunk_t * stack_copy(Parrot_Interp, Stack_Chunk_t *stack);
-void stack_unmake_COW(Parrot_Interp, Stack_Chunk_t *stack);
+Stack_Chunk_t * cst_new_stack(Parrot_Interp, const char *name, size_t);
 void* stack_prepare_push(Parrot_Interp, Stack_Chunk_t **stack_p);
 void* stack_prepare_pop(Parrot_Interp, Stack_Chunk_t **stack_p);
 
--- parrot/src/debug.c  Sat Mar 13 09:44:44 2004
+++ parrot-leo/src/debug.c      Wed Mar 24 11:39:48 2004
@@ -2147,9 +2147,7 @@
     unsigned long depth = 0, i = 0;
     Stack_Chunk_t *chunk = interpreter->ctx.int_reg_stack;
 
-    valid_chunk(chunk, command, depth,
-                FRAMES_PER_INT_REG_CHUNK, i);
-
+    internal_exception(1, "TODO");
     if (!chunk) {
         i = depth / FRAMES_PER_INT_REG_CHUNK;
         PIO_eprintf(interpreter, "There are only %li frames\n",i);
@@ -2161,7 +2159,7 @@
 
     na(command);
     PDB_print_int_frame(interpreter,
-                &((struct IRegChunkBuf*)chunk->bufstart)->IRegFrame[depth],
+                (struct IRegFrame*)STACK_DATAP(chunk),
                 atoi(command));
 }
 
@@ -2182,9 +2180,7 @@
     unsigned long depth = 0, i = 0;
     Stack_Chunk_t *chunk = interpreter->ctx.num_reg_stack;
 
-    valid_chunk(chunk, command, depth,
-                FRAMES_PER_NUM_REG_CHUNK, i);
-
+    internal_exception(1, "TODO");
     if (!chunk) {
         i = depth / FRAMES_PER_NUM_REG_CHUNK;
         PIO_eprintf(interpreter, "There are only %li frames\n",i);
@@ -2195,7 +2191,7 @@
 
     na(command);
     PDB_print_num_frame(interpreter,
-                &((struct NRegChunkBuf*)chunk->bufstart)->NRegFrame[depth],
+                (struct NRegFrame*)STACK_DATAP(chunk),
                 atoi(command));
 }
 
@@ -2216,9 +2212,7 @@
     unsigned long depth = 0, i = 0;
     Stack_Chunk_t *chunk = interpreter->ctx.string_reg_stack;
 
-    valid_chunk(chunk, command, depth,
-                FRAMES_PER_STR_REG_CHUNK, i);
-
+    internal_exception(1, "TODO");
     if (!chunk) {
         i = depth / FRAMES_PER_STR_REG_CHUNK;
         PIO_eprintf(interpreter, "There are only %li frames\n",i);
@@ -2230,7 +2224,7 @@
 
     na(command);
     PDB_print_string_frame(interpreter,
-                &((struct SRegChunkBuf*)chunk->bufstart)->SRegFrame[depth],
+                (struct SRegFrame*)STACK_DATAP(chunk),
                 atoi(command));
 }
 
@@ -2251,9 +2245,7 @@
     unsigned long depth = 0, i = 0;
     Stack_Chunk_t *chunk = interpreter->ctx.pmc_reg_stack;
 
-    valid_chunk(chunk, command, depth,
-                FRAMES_PER_PMC_REG_CHUNK, i);
-
+    internal_exception(1, "TODO");
     if (!chunk) {
         i = depth / FRAMES_PER_PMC_REG_CHUNK;
         PIO_eprintf(interpreter, "There are only %li frames\n",i);
@@ -2264,7 +2256,7 @@
 
     na(command);
     PDB_print_pmc_frame(interpreter,
-                &((struct PRegChunkBuf*)chunk->bufstart)->PRegFrame[depth],
+                (struct PRegFrame*)STACK_DATAP(chunk),
                 atoi(command), NULL);
 }
 
--- parrot/src/dod.c    Sun Mar 21 12:08:09 2004
+++ parrot-leo/src/dod.c        Wed Mar 24 11:40:04 2004
@@ -265,6 +265,7 @@
     mark_const_subs(interpreter);
 
     mark_object_cache(interpreter);
+
     /* mark NCI meth hash */
     for (i = 0; i < interpreter->nci_method_table_size; ++i) {
         PMC *h = interpreter->nci_method_table[i];
--- parrot/src/register.c       Sat Feb 21 20:15:11 2004
+++ parrot-leo/src/register.c   Wed Mar 24 11:48:14 2004
@@ -20,6 +20,8 @@
 
 =head2 C Implementation
 
+TODO update pod
+
 As the registers and register frame stacks for the various types share
 essentially the same structure we'll take as our example the integer
 registers and their register frame stack.
@@ -76,39 +78,18 @@
 setup_register_stacks(Parrot_Interp interpreter, struct Parrot_Context *ctx)
 {
     ctx->int_reg_stack = cst_new_stack(interpreter,
-            "IntReg_", sizeof(struct IRegFrame), FRAMES_PER_CHUNK);
+            "IntReg_", sizeof(struct IRegFrame));
 
     ctx->string_reg_stack = cst_new_stack(interpreter,
-            "StringReg_", sizeof(struct SRegFrame), FRAMES_PER_CHUNK);
+            "StringReg_", sizeof(struct SRegFrame));
 
     ctx->num_reg_stack = cst_new_stack(interpreter,
-            "NumReg_", sizeof(struct NRegFrame), FRAMES_PER_CHUNK);
+            "NumReg_", sizeof(struct NRegFrame));
 
     ctx->pmc_reg_stack = cst_new_stack(interpreter,
-            "PMCReg_", sizeof(struct PRegFrame), FRAMES_PER_CHUNK);
+            "PMCReg_", sizeof(struct PRegFrame));
 }
 
-/*
-
-=item C<void
-mark_register_stack(Parrot_Interp interpreter, Stack_Chunk_t* stack)>
-
-Marks the contents of the register stacks as live.
-
-=cut
-
-*/
-
-void
-mark_register_stack(Parrot_Interp interpreter, Stack_Chunk_t* chunk)
-{
-    /* go up to top */
-    for (; chunk && chunk->prev; chunk = chunk->prev)
-        ;
-    for (; chunk; chunk = chunk->next) {
-        pobject_lives(interpreter, (PObj*)chunk);
-    }
-}
 
 /*
 
@@ -124,21 +105,19 @@
 void
 mark_pmc_register_stack(Parrot_Interp interpreter, Stack_Chunk_t* chunk)
 {
-    UINTVAL i, j;
-    for (; chunk && chunk->prev; chunk = chunk->prev)
-        ;
-    for ( ; chunk; chunk = chunk->next) {
-        struct PRegChunkBuf* pc = chunk->bufstart;
-        pobject_lives(interpreter, (PObj*)chunk);
-        for (i = 0; i < chunk->used; i++) {
-            struct PRegFrame *pf = &pc->PRegFrame[i];
+    UINTVAL j;
+    for ( ; ; chunk = chunk->prev) {
+        struct PRegFrame *pf = STACK_DATAP(chunk);
+
+        if (chunk == chunk->prev || chunk->free_p)
+            break;
+        /* TODO for variable sized chunks use buflen */
             for (j = 0; j < NUM_REGISTERS/2; j++) {
                 PObj* reg = (PObj*) pf->registers[j];
                 if (reg)
                     pobject_lives(interpreter, reg);
             }
         }
-    }
 }
 
 /*
@@ -155,19 +134,16 @@
 void
 mark_string_register_stack(Parrot_Interp interpreter, Stack_Chunk_t* chunk)
 {
-    UINTVAL i, j;
-    for (; chunk && chunk->prev; chunk = chunk->prev)
-        ;
-    for ( ; chunk; chunk = chunk->next) {
-        struct SRegChunkBuf* sc = chunk->bufstart;
-        pobject_lives(interpreter, (PObj*)chunk);
-        for (i = 0; i < chunk->used; i++) {
-            struct SRegFrame *sf = &sc->SRegFrame[i];
+    UINTVAL j;
+    for ( ; ; chunk = chunk->prev) {
+        struct SRegFrame *sf = STACK_DATAP(chunk);
+
+        if (chunk == chunk->prev || chunk->free_p)
+            break;
             for (j = 0; j < NUM_REGISTERS/2; j++) {
                 PObj* reg = (PObj*) sf->registers[j];
                 if (reg)
                     pobject_lives(interpreter, reg);
-            }
         }
     }
 }
--- parrot/src/stack_common.c   Sun Mar 21 16:46:50 2004
+++ parrot-leo/src/stack_common.c       Wed Mar 24 11:55:53 2004
@@ -11,15 +11,14 @@
 Both the register stacks and stacks implemented in F<src/stacks.c>
 have a common funcionality, which is implemented in this file.
 
-These stacks all differ only in the size of items and items per chunk.
+These stacks all differ only in the size of items.
 
 =head2 Functions
 
 =over 4
 
 =item C<Stack_Chunk_t *
-cst_new_stack(Interp *interpreter, const char *name, size_t item_size,
-  size_t items_per_chunk)>
+cst_new_stack(Interp *interpreter, const char *name, size_t item_size)>
 
 Create a new stack and name it. C<< stack->name >> is used for
 debugging/error reporting.
@@ -31,86 +30,62 @@
 #include "parrot/parrot.h"
 #include <assert.h>
 
+/*
+ * s. also STACK_DATAP and mark routines in stacks.c and registers.c
+ *
+ * It'll be replaced very likely by some more macros in src/generic_register.c
+ */
+
 Stack_Chunk_t *
-cst_new_stack(Interp *interpreter, const char *name, size_t item_size,
-                 size_t items_per_chunk)
+cst_new_stack(Interp *interpreter, const char *name, size_t item_size)
 {
-    Stack_Chunk_t *chunk = new_bufferlike_header(interpreter,
-            sizeof(Stack_Chunk_t));
+    /*
+     * TODO cleanup in Parrot_really_destroy
+     */
+    Stack_Chunk_t *chunk = mem_sys_allocate(item_size +
+            offsetof(Stack_Chunk_t, data));
 
-    SET_NULL(chunk->next);
-    SET_NULL(chunk->prev);
-    chunk->n_chunks = 1;
-    chunk->chunk_limit = STACK_CHUNK_LIMIT;
-    chunk->name = name;
+    chunk->prev = chunk;        /* mark the top of the stack */
     chunk->item_size = item_size;
-    chunk->items_per_chunk = items_per_chunk;
-    chunk->used = 0;
-
-    /* Block DOD from murdering our newly allocated stack buffer. */
-    Parrot_block_DOD(interpreter);
-    Parrot_allocate(interpreter, (Buffer *)chunk, item_size * items_per_chunk);
-    Parrot_unblock_DOD(interpreter);
+    chunk->free_p = NULL;
+    chunk->name = name;
 
     return chunk;
 }
 
+
 /*
 
-=item C<Stack_Chunk_t *
-stack_copy(Parrot_Interp interpreter, Stack_Chunk_t *stack)>
+=item C<void stack_system_init(Interp *interpreter)>
 
-COW copy a stack. This is done by allocating a new stack buffer header,
-that points to possibly common next chunks and to common buffer memory.
+Called from C<make_interpreter()> to initialize the interpreter's
+register stacks.
 
 =cut
 
 */
 
-Stack_Chunk_t *
-stack_copy(Parrot_Interp interpreter, Stack_Chunk_t *stack)
-{
-    Stack_Chunk_t *chunk = new_bufferlike_header(interpreter,
-            sizeof(Stack_Chunk_t));
-    /*
-     * the private0_FLAG indiciates, that we might share the
-     * next stack_chunk too
-     */
-    PObj_get_FLAGS((Buffer *) stack) |=
-       (PObj_COW_FLAG | PObj_private0_FLAG);
-    /* just copy the header, all pointers are shared now */
-    mem_sys_memcopy(chunk, stack, sizeof(*stack));
-    return chunk;
-}
-
 /*
+ * we have currently: NUM, {INT,PMC*,STRING*} frames and Stack_Entry_t
+ */
+#define N_CHUNK_CACHES 3
 
-=item C<void
-stack_unmake_COW(Parrot_Interp interpreter, Stack_Chunk_t *stack)>
-
-Make a COWed stack_chunk non-COWed.
-
-=cut
-
-*/
+typedef struct {
+    Stack_Chunk_t *free_list[N_CHUNK_CACHES];
+} Stack_cache;
 
 void
-stack_unmake_COW(Parrot_Interp interpreter, Stack_Chunk_t *stack)
+stack_system_init(Interp *interpreter)
 {
-    Buffer for_alloc;
-    /*
-     * allocate a dummy stacks memory
-     * also be sure not to allocate from the constant pool
-     */
-    PObj_flags_CLEARALL(&for_alloc);
-    Parrot_allocate(interpreter, &for_alloc, stack->buflen);
+    int i;
+    Stack_cache *sc;
+
     /*
-     * copy over used items data
+     * TODO cleanup in Parrot_really_destroy
      */
-    mem_sys_memcopy(for_alloc.bufstart, stack->bufstart,
-           stack->item_size * stack->items_per_chunk);
-    stack->bufstart = for_alloc.bufstart;
-    PObj_COW_CLEAR((Buffer*)stack);
+    sc = interpreter->stack_chunk_cache = mem_sys_allocate(sizeof(Stack_cache));
+    for (i = 0; i < N_CHUNK_CACHES; ++i)
+        sc->free_list[i] = NULL;
 }
 
 
@@ -119,7 +94,7 @@
 =item C<void*
 stack_prepare_push(Parrot_Interp interpreter, Stack_Chunk_t **stack_p)>
 
-Return a pointer, where new entries go for push. UnCOW if necessary
+Return a pointer, where new entries go for push.
 
 =cut
 
@@ -129,43 +104,42 @@
 stack_prepare_push(Parrot_Interp interpreter, Stack_Chunk_t **stack_p)
 {
     Stack_Chunk_t *chunk = *stack_p, *new_chunk;
+    Stack_cache *sc = interpreter->stack_chunk_cache;
+    int s;
+
     /*
-     * before any change unCOW if necessary
+     * XXX this should be all macroized to get rid of the switch,
+     * s. src/generic_register.c
      */
-    if (PObj_COW_TEST((Buffer*)chunk))
-       stack_unmake_COW(interpreter, chunk);
+    switch (STACK_ITEMSIZE(chunk)) {
+        case sizeof(struct IRegFrame):
+            s = 0;
+            break;
+        case sizeof(struct NRegFrame):
+            s = 1;
+            break;
+        case sizeof(Stack_Entry_t):
+            s = 2;
+            break;
+        default:
+            PANIC("Unhandled stack chunk size");
+            _exit(1); /* avoid warning */
+    }
+    if (sc->free_list[s]) {
+        new_chunk = sc->free_list[s];
+        sc->free_list[s] = new_chunk->free_p;
     /*
-     * if this chunk is full, allocate a new one
+         * freeP- is used as a flag too to avoid tracing into
+         * the free list in mark_pmc_register_stack
      */
-    if (chunk->used == chunk->items_per_chunk) {
-        if (chunk->next == NULL) {
-            new_chunk = cst_new_stack(interpreter, chunk->name,
-                   chunk->item_size, chunk->items_per_chunk);
-           new_chunk->prev = chunk;
-           chunk->next = new_chunk;
-            new_chunk->n_chunks = chunk->n_chunks + 1;
-            if (new_chunk->n_chunks == new_chunk->chunk_limit)
-                internal_exception(1, "Stack '%s' too deep\n",
-                        chunk->name);
-            *stack_p = chunk = new_chunk;
+        new_chunk->free_p = NULL;
        }
-       else {
-           /*
-            * we have a next chunk: this is either a spare chunk
-            * kept during stack_pop to avoid thrashing or
-            * a common next stack_chunk
-            */
-           if (PObj_get_FLAGS((Buffer*)chunk->next) & PObj_private0_FLAG) {
+    else
                new_chunk = cst_new_stack(interpreter, chunk->name,
-                   chunk->item_size, chunk->items_per_chunk);
+                STACK_ITEMSIZE(chunk));
                 new_chunk->prev = chunk;
-               chunk->next = new_chunk;
-           }
-            *stack_p = chunk = chunk->next;
-            assert(!PObj_COW_TEST( (Buffer *) chunk));
-       }
-    }
-    return (char*) chunk->bufstart + chunk->used++ * chunk->item_size;
+    *stack_p = new_chunk;
+    return STACK_DATAP(new_chunk);
 }
 
 /*
@@ -173,7 +147,7 @@
 =item C<void*
 stack_prepare_pop(Parrot_Interp interpreter, Stack_Chunk_t **stack_p)>
 
-Return a pointer, where new entries are poped off. UnCOW if necessary.
+Return a pointer, where new entries are poped off.
 
 =cut
 
@@ -183,30 +157,35 @@
 stack_prepare_pop(Parrot_Interp interpreter, Stack_Chunk_t **stack_p)
 {
     Stack_Chunk_t *chunk = *stack_p;
+    Stack_cache *sc = interpreter->stack_chunk_cache;
+    int s;
     /*
-     * before any change unCOW if necessary
+     * the first entry (initial top) refers to itself
      */
-    if (PObj_COW_TEST((Buffer*)chunk))
-       stack_unmake_COW(interpreter, chunk);
-    /*
-     * if this chunk is empty go to previous if any
-     */
-    if (chunk->used == 0 && chunk->prev) {
-        if (chunk->next) {
-            /* GC will collect it */
-            chunk->next = NULL;
-        }
-
-        /* Now back to the previous chunk - we'll keep the one we have
-         * just emptied around for now in case we need it again. */
-        *stack_p = chunk = chunk->prev;
-       assert(!PObj_COW_TEST( (Buffer *) chunk));
-    }
-    if (chunk->used == 0) {
+    if (chunk == chunk->prev) {
         internal_exception(ERROR_STACK_EMPTY, "No entries on %sStack!",
                 chunk->name);
     }
-    return (char*) chunk->bufstart + --chunk->used * chunk->item_size;
+    switch (STACK_ITEMSIZE(chunk)) {
+        case sizeof(struct IRegFrame):
+            s = 0;
+            break;
+        case sizeof(struct NRegFrame):
+            s = 1;
+            break;
+        case sizeof(Stack_Entry_t):
+            s = 2;
+            break;
+        default:
+            PANIC("Unhandled stack chunk size");
+            _exit(1); /* avoid warning */
+    }
+    *stack_p = chunk->prev;
+
+    chunk->free_p = sc->free_list[s];
+    sc->free_list[s] = chunk;
+
+    return STACK_DATAP(chunk);
 }
 
 /*
--- parrot/src/stacks.c Thu Mar  4 13:08:54 2004
+++ parrot-leo/src/stacks.c     Wed Mar 24 11:41:21 2004
@@ -8,6 +8,8 @@
 
 =head1 DESCRIPTION
 
+TODO update pod
+
 The stack is stored as a doubly-linked list of chunks (C<Stack_Chunk>),
 where each chunk has room for C<STACK_CHUNK_DEPTH> entries. The
 invariant maintained is that there is always room for another entry; if
@@ -45,22 +47,6 @@
 
 /*
 
-=item C<void stack_system_init(Interp *interpreter)>
-
-Called from C<make_interpreter()> to initialize the interpreter's
-register stacks.
-
-=cut
-
-*/
-
-void stack_system_init(Interp *interpreter)
-{
-    make_bufferlike_pool(interpreter, sizeof(Stack_Chunk_t));
-}
-
-/*
-
 =item C<Stack_Chunk_t *
 new_stack(Interp *interpreter, const char *name)>
 
@@ -75,8 +61,7 @@
 new_stack(Interp *interpreter, const char *name)
 {
 
-    return cst_new_stack(interpreter, name,
-            sizeof(Stack_Entry_t), STACK_CHUNK_DEPTH);
+    return cst_new_stack(interpreter, name, sizeof(Stack_Entry_t));
 }
 
 
@@ -99,31 +84,28 @@
     Stack_Entry_t *entry;
     size_t i;
 
-    for (; chunk && chunk->prev; chunk = chunk->prev)
-        ;
-    for (; chunk; chunk = chunk->next) {
-
-        pobject_lives(interpreter, (PObj *)chunk);
-        entry = (Stack_Entry_t *)(chunk->bufstart);
-        for (i = 0; i < chunk->used; i++) {
-            switch (entry[i].entry_type) {
+    for (; ; chunk = chunk->prev) {
+
+        if (chunk == chunk->prev)
+            break;
+        entry = (Stack_Entry_t *)STACK_DATAP(chunk);
+        switch (entry->entry_type) {
                 case STACK_ENTRY_PMC:
-                    if (entry[i].entry.pmc_val) {
+                if (entry->entry.pmc_val) {
                         pobject_lives(interpreter,
-                                      (PObj *)entry[i].entry.pmc_val);
+                            (PObj *)entry->entry.pmc_val);
                     }
                     break;
                 case STACK_ENTRY_STRING:
-                    if (entry[i].entry.string_val) {
+                if (entry->entry.string_val) {
                         pobject_lives(interpreter,
-                                      (PObj *)entry[i].entry.string_val);
+                            (PObj *)entry->entry.string_val);
                     }
                     break;
                 default:
                     break;
             }
         }
-    }
 }
 /*
 
@@ -154,15 +136,15 @@
 */
 
 size_t
-stack_height(Interp *interpreter, Stack_Chunk_t *top)
+stack_height(Interp *interpreter, Stack_Chunk_t *chunk)
 {
-    Stack_Chunk_t *chunk;
-    size_t height = top->used;
+    size_t height = 0;
 
-    for (chunk = top->prev; chunk; chunk = chunk->prev)
-        height += chunk->used;
-    assert(height == (top->n_chunks - 1) * STACK_CHUNK_DEPTH +
-            top->used);
+    for (; ; chunk = chunk->prev) {
+        if (chunk == chunk->prev)
+            break;
+        ++height;
+    }
 
     return height;
 }
@@ -197,16 +179,15 @@
         offset = (size_t)depth;
     }
     chunk = stack;          /* Start at top */
-    while (chunk != NULL && offset >= chunk->used) {
-        offset -= chunk->used;
+    while ( offset) {
+        if (chunk == chunk->prev)
+            break;
+        --offset;
         chunk = chunk->prev;
     }
-    if (chunk == NULL)
+    if (chunk == chunk->prev)
         return NULL;
-    if (offset < chunk->used) {
-        entry = (Stack_Entry_t *)PObj_bufstart(chunk) +
-            chunk->used - offset - 1;
-    }
+    entry = (Stack_Entry_t *)STACK_DATAP(chunk);
     return entry;
 }
 
@@ -235,13 +216,6 @@
 
     if (num_entries >= -1 && num_entries <= 1) {
         return;
-    }
-
-    /* If stack is copy-on-write, copy it before we can execute on it */
-    if (PObj_COW_TEST( (Buffer *) stack)) {
-        stack_unmake_COW(interpreter, stack);
-        if (depth >= STACK_CHUNK_DEPTH)
-            internal_exception(1, "Unhandled deep rotate for COWed stack");
     }
 
 
--- parrot/src/sub.c    Mon Mar 22 13:38:12 2004
+++ parrot-leo/src/sub.c        Wed Mar 24 13:25:36 2004
@@ -57,16 +57,8 @@
 cow_copy_context(struct Parrot_Interp *interp,
         struct Parrot_Context *dest, struct Parrot_Context *src)
 {
-    dest->int_reg_stack = stack_copy(interp, src->int_reg_stack);
-    dest->num_reg_stack = stack_copy(interp, src->num_reg_stack);
-    dest->string_reg_stack = stack_copy(interp, src->string_reg_stack);
-    dest->pmc_reg_stack = stack_copy(interp, src->pmc_reg_stack);
-    dest->pad_stack = stack_copy(interp, src->pad_stack);
-    dest->user_stack = stack_copy(interp, src->user_stack);
-    dest->control_stack = stack_copy(interp, src->control_stack);
-    dest->warns = src->warns;
-    dest->errors = src->errors;
-    buffer_mark_COW(dest->warns);
+    memcpy(dest, src, sizeof(*src));
+    buffer_mark_COW(dest->warns);  /* XXX */
     buffer_mark_COW(dest->errors);
 }
 
@@ -104,8 +96,6 @@
     mark_stack(interpreter, ctx->pad_stack);
     mark_stack(interpreter, ctx->user_stack);
     mark_stack(interpreter, ctx->control_stack);
-    mark_register_stack(interpreter, ctx->int_reg_stack);
-    mark_register_stack(interpreter, ctx->num_reg_stack);
     mark_string_register_stack(interpreter, ctx->string_reg_stack);
     mark_pmc_register_stack(interpreter, ctx->pmc_reg_stack);
     pobject_lives(interpreter, ctx->warns);
@@ -159,13 +149,15 @@
         return;
     }
     /* save current interp stack */
-    *ctx_stack = stack_copy(interp, *interp_stack);
+    *ctx_stack = *interp_stack;
+#if 0
     /* we push a mark on that stack, so if the coroutine pops
      * beyond its own stack into the interpeter stack
      * we can catch this
      */
     stack_push(interp, interp_stack, NULL, STACK_ENTRY_CORO_MARK,
             coro_error);
+#endif
     /*
      * now append the coroutine stack
      * TODO look if we can do some kind of chunk_copy here
@@ -209,7 +201,7 @@
         return;
     }
     /*
-     * if the saved stack is empty just swap
+     * if the coroutine stack is empty just swap
      */
     hc = stack_height(interp, *ctx_stack);
     if (hc == 0) {
@@ -218,6 +210,7 @@
         return;
     }
 
+#if 0
     /*
      * find our mark, everything above the mark is the real coroutine
      * stack
@@ -225,13 +218,13 @@
     for (i = 0; i < hi; i++) {
         Stack_Entry_t *e = stack_entry(interp, *interp_stack, i);
         if (e->cleanup == coro_error) {
-            (void)stack_pop(interp, interp_stack, NULL, STACK_ENTRY_CORO_MARK);
             mark_found = 1;
             break;
         }
     }
     if (!mark_found)
         internal_exception(1, "The coroutine messed with the stack");
+#endif
     hi = stack_height(interp, *interp_stack);
     hs = stack_height(interp, *saved_stack);
     if (!i || (hi == hc + hs)) {
@@ -265,9 +258,6 @@
 
 Swaps the context.
 
-XXX: If this routine is specific to coroutine, we should change
-the C<*sub> argument to C<Parrot_Coroutine>.
-
 =cut
 
 */
@@ -446,20 +436,22 @@
 new_coroutine(struct Parrot_Interp *interp)
 {
     PMC * pad;
-    struct Parrot_Coroutine *co = (struct Parrot_Coroutine *)new_sub(interp,
-            sizeof(struct Parrot_Coroutine));
-    struct Parrot_Context *ctx = &co->ctx;
+    struct Parrot_Context *ctx;
+    struct Parrot_Coroutine *co =
+        mem_sys_allocate_zeroed(sizeof(struct Parrot_Coroutine));
+
+    co->seg = interp->code->cur_cs;
+    ctx = &co->ctx;
     save_context(interp, ctx);
-    setup_register_stacks(interp, &interp->ctx);
-    /* put in a COWed copy of the user stack */
-    ctx->user_stack = stack_copy(interp, interp->ctx.user_stack);
-    /* create new pad and control stacks,
+
+    /* do we have separate register stacks */
+    setup_register_stacks(interp, ctx);
+
+    /* create new (pad ??) and control stacks,
      * when invoking the coroutine the real stacks are
      * constructed in swap_context
      * XXX decide what to do with pad
      */
-    ctx->pad_stack = stack_copy(interp, interp->ctx.pad_stack);
-
     co->co_control_stack = new_stack(interp, "Control");
 
     /*
--- parrot/t/op/stacks.t        Mon Mar  8 10:28:56 2004
+++ parrot-leo/t/op/stacks.t    Tue Mar 23 11:24:37 2004
@@ -1341,6 +1341,8 @@
 ok 8
 OUTPUT
 
+SKIP: {
+  skip("no stack limit currently", 3);
 output_is(<<CODE, <<'OUTPUT', "check limit - User");
 lp:
        save I0
@@ -1366,7 +1368,7 @@
 CODE
 Stack 'Control' too deep
 OUTPUT
-
+}
 ##############################
 
 # set integer registers to some value given by $code...
--- parrot/t/pmc/eval.t Mon Mar  8 10:29:00 2004
+++ parrot-leo/t/pmc/eval.t     Tue Mar 23 12:14:02 2004
@@ -97,6 +97,9 @@
 fin
 OUTPUT
 
+SKIP: {
+  skip("wrong stack handling", 1);
+
 output_is(<<'CODE', <<'OUTPUT', "nano forth sub");
 _main:
     load_bytecode "examples/assembly/nanoforth2.pasm"
@@ -126,3 +129,4 @@
 6
 11
 OUTPUT
+}

Reply via email to