src/stacks.c

   1 /*
   2 Copyright (C) 2001-2008, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/stacks.c - Stack handling routines for Parrot
   8
   9 =head1 DESCRIPTION
  10
  11 The stack is stored as a linked list of chunks (C<Stack_Chunk>),
  12 where each chunk has room for one entry.
  13
  14 =head2 Functions
  15
  16 =over 4
  17
  18 =cut
  19
  20 */
  21
  22 #include "parrot/parrot.h"
  23 #include "parrot/stacks.h"
  24
  25 /* HEADERIZER HFILE: include/parrot/stacks.h */
  26
  27 /*
  28
  29 =item C<void stack_system_init>
  30
  31 Called from C<make_interpreter()> to initialize the interpreter's
  32 register stacks.
  33
  34 =cut
  35
  36 */
  37
  38 PARROT_API
  39 void
  40 stack_system_init(SHIM_INTERP)
  41 {
  42 }
  43
  44 /*
  45
  46 =item C<Stack_Chunk_t * cst_new_stack_chunk>
  47
  48 Get a new chunk either from the freelist or allocate one.
  49
  50 =cut
  51
  52 */
  53
  54 PARROT_API
  55 PARROT_WARN_UNUSED_RESULT
  56 PARROT_CANNOT_RETURN_NULL
  57 Stack_Chunk_t *
  58 cst_new_stack_chunk(PARROT_INTERP, ARGIN(const Stack_Chunk_t *chunk))
  59 {
  60     Small_Object_Pool * const pool = chunk->pool;
  61     Stack_Chunk_t * const new_chunk = (Stack_Chunk_t *)pool->get_free_object(interp, pool);
  62
  63     PObj_bufstart(new_chunk) = NULL;
  64     PObj_buflen(new_chunk)   = 0;
  65
  66     new_chunk->pool          = chunk->pool;
  67     new_chunk->name          = chunk->name;
  68
  69     return new_chunk;
  70 }
  71
  72 /*
  73
  74 =item C<Stack_Chunk_t * new_stack>
  75
  76 Create a new stack and name it. C<< stack->name >> is used for
  77 debugging/error reporting.
  78
  79 =cut
  80
  81 */
  82
  83 PARROT_API
  84 PARROT_CANNOT_RETURN_NULL
  85 PARROT_WARN_UNUSED_RESULT
  86 Stack_Chunk_t *
  87 new_stack(PARROT_INTERP, ARGIN(const char *name))
  88 {
  89     Small_Object_Pool * const pool = make_bufferlike_pool(interp, sizeof (Stack_Chunk_t));
  90     Stack_Chunk_t     * const chunk = (Stack_Chunk_t *)(pool->get_free_object)(interp, pool);
  91
  92     chunk->prev = chunk;        /* mark the top of the stack */
  93     chunk->name = name;
  94     chunk->pool = pool;         /* cache the pool pointer, for ease */
  95
  96     return chunk;
  97 }
  98
  99
 100 /*
 101
 102 =item C<void mark_stack>
 103
 104 Mark entries in a stack structure during DOD.
 105
 106 =cut
 107
 108 */
 109
 110 PARROT_API
 111 void
 112 mark_stack(PARROT_INTERP, ARGMOD(Stack_Chunk_t *chunk))
 113 {
 114     for (; ; chunk = chunk->prev) {
 115         Stack_Entry_t  *entry;
 116
 117         pobject_lives(interp, (PObj *)chunk);
 118
 119         if (chunk == chunk->prev)
 120             break;
 121
 122         entry = STACK_DATAP(chunk);
 123
 124         if (entry->entry_type == STACK_ENTRY_PMC && UVal_pmc(entry->entry))
 125             pobject_lives(interp, (PObj *)UVal_pmc(entry->entry));
 126     }
 127 }
 128
 129 /*
 130
 131 =item C<void stack_destroy>
 132
 133 stack_destroy() doesn't need to do anything, since GC does it all.
 134
 135 =cut
 136
 137 */
 138
 139 PARROT_API
 140 void
 141 stack_destroy(SHIM(Stack_Chunk_t *top))
 142 {
 143     /* GC does it all */
 144 }
 145
 146 /*
 147
 148 =item C<size_t stack_height>
 149
 150 Returns the height of the stack. The maximum "depth" is height - 1.
 151
 152 =cut
 153
 154 */
 155
 156 PARROT_API
 157 PARROT_WARN_UNUSED_RESULT
 158 size_t
 159 stack_height(SHIM_INTERP, ARGIN(const Stack_Chunk_t *chunk))
 160 {
 161     size_t height = 0;
 162
 163     for (; ; chunk = chunk->prev) {
 164         if (chunk == chunk->prev)
 165             break;
 166         ++height;
 167     }
 168
 169     return height;
 170 }
 171
 172
 173 /*
 174
 175 =item C<Stack_Entry_t * stack_entry>
 176
 177 If C<< depth >= 0 >>, return the entry at that depth from the top of the
 178 stack, with 0 being the top entry. If C<depth < 0>, then return the
 179 entry C<|depth|> entries from the bottom of the stack. Returns C<NULL>
 180 if C<|depth| > number> of entries in stack.
 181
 182 =cut
 183
 184 */
 185
 186 PARROT_API
 187 PARROT_CAN_RETURN_NULL
 188 PARROT_WARN_UNUSED_RESULT
 189 Stack_Entry_t *
 190 stack_entry(PARROT_INTERP, ARGIN(Stack_Chunk_t *stack), INTVAL depth)
 191 {
 192     Stack_Chunk_t *chunk;
 193     size_t         offset = (size_t)depth;
 194
 195     if (depth < 0)
 196         return NULL;
 197
 198     /* Start at top */
 199     chunk = stack;
 200
 201     while (offset) {
 202         if (chunk == chunk->prev)
 203             break;
 204         --offset;
 205         chunk = chunk->prev;
 206     }
 207
 208     if (chunk == chunk->prev)
 209         return NULL;
 210
 211     return STACK_DATAP(chunk);
 212 }
 213
 214 /*
 215
 216 =item C<void rotate_entries>
 217
 218 Rotate the top N entries by one.  If C<< N > 0 >>, the rotation is bubble
 219 up, so the top most element becomes the Nth element.  If C<< N < 0 >>, the
 220 rotation is bubble down, so that the Nth element becomes the top most
 221 element.
 222
 223 */
 224
 225 PARROT_API
 226 void
 227 rotate_entries(PARROT_INTERP, ARGMOD(Stack_Chunk_t **stack_p), INTVAL num_entries)
 228 {
 229     Stack_Chunk_t * const stack = *stack_p;
 230
 231     if (num_entries >= -1 && num_entries <= 1) {
 232         return;
 233     }
 234
 235     if (num_entries < 0) {
 236         INTVAL i;
 237         Stack_Entry_t temp;
 238         INTVAL depth;
 239
 240         num_entries = -num_entries;
 241         depth = num_entries - 1;
 242
 243         if (stack_height(interp, stack) < (size_t)num_entries) {
 244             real_exception(interp, NULL, ERROR_STACK_SHALLOW, "Stack too shallow!");
 245         }
 246
 247         /* XXX Dereferencing stack_entry here is a cavalcade of danger */
 248         temp = *stack_entry(interp, stack, depth);
 249         for (i = depth; i > 0; i--) {
 250             *stack_entry(interp, stack, i) =
 251                 *stack_entry(interp, stack, i - 1);
 252         }
 253
 254         *stack_entry(interp, stack, 0) = temp;
 255     }
 256     else {
 257         INTVAL i;
 258         Stack_Entry_t temp;
 259         INTVAL depth = num_entries - 1;
 260
 261         if (stack_height(interp, stack) < (size_t)num_entries) {
 262             real_exception(interp, NULL, ERROR_STACK_SHALLOW, "Stack too shallow!");
 263         }
 264         /* XXX Dereferencing stack_entry here is a cavalcade of danger */
 265         temp = *stack_entry(interp, stack, 0);
 266         for (i = 0; i < depth; i++) {
 267             *stack_entry(interp, stack, i) =
 268                 *stack_entry(interp, stack, i + 1);
 269         }
 270
 271         *stack_entry(interp, stack, depth) = temp;
 272     }
 273 }
 274
 275 /*
 276
 277 =item C<Stack_Entry_t* stack_prepare_push>
 278
 279 Return a pointer, where new entries go for push.
 280
 281 =cut
 282
 283 */
 284
 285 PARROT_API
 286 PARROT_WARN_UNUSED_RESULT
 287 PARROT_CANNOT_RETURN_NULL
 288 Stack_Entry_t*
 289 stack_prepare_push(PARROT_INTERP, ARGMOD(Stack_Chunk_t **stack_p))
 290 {
 291     Stack_Chunk_t * const chunk     = *stack_p;
 292     Stack_Chunk_t * const new_chunk = cst_new_stack_chunk(interp, chunk);
 293
 294     new_chunk->prev = chunk;
 295     *stack_p        = new_chunk;
 296
 297     return STACK_DATAP(new_chunk);
 298 }
 299
 300 /*
 301
 302 =item C<void stack_push>
 303
 304 Push something on the generic stack.
 305
 306 Note that the cleanup pointer, if non-C<NULL>, points to a routine
 307 that'll be called when the entry is removed from the stack. This is
 308 handy for those cases where you need some sort of activity to take place
 309 when an entry is removed, such as when you push a lexical lock onto the
 310 call stack, or localize (or tempify, or whatever we're calling it)
 311 variable or something.
 312
 313 */
 314
 315 PARROT_API
 316 void
 317 stack_push(PARROT_INTERP, ARGMOD(Stack_Chunk_t **stack_p),
 318            ARGIN(void *thing), Stack_entry_type type, NULLOK(Stack_cleanup_method cleanup))
 319 {
 320     Stack_Entry_t * const entry = (Stack_Entry_t *)stack_prepare_push(interp, stack_p);
 321
 322     /* Remember the type */
 323     entry->entry_type = type;
 324
 325     /* Remember the cleanup function */
 326     entry->cleanup = cleanup;
 327
 328     /* Store our thing */
 329     switch (type) {
 330         case STACK_ENTRY_MARK:
 331             UVal_int(entry->entry) = *(INTVAL *)thing;
 332             break;
 333         case STACK_ENTRY_DESTINATION:
 334             UVal_ptr(entry->entry) = thing;
 335             break;
 336         case STACK_ENTRY_ACTION:
 337         case STACK_ENTRY_PMC:
 338             UVal_pmc(entry->entry) = (PMC *)thing;
 339             break;
 340         default:
 341             real_exception(interp, NULL, ERROR_BAD_STACK_TYPE,
 342                     "Invalid Stack_Entry_type!");
 343     }
 344 }
 345
 346 /*
 347
 348 =item C<Stack_Entry_t* stack_prepare_pop>
 349
 350 Return a pointer, where new entries are popped off.
 351
 352 =cut
 353
 354 */
 355
 356 PARROT_API
 357 PARROT_WARN_UNUSED_RESULT
 358 PARROT_CANNOT_RETURN_NULL
 359 Stack_Entry_t*
 360 stack_prepare_pop(PARROT_INTERP, ARGMOD(Stack_Chunk_t **stack_p))
 361 {
 362     Stack_Chunk_t * const chunk = *stack_p;
 363
 364     /* the first entry (initial top) refers to itself */
 365     if (chunk == chunk->prev)
 366         real_exception(interp, NULL, ERROR_STACK_EMPTY,
 367             "No entries on %s Stack!", chunk->name);
 368
 369     *stack_p = chunk->prev;
 370
 371     return STACK_DATAP(chunk);
 372 }
 373
 374 /*
 375
 376 =item C<void * stack_pop>
 377
 378 Pop off an entry and return a pointer to the contents.
 379
 380 */
 381
 382 PARROT_API
 383 PARROT_CAN_RETURN_NULL
 384 void *
 385 stack_pop(PARROT_INTERP, ARGMOD(Stack_Chunk_t **stack_p),
 386           ARGOUT_NULLOK(void *where), Stack_entry_type type)
 387 {
 388     Stack_Chunk_t     *cur_chunk   = *stack_p;
 389     Stack_Entry_t * const entry    =
 390         (Stack_Entry_t *)stack_prepare_pop(interp, stack_p);
 391
 392     /* Types of 0 mean we don't care */
 393     if (type && entry->entry_type != type) {
 394         real_exception(interp, NULL, ERROR_BAD_STACK_TYPE,
 395                            "Wrong type on top of stack!\n");
 396     }
 397
 398     /* Cleanup routine? */
 399     if (entry->cleanup != STACK_CLEANUP_NULL)
 400         (*entry->cleanup) (interp, entry);
 401
 402     /* Sometimes the caller cares what the value was */
 403     if (where) {
 404         /* Snag the value */
 405         switch (type) {
 406         case STACK_ENTRY_MARK:
 407             *(INTVAL *)where   = UVal_int(entry->entry);
 408             break;
 409         case STACK_ENTRY_DESTINATION:
 410             *(void **)where    = UVal_ptr(entry->entry);
 411             break;
 412         case STACK_ENTRY_ACTION:
 413         case STACK_ENTRY_PMC:
 414             *(PMC **)where     = UVal_pmc(entry->entry);
 415             break;
 416         default:
 417             real_exception(interp, NULL, ERROR_BAD_STACK_TYPE,
 418                                "Wrong type on top of stack!\n");
 419         }
 420     }
 421
 422     /* recycle this chunk to the free list if it's otherwise unreferenced */
 423     if (cur_chunk->refcount <= 0) {
 424         Small_Object_Pool * const pool = cur_chunk->pool;
 425
 426         pool->dod_object(interp, pool, (PObj *)cur_chunk);
 427         pool->add_free_object(interp, pool, (PObj *)cur_chunk);
 428     }
 429
 430     return where;
 431 }
 432
 433 /*
 434
 435 =item C<void * pop_dest>
 436
 437 Pop off a destination entry and return a pointer to the contents.
 438
 439 =cut
 440
 441 */
 442
 443 PARROT_API
 444 PARROT_WARN_UNUSED_RESULT
 445 PARROT_CANNOT_RETURN_NULL
 446 void *
 447 pop_dest(PARROT_INTERP)
 448 {
 449     /* We don't mind the extra call, so we do this: (previous comment
 450      * said we *do* mind, but I say let the compiler decide) */
 451     void *dest;
 452     (void)stack_pop(interp, &interp->dynamic_env,
 453                     &dest, STACK_ENTRY_DESTINATION);
 454     return dest;
 455 }
 456
 457 /*
 458
 459 =item C<void * stack_peek>
 460
 461 Peek at stack and return pointer to entry and the type of the entry.
 462
 463 =cut
 464
 465 */
 466
 467 PARROT_API
 468 PARROT_CAN_RETURN_NULL
 469 PARROT_WARN_UNUSED_RESULT
 470 void *
 471 stack_peek(PARROT_INTERP, ARGIN(Stack_Chunk_t *stack_base),
 472            ARGMOD_NULLOK(Stack_entry_type *type))
 473 {
 474     const Stack_Entry_t * const entry = stack_entry(interp, stack_base, 0);
 475     if (entry == NULL)
 476         return NULL;
 477
 478     if (type != NULL)
 479         *type = entry->entry_type;
 480
 481     if (entry->entry_type == STACK_ENTRY_DESTINATION)
 482         return UVal_ptr(entry->entry);
 483
 484     return (void *) UVal_pmc(entry->entry);
 485 }
 486
 487 /*
 488
 489 =item C<Stack_entry_type get_entry_type>
 490
 491 Returns the stack entry type of C<entry>.
 492
 493 =cut
 494
 495 */
 496
 497 PARROT_WARN_UNUSED_RESULT
 498 PARROT_PURE_FUNCTION
 499 Stack_entry_type
 500 get_entry_type(ARGIN(const Stack_Entry_t *entry))
 501 {
 502     return entry->entry_type;
 503 }
 504
 505 /*
 506
 507 =item C<void Parrot_dump_dynamic_environment>
 508
 509 Print a representation of the dynamic stack to the standard error (using
 510 C<PIO_eprintf>).  This is used only temporarily for debugging.
 511
 512 =cut
 513
 514 */
 515
 516 PARROT_API
 517 void
 518 Parrot_dump_dynamic_environment(PARROT_INTERP, ARGIN(Stack_Chunk_t *dynamic_env))
 519 {
 520     int height = (int) stack_height(interp, dynamic_env);
 521
 522     while (dynamic_env->prev != dynamic_env) {
 523         const Stack_Entry_t * const e = stack_entry(interp, dynamic_env, 0);
 524         if (! e) {
 525             real_exception(interp, NULL, 1, "Control stack damaged");
 526         }
 527
 528         PIO_eprintf(interp, "[%4d:  chunk %p entry %p "
 529                                  "type %d cleanup %p]\n",
 530                     height, dynamic_env, e,
 531                     e->entry_type, e->cleanup);
 532         if (e->entry_type == STACK_ENTRY_PMC
 533                 || e->entry_type == STACK_ENTRY_ACTION) {
 534             PMC * const thing = UVal_pmc(e->entry);
 535
 536             PIO_eprintf(interp, "[        PMC %p type %d => %Ss]\n",
 537                         thing, thing->vtable->base_type,
 538                         VTABLE_get_string(interp, thing));
 539         }
 540         else if (e->entry_type == STACK_ENTRY_MARK) {
 541             PIO_eprintf(interp, "[        mark %d]\n",
 542                         UVal_int(e->entry));
 543         }
 544         dynamic_env = dynamic_env->prev;
 545         height--;
 546     }
 547     PIO_eprintf(interp, "[%4d:  chunk %p %s base]\n",
 548                 height, dynamic_env, dynamic_env->name);
 549 }
 550
 551 /*
 552
 553 =back
 554
 555 =head1 SEE ALSO
 556
 557 F<include/parrot/stacks.h> and F<include/parrot/enums.h>.
 558
 559 =cut
 560
 561 */
 562
 563
 564 /*
 565  * Local variables:
 566  *   c-file-style: "parrot"
 567  * End:
 568  * vim: expandtab shiftwidth=4:
 569  */