src/extend.c

   1 /*
   2 Copyright (C) 2001-2007, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/extend.c - Parrot extension interface
   8
   9 =head1 DESCRIPTION
  10
  11 These are the functions that parrot extensions (i.e. parrot subroutines
  12 written in C, or some other compiled language, rather than in parrot
  13 bytecode) may access.
  14
  15 There is a deliberate distancing from the internals here. Don't go
  16 peeking inside -- you've as much access as bytecode does, but no more,
  17 so we can provide backwards compatibility for as long as we possibly
  18 can.
  19
  20 =head2 Functions
  21
  22 =over 4
  23
  24 =cut
  25
  26 */
  27
  28 /* Some internal notes. Parrot will die a horrible and bizarre death
  29    if the stack start pointer's not set and a GC run is
  30    triggered. The pointer *will* be set by the interpreter if the
  31    interpreter calls code which calls these functions, so most
  32    extension code is safe, no problem.
  33
  34    The problem comes in if these routines are called from *outside*
  35    an interpreter. This happens when an embedding application calls
  36    them to do stuff with PMCs, STRINGS, interpreter contents, and
  37    suchlike things. This is perfectly legal -- in fact it's what
  38    we've documented should be done -- but the problem is that the
  39    stack base pointer will be NULL. This is Very Bad.
  40
  41    To deal with this there are two macros that are defined to handle
  42    the problem.
  43
  44    PARROT_CALLIN_START(interp) will figure out if the stack
  45    anchor needs setting and, if so, will set it. It must *always*
  46    come immediately after the last variable declared in the block
  47    making the calls into the interpreter, as it declares a variable
  48    and has some code.
  49
  50    PARROT_CALLIN_END(interp) will put the stack anchor back to
  51    the way it was, and should always be the last statement before a
  52    return. (If you have multiple returns have it in multiple times)
  53
  54    Not doing this is a good way to introduce bizarre heisenbugs, so
  55    just do it. This is the only place they ought to have to be put
  56    in, and most of the functions are already written, so it's not
  57    like it's an onerous requirement.
  58
  59 */
  60
  61 #include "parrot/parrot.h"
  62 #include "parrot/extend.h"
  63 #include "pmc/pmc_sub.h"
  64 #include "pmc/pmc_context.h"
  65
  66 /* HEADERIZER HFILE: include/parrot/extend.h */
  67
  68 /*
  69
  70 =item C<int Parrot_vfprintf(PARROT_INTERP, Parrot_PMC pio, const char *s,
  71 va_list args)>
  72
  73 Writes a C string format with a varargs list to a PIO.
  74
  75 =item C<int Parrot_fprintf(PARROT_INTERP, Parrot_PMC pio, const char *s, ...)>
  76
  77 Writes a C string format with varargs to a PIO.
  78
  79 =item C<int Parrot_printf(NULLOK_INTERP, const char *s, ...)>
  80
  81 Writes a C string format with varargs to C<stdout>.
  82
  83 =item C<int Parrot_eprintf(NULLOK_INTERP, const char *s, ...)>
  84
  85 Writes a C string format with varargs to C<stderr>.
  86
  87 =cut
  88
  89 */
  90
  91 PARROT_EXPORT
  92 int
  93 Parrot_vfprintf(PARROT_INTERP, ARGIN(Parrot_PMC pio),
  94         ARGIN(const char *s), va_list args)
  95 {
  96     ASSERT_ARGS(Parrot_vfprintf)
  97     STRING * str;
  98     INTVAL retval;
  99
 100     PARROT_CALLIN_START(interp);
 101     str = Parrot_vsprintf_c(interp, s, args);
 102     retval = Parrot_io_putps(interp, pio, str);
 103     PARROT_CALLIN_END(interp);
 104
 105     return retval;
 106 }
 107
 108 PARROT_EXPORT
 109 int
 110 Parrot_fprintf(PARROT_INTERP, ARGIN(Parrot_PMC pio),
 111         ARGIN(const char *s), ...)
 112 {
 113     ASSERT_ARGS(Parrot_fprintf)
 114     va_list args;
 115     INTVAL retval;
 116
 117     va_start(args, s);
 118     retval = Parrot_vfprintf(interp, pio, s, args);
 119     va_end(args);
 120
 121     return retval;
 122 }
 123
 124 PARROT_EXPORT
 125 int
 126 Parrot_printf(NULLOK_INTERP, ARGIN(const char *s), ...)
 127 {
 128     ASSERT_ARGS(Parrot_printf)
 129     va_list args;
 130     INTVAL retval;
 131     va_start(args, s);
 132
 133     if (interp) {
 134         retval = Parrot_vfprintf(interp, Parrot_io_STDOUT(interp), s, args);
 135     }
 136     else {
 137         /* Be nice about this...
 138          **   XXX BD Should this use the default Parrot_io_STDOUT or something?
 139          */
 140         retval = vfprintf(stdout, s, args);
 141     }
 142     va_end(args);
 143
 144     return retval;
 145 }
 146
 147 PARROT_EXPORT
 148 int
 149 Parrot_eprintf(NULLOK_INTERP, ARGIN(const char *s), ...)
 150 {
 151     ASSERT_ARGS(Parrot_eprintf)
 152     va_list args;
 153     INTVAL retval;
 154
 155     va_start(args, s);
 156
 157     if (interp) {
 158         retval = Parrot_vfprintf(interp, Parrot_io_STDERR(interp), s, args);
 159     }
 160     else {
 161         /* Be nice about this...
 162          **   XXX BD Should this use the default Parrot_io_STDOUT or something?
 163          */
 164         retval=vfprintf(stderr, s, args);
 165     }
 166
 167     va_end(args);
 168
 169     return retval;
 170 }
 171
 172 /*
 173
 174 =item C<Parrot_PMC Parrot_get_root_namespace(PARROT_INTERP)>
 175
 176 Return the root namespace
 177
 178 =cut
 179
 180 */
 181
 182 PARROT_EXPORT
 183 Parrot_PMC
 184 Parrot_get_root_namespace(PARROT_INTERP)
 185 {
 186     ASSERT_ARGS(Parrot_get_root_namespace)
 187     return interp->root_namespace;
 188 }
 189
 190 /*
 191
 192 =item C<Parrot_String Parrot_PMC_get_string_intkey(PARROT_INTERP, Parrot_PMC
 193 pmc, Parrot_Int key)>
 194
 195 Return the integer keyed string value of the passed-in PMC
 196
 197 =cut
 198
 199 */
 200
 201 PARROT_EXPORT
 202 Parrot_String
 203 Parrot_PMC_get_string_intkey(PARROT_INTERP,
 204         Parrot_PMC pmc, Parrot_Int key)
 205 {
 206     ASSERT_ARGS(Parrot_PMC_get_string_intkey)
 207     Parrot_String retval;
 208     PARROT_CALLIN_START(interp);
 209     retval = VTABLE_get_string_keyed_int(interp, pmc, key);
 210     PARROT_CALLIN_END(interp);
 211     return retval;
 212 }
 213
 214
 215 /*
 216
 217 =item C<void * Parrot_PMC_get_pointer_intkey(PARROT_INTERP, Parrot_PMC pmc,
 218 Parrot_Int key)>
 219
 220 Return a pointer to the PMC indicated by an integer key.
 221
 222 =cut
 223
 224 */
 225
 226 PARROT_EXPORT
 227 PARROT_WARN_UNUSED_RESULT
 228 PARROT_CAN_RETURN_NULL
 229 void *
 230 Parrot_PMC_get_pointer_intkey(PARROT_INTERP,
 231         Parrot_PMC pmc, Parrot_Int key)
 232 {
 233     ASSERT_ARGS(Parrot_PMC_get_pointer_intkey)
 234     void *retval;
 235     PARROT_CALLIN_START(interp);
 236     retval = VTABLE_get_pointer_keyed_int(interp, pmc, key);
 237     PARROT_CALLIN_END(interp);
 238     return retval;
 239 }
 240
 241 /*
 242
 243 =item C<Parrot_PMC Parrot_PMC_get_pmc_intkey(PARROT_INTERP, Parrot_PMC pmc,
 244 Parrot_Int key)>
 245
 246 Return the integer keyed PMC value of the passed-in PMC
 247
 248 =cut
 249
 250 */
 251
 252 PARROT_EXPORT
 253 Parrot_PMC
 254 Parrot_PMC_get_pmc_intkey(PARROT_INTERP,
 255         Parrot_PMC pmc, Parrot_Int key)
 256 {
 257     ASSERT_ARGS(Parrot_PMC_get_pmc_intkey)
 258     Parrot_PMC retval;
 259     PARROT_CALLIN_START(interp);
 260     retval = VTABLE_get_pmc_keyed_int(interp, pmc, key);
 261     PARROT_CALLIN_END(interp);
 262     return retval;
 263 }
 264
 265 /*
 266
 267 =item C<Parrot_PMC Parrot_PMC_get_pmc_strkey(PARROT_INTERP, Parrot_PMC pmc,
 268 Parrot_String key)>
 269
 270 Return the string keyed PMC value of the passed-in PMC
 271
 272 =cut
 273
 274 */
 275
 276 PARROT_EXPORT
 277 Parrot_PMC
 278 Parrot_PMC_get_pmc_strkey(PARROT_INTERP,
 279         Parrot_PMC pmc, Parrot_String key)
 280 {
 281     ASSERT_ARGS(Parrot_PMC_get_pmc_strkey)
 282     Parrot_PMC retval;
 283     PARROT_CALLIN_START(interp);
 284     retval = VTABLE_get_pmc_keyed_str(interp, pmc, key);
 285     PARROT_CALLIN_END(interp);
 286     return retval;
 287 }
 288
 289 /*
 290
 291 =item C<Parrot_Int Parrot_PMC_get_intval(PARROT_INTERP, Parrot_PMC pmc)>
 292
 293 Return the signed integer value of the value in the PMC.
 294
 295 =cut
 296
 297 */
 298
 299 PARROT_EXPORT
 300 Parrot_Int
 301 Parrot_PMC_get_intval(PARROT_INTERP, Parrot_PMC pmc)
 302 {
 303     ASSERT_ARGS(Parrot_PMC_get_intval)
 304     Parrot_Int retval;
 305     PARROT_CALLIN_START(interp);
 306     retval = VTABLE_get_integer(interp, pmc);
 307     PARROT_CALLIN_END(interp);
 308     return retval;
 309 }
 310
 311 /*
 312
 313 =item C<Parrot_Int Parrot_PMC_get_intval_intkey(PARROT_INTERP, Parrot_PMC pmc,
 314 Parrot_Int key)>
 315
 316 Return the keyed, signed integer value of the value in the PMC.
 317
 318 =cut
 319
 320 */
 321
 322 PARROT_EXPORT
 323 Parrot_Int
 324 Parrot_PMC_get_intval_intkey(PARROT_INTERP,
 325         Parrot_PMC pmc, Parrot_Int key)
 326 {
 327     ASSERT_ARGS(Parrot_PMC_get_intval_intkey)
 328     Parrot_Int retval;
 329     PARROT_CALLIN_START(interp);
 330     retval = VTABLE_get_integer_keyed_int(interp, pmc, key);
 331     PARROT_CALLIN_END(interp);
 332     return retval;
 333 }
 334
 335 /*
 336
 337 =item C<Parrot_Int Parrot_PMC_get_intval_pmckey(PARROT_INTERP, Parrot_PMC pmc,
 338 Parrot_PMC key)>
 339
 340 Return the keyed, signed integer value of the value in the PMC.
 341
 342 =cut
 343
 344 */
 345
 346 PARROT_EXPORT
 347 Parrot_Int
 348 Parrot_PMC_get_intval_pmckey(PARROT_INTERP,
 349         Parrot_PMC pmc, Parrot_PMC key)
 350 {
 351     ASSERT_ARGS(Parrot_PMC_get_intval_pmckey)
 352     Parrot_Int retval;
 353     PARROT_CALLIN_START(interp);
 354     retval = VTABLE_get_integer_keyed(interp, pmc, key);
 355     PARROT_CALLIN_END(interp);
 356     return retval;
 357 }
 358
 359 /*
 360
 361 =item C<Parrot_Float Parrot_PMC_get_numval(PARROT_INTERP, Parrot_PMC pmc)>
 362
 363 Return the floating-point value of the PMC.
 364
 365 =cut
 366
 367 */
 368
 369 PARROT_EXPORT
 370 Parrot_Float
 371 Parrot_PMC_get_numval(PARROT_INTERP, Parrot_PMC pmc)
 372 {
 373     ASSERT_ARGS(Parrot_PMC_get_numval)
 374     Parrot_Float retval;
 375     PARROT_CALLIN_START(interp);
 376     retval = VTABLE_get_number(interp, pmc);
 377     PARROT_CALLIN_END(interp);
 378     return retval;
 379 }
 380
 381 /*
 382
 383 =item C<Parrot_Float Parrot_PMC_get_numval_intkey(PARROT_INTERP, Parrot_PMC pmc,
 384 Parrot_Int key)>
 385
 386 Return the keyed, signed integer value of the value in the PMC.
 387
 388 =cut
 389
 390 */
 391
 392 PARROT_EXPORT
 393 Parrot_Float
 394 Parrot_PMC_get_numval_intkey(PARROT_INTERP,
 395         Parrot_PMC pmc, Parrot_Int key)
 396 {
 397     ASSERT_ARGS(Parrot_PMC_get_numval_intkey)
 398     Parrot_Float retval;
 399     PARROT_CALLIN_START(interp);
 400     retval = VTABLE_get_number_keyed_int(interp, pmc, key);
 401     PARROT_CALLIN_END(interp);
 402     return retval;
 403 }
 404
 405 /*
 406
 407 =item C<char * Parrot_PMC_get_cstring_intkey(PARROT_INTERP, Parrot_PMC pmc,
 408 Parrot_Int key)>
 409
 410 Return a null-terminated string that represents the string value of the PMC.
 411
 412 Note that you must free this string with C<Parrot_str_free_cstring()>!
 413
 414 =cut
 415
 416 */
 417
 418 PARROT_EXPORT
 419 PARROT_MALLOC
 420 PARROT_CAN_RETURN_NULL
 421 char *
 422 Parrot_PMC_get_cstring_intkey(PARROT_INTERP,
 423         Parrot_PMC pmc, Parrot_Int key)
 424 {
 425     ASSERT_ARGS(Parrot_PMC_get_cstring_intkey)
 426     STRING *intermediate;
 427     char   *retval;
 428
 429     PARROT_CALLIN_START(interp);
 430     intermediate = VTABLE_get_string_keyed_int(interp, pmc, key);
 431     retval       = Parrot_str_to_cstring(interp, intermediate);
 432     PARROT_CALLIN_END(interp);
 433
 434     return retval;
 435 }
 436
 437 /*
 438
 439 =item C<char * Parrot_PMC_get_cstring(PARROT_INTERP, Parrot_PMC pmc)>
 440
 441 Return a null-terminated string that represents the string value of the PMC.
 442
 443 Note that you must free this string with C<Parrot_str_free_cstring()>!
 444
 445 =cut
 446
 447 */
 448
 449 PARROT_EXPORT
 450 PARROT_MALLOC
 451 PARROT_CAN_RETURN_NULL
 452 char *
 453 Parrot_PMC_get_cstring(PARROT_INTERP, Parrot_PMC pmc)
 454 {
 455     ASSERT_ARGS(Parrot_PMC_get_cstring)
 456     STRING *intermediate;
 457     char   *retval;
 458
 459     PARROT_CALLIN_START(interp);
 460     intermediate = VTABLE_get_string(interp, pmc);
 461     retval       = Parrot_str_to_cstring(interp, intermediate);
 462     PARROT_CALLIN_END(interp);
 463
 464     return retval;
 465 }
 466
 467 /*
 468
 469 =item C<char * Parrot_PMC_get_cstringn(PARROT_INTERP, Parrot_PMC pmc, Parrot_Int
 470 *length)>
 471
 472 Return a null-terminated string for the PMC, along with the length.
 473
 474 Yes, right now this is a bit of a cheat. It needs fixing, but without
 475 disturbing the interface.
 476
 477 Note that you must free the string with C<Parrot_str_free_cstring()>.
 478
 479 =cut
 480
 481 */
 482
 483 PARROT_EXPORT
 484 PARROT_MALLOC
 485 PARROT_CAN_RETURN_NULL
 486 char *
 487 Parrot_PMC_get_cstringn(PARROT_INTERP, ARGIN(Parrot_PMC pmc),
 488         ARGOUT(Parrot_Int *length))
 489 {
 490     ASSERT_ARGS(Parrot_PMC_get_cstringn)
 491     char *retval;
 492
 493     PARROT_CALLIN_START(interp);
 494     retval  = Parrot_str_to_cstring(interp, VTABLE_get_string(interp, pmc));
 495     *length = strlen(retval);
 496     PARROT_CALLIN_END(interp);
 497
 498     return retval;
 499 }
 500
 501 /*
 502
 503 =item C<char * Parrot_PMC_get_cstringn_intkey(PARROT_INTERP, Parrot_PMC pmc,
 504 Parrot_Int *length, Parrot_Int key)>
 505
 506 Return a null-terminated string for the PMC, along with the length.
 507
 508 Yes, right now this is a bit of a cheat. It needs fixing, but without
 509 disturbing the interface.
 510
 511 Note that you must free this string with C<Parrot_str_free_cstring()>.
 512
 513 =cut
 514
 515 */
 516
 517 PARROT_EXPORT
 518 PARROT_MALLOC
 519 PARROT_CAN_RETURN_NULL
 520 char *
 521 Parrot_PMC_get_cstringn_intkey(PARROT_INTERP, ARGIN(Parrot_PMC pmc),
 522         ARGOUT(Parrot_Int *length), Parrot_Int key)
 523 {
 524     ASSERT_ARGS(Parrot_PMC_get_cstringn_intkey)
 525     char *retval;
 526
 527     PARROT_CALLIN_START(interp);
 528     retval  = Parrot_str_to_cstring(interp,
 529                                VTABLE_get_string_keyed_int(interp, pmc, key));
 530     *length = strlen(retval);
 531     PARROT_CALLIN_END(interp);
 532
 533     return retval;
 534 }
 535
 536 /*
 537
 538 =item C<void Parrot_PMC_set_string(PARROT_INTERP, Parrot_PMC pmc, Parrot_String
 539 value)>
 540
 541 Assign the passed-in Parrot string to the passed-in PMC.
 542
 543 =cut
 544
 545 */
 546
 547 PARROT_EXPORT
 548 void
 549 Parrot_PMC_set_string(PARROT_INTERP,
 550         Parrot_PMC pmc, Parrot_String value)
 551 {
 552     ASSERT_ARGS(Parrot_PMC_set_string)
 553     PARROT_CALLIN_START(interp);
 554     VTABLE_set_string_native(interp, pmc, value);
 555     PARROT_CALLIN_END(interp);
 556 }
 557
 558 /*
 559
 560 =item C<void Parrot_PMC_set_string_intkey(PARROT_INTERP, Parrot_PMC pmc,
 561 Parrot_Int key, Parrot_String value)>
 562
 563 Assign the passed-in Parrot string to the passed-in PMC.
 564
 565 =cut
 566
 567 */
 568
 569 PARROT_EXPORT
 570 void
 571 Parrot_PMC_set_string_intkey(PARROT_INTERP,
 572         Parrot_PMC pmc, Parrot_Int key, Parrot_String value)
 573 {
 574     ASSERT_ARGS(Parrot_PMC_set_string_intkey)
 575     PARROT_CALLIN_START(interp);
 576     VTABLE_set_string_keyed_int(interp, pmc, key, value);
 577     PARROT_CALLIN_END(interp);
 578 }
 579
 580 /*
 581
 582 =item C<void Parrot_PMC_set_pmc_intkey(PARROT_INTERP, Parrot_PMC pmc, Parrot_Int
 583 key, Parrot_PMC value)>
 584
 585 Assign the passed-in pmc to the passed-in slot of the passed-in PMC.
 586
 587 =cut
 588
 589 */
 590
 591 PARROT_EXPORT
 592 void
 593 Parrot_PMC_set_pmc_intkey(PARROT_INTERP,
 594         Parrot_PMC pmc, Parrot_Int key, Parrot_PMC value)
 595 {
 596     ASSERT_ARGS(Parrot_PMC_set_pmc_intkey)
 597     PARROT_CALLIN_START(interp);
 598     VTABLE_set_pmc_keyed_int(interp, pmc, key, value);
 599     PARROT_CALLIN_END(interp);
 600 }
 601
 602 /*
 603
 604 =item C<void Parrot_PMC_set_pmc_strkey(PARROT_INTERP, Parrot_PMC pmc,
 605 Parrot_String key, Parrot_PMC value)>
 606
 607 Assign the passed-in pmc to the passed-in slot of the passed-in PMC.
 608
 609 =cut
 610
 611 */
 612
 613 PARROT_EXPORT
 614 void
 615 Parrot_PMC_set_pmc_strkey(PARROT_INTERP,
 616         Parrot_PMC pmc, Parrot_String key, Parrot_PMC value)
 617 {
 618     ASSERT_ARGS(Parrot_PMC_set_pmc_strkey)
 619     PARROT_CALLIN_START(interp);
 620     VTABLE_set_pmc_keyed_str(interp, pmc, key, value);
 621     PARROT_CALLIN_END(interp);
 622 }
 623
 624 /*
 625
 626 =item C<void Parrot_PMC_set_pmc_pmckey(PARROT_INTERP, Parrot_PMC pmc, Parrot_PMC
 627 key, Parrot_PMC value)>
 628
 629 Assign the passed-in pmc to the passed-in slot of the passed-in PMC.
 630
 631 =cut
 632
 633 */
 634
 635 PARROT_EXPORT
 636 void
 637 Parrot_PMC_set_pmc_pmckey(PARROT_INTERP,
 638         Parrot_PMC pmc, Parrot_PMC key, Parrot_PMC value)
 639 {
 640     ASSERT_ARGS(Parrot_PMC_set_pmc_pmckey)
 641     PARROT_CALLIN_START(interp);
 642     VTABLE_set_pmc_keyed(interp, pmc, key, value);
 643     PARROT_CALLIN_END(interp);
 644 }
 645
 646 /*
 647
 648 =item C<void Parrot_PMC_set_pointer_intkey(PARROT_INTERP, Parrot_PMC pmc,
 649 Parrot_Int key, void *value)>
 650
 651 Assign the passed-in pointer to the passed-in PMC.
 652
 653 =cut
 654
 655 */
 656
 657 PARROT_EXPORT
 658 void
 659 Parrot_PMC_set_pointer_intkey(PARROT_INTERP,
 660         ARGIN(Parrot_PMC pmc), Parrot_Int key, ARGIN_NULLOK(void *value))
 661 {
 662     ASSERT_ARGS(Parrot_PMC_set_pointer_intkey)
 663     PARROT_CALLIN_START(interp);
 664     VTABLE_set_pointer_keyed_int(interp, pmc, key, value);
 665     PARROT_CALLIN_END(interp);
 666 }
 667
 668 /*
 669
 670 =item C<void Parrot_PMC_set_intval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Int
 671 value)>
 672
 673 Assign the passed-in Parrot integer to the passed-in PMC.
 674
 675 =cut
 676
 677 */
 678
 679 PARROT_EXPORT
 680 void
 681 Parrot_PMC_set_intval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Int value)
 682 {
 683     ASSERT_ARGS(Parrot_PMC_set_intval)
 684     PARROT_CALLIN_START(interp);
 685     VTABLE_set_integer_native(interp, pmc, value);
 686     PARROT_CALLIN_END(interp);
 687 }
 688
 689 /*
 690
 691 =item C<void Parrot_PMC_set_intval_intkey(PARROT_INTERP, Parrot_PMC pmc,
 692 Parrot_Int key, Parrot_Int value)>
 693
 694 Assign the passed-in Parrot integer to the passed-in PMC.
 695
 696 =cut
 697
 698 */
 699
 700 PARROT_EXPORT
 701 void
 702 Parrot_PMC_set_intval_intkey(PARROT_INTERP,
 703         Parrot_PMC pmc, Parrot_Int key, Parrot_Int value)
 704 {
 705     ASSERT_ARGS(Parrot_PMC_set_intval_intkey)
 706     PARROT_CALLIN_START(interp);
 707     VTABLE_set_integer_keyed_int(interp, pmc, key, value);
 708     PARROT_CALLIN_END(interp);
 709 }
 710
 711 /*
 712
 713 =item C<void Parrot_PMC_set_numval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Float
 714 value)>
 715
 716 Assign the passed-in Parrot number to the passed-in PMC.
 717
 718 =cut
 719
 720 */
 721
 722 PARROT_EXPORT
 723 void
 724 Parrot_PMC_set_numval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Float value)
 725 {
 726     ASSERT_ARGS(Parrot_PMC_set_numval)
 727     PARROT_CALLIN_START(interp);
 728     VTABLE_set_number_native(interp, pmc, value);
 729     PARROT_CALLIN_END(interp);
 730 }
 731
 732 /*
 733
 734 =item C<void Parrot_PMC_set_numval_intkey(PARROT_INTERP, Parrot_PMC pmc,
 735 Parrot_Int key, Parrot_Float value)>
 736
 737 Assign the passed-in Parrot number to the passed-in PMC.
 738
 739 =cut
 740
 741 */
 742
 743 PARROT_EXPORT
 744 void
 745 Parrot_PMC_set_numval_intkey(PARROT_INTERP,
 746         Parrot_PMC pmc, Parrot_Int key, Parrot_Float value)
 747 {
 748     ASSERT_ARGS(Parrot_PMC_set_numval_intkey)
 749     PARROT_CALLIN_START(interp);
 750     VTABLE_set_number_keyed_int(interp, pmc, key, value);
 751     PARROT_CALLIN_END(interp);
 752 }
 753
 754 /*
 755
 756 =item C<void Parrot_PMC_set_cstring(PARROT_INTERP, Parrot_PMC pmc, const char
 757 *value)>
 758
 759 Assign the passed-in null-terminated C string to the passed-in PMC.
 760
 761 =cut
 762
 763 */
 764
 765 PARROT_EXPORT
 766 void
 767 Parrot_PMC_set_cstring(PARROT_INTERP, Parrot_PMC pmc, ARGIN_NULLOK(const char *value))
 768 {
 769     ASSERT_ARGS(Parrot_PMC_set_cstring)
 770     PARROT_CALLIN_START(interp);
 771     VTABLE_set_string_native(interp, pmc,
 772                              Parrot_str_new(interp, value, 0));
 773     PARROT_CALLIN_END(interp);
 774 }
 775
 776 /*
 777
 778 =item C<void Parrot_PMC_set_cstring_intkey(PARROT_INTERP, Parrot_PMC pmc,
 779 Parrot_Int key, const char *value)>
 780
 781 Assign the passed-in null-terminated C string to the passed-in PMC.
 782
 783 =cut
 784
 785 */
 786
 787 PARROT_EXPORT
 788 void
 789 Parrot_PMC_set_cstring_intkey(PARROT_INTERP,
 790         Parrot_PMC pmc, Parrot_Int key, ARGIN_NULLOK(const char *value))
 791 {
 792     ASSERT_ARGS(Parrot_PMC_set_cstring_intkey)
 793     PARROT_CALLIN_START(interp);
 794     VTABLE_set_string_keyed_int(interp, pmc, key,
 795                                 Parrot_str_new(interp, value, 0));
 796     PARROT_CALLIN_END(interp);
 797 }
 798
 799 /*
 800
 801 =item C<void Parrot_PMC_set_cstringn(PARROT_INTERP, Parrot_PMC pmc, const char
 802 *value, Parrot_UInt length)>
 803
 804 Assign the passed-in length-noted string to the passed-in PMC.
 805
 806 =cut
 807
 808 */
 809
 810 PARROT_EXPORT
 811 void
 812 Parrot_PMC_set_cstringn(PARROT_INTERP,
 813         Parrot_PMC pmc, ARGIN_NULLOK(const char *value), Parrot_UInt length)
 814 {
 815     ASSERT_ARGS(Parrot_PMC_set_cstringn)
 816     PARROT_CALLIN_START(interp);
 817     VTABLE_set_string_native(interp, pmc,
 818                              Parrot_str_new(interp, value, length));
 819     PARROT_CALLIN_END(interp);
 820 }
 821
 822 /*
 823
 824 =item C<void Parrot_PMC_push_intval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Int
 825 value)>
 826
 827 Push the passed-in Parrot integer onto the passed in PMC
 828
 829 =cut
 830
 831 */
 832
 833 PARROT_EXPORT
 834 void
 835 Parrot_PMC_push_intval(PARROT_INTERP,
 836         Parrot_PMC pmc, Parrot_Int value)
 837 {
 838     ASSERT_ARGS(Parrot_PMC_push_intval)
 839     PARROT_CALLIN_START(interp);
 840     VTABLE_push_integer(interp, pmc, value);
 841     PARROT_CALLIN_END(interp);
 842 }
 843
 844 /*
 845
 846 =item C<void Parrot_PMC_push_numval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Float
 847 value)>
 848
 849 Push the passed-in Parrot number onto the passed in PMC
 850
 851 =cut
 852
 853 */
 854
 855 PARROT_EXPORT
 856 void
 857 Parrot_PMC_push_numval(PARROT_INTERP, Parrot_PMC pmc, Parrot_Float value)
 858 {
 859     ASSERT_ARGS(Parrot_PMC_push_numval)
 860     PARROT_CALLIN_START(interp);
 861     VTABLE_push_float(interp, pmc, value);
 862     PARROT_CALLIN_END(interp);
 863 }
 864
 865 /*
 866
 867 =item C<void Parrot_PMC_push_pmcval(PARROT_INTERP, Parrot_PMC pmc, Parrot_PMC
 868 value)>
 869
 870 Push the passed-in Parrot PMC onto the passed in PMC
 871
 872 =cut
 873
 874 */
 875
 876 PARROT_EXPORT
 877 void
 878 Parrot_PMC_push_pmcval(PARROT_INTERP, Parrot_PMC pmc, Parrot_PMC value)
 879 {
 880     ASSERT_ARGS(Parrot_PMC_push_pmcval)
 881     PARROT_CALLIN_START(interp);
 882     VTABLE_push_pmc(interp, pmc, value);
 883     PARROT_CALLIN_END(interp);
 884 }
 885
 886 /*
 887
 888 =item C<void Parrot_PMC_delete_pmckey(PARROT_INTERP, Parrot_PMC pmc, Parrot_PMC
 889 key)>
 890
 891 Deletes the value associated with the passed-in PMC from the PMC.
 892
 893 =cut
 894
 895 */
 896
 897 PARROT_EXPORT
 898 void
 899 Parrot_PMC_delete_pmckey(PARROT_INTERP, Parrot_PMC pmc, Parrot_PMC key)
 900 {
 901     ASSERT_ARGS(Parrot_PMC_delete_pmckey)
 902     PARROT_CALLIN_START(interp);
 903     VTABLE_delete_keyed(interp, pmc, key);
 904     PARROT_CALLIN_END(interp);
 905 }
 906
 907 /*
 908
 909 =item C<void Parrot_PMC_set_cstringn_intkey(PARROT_INTERP, Parrot_PMC pmc,
 910 Parrot_Int key, const char *value, Parrot_UInt length)>
 911
 912 Assign the passed-in length-noted string to the passed-in PMC.
 913
 914 =cut
 915
 916 */
 917
 918 PARROT_EXPORT
 919 void
 920 Parrot_PMC_set_cstringn_intkey(PARROT_INTERP,
 921         Parrot_PMC pmc, Parrot_Int key, ARGIN_NULLOK(const char *value),
 922         Parrot_UInt length)
 923 {
 924     ASSERT_ARGS(Parrot_PMC_set_cstringn_intkey)
 925     PARROT_CALLIN_START(interp);
 926     VTABLE_set_string_keyed_int(interp, pmc, key,
 927                                 Parrot_str_new(interp, value, length));
 928     PARROT_CALLIN_END(interp);
 929 }
 930
 931 /*
 932
 933 =item C<Parrot_PMC Parrot_PMC_new(PARROT_INTERP, Parrot_Int type)>
 934
 935 Create and return a new PMC.
 936
 937 =cut
 938
 939 */
 940
 941 PARROT_EXPORT
 942 Parrot_PMC
 943 Parrot_PMC_new(PARROT_INTERP, Parrot_Int type)
 944 {
 945     ASSERT_ARGS(Parrot_PMC_new)
 946     Parrot_PMC newpmc;
 947     PARROT_CALLIN_START(interp);
 948     newpmc = pmc_new_noinit(interp, type);
 949     VTABLE_init(interp, newpmc);
 950     PARROT_CALLIN_END(interp);
 951     return newpmc;
 952 }
 953
 954 /*
 955
 956 =item C<Parrot_Int Parrot_PMC_typenum(PARROT_INTERP, const char *_class)>
 957
 958 Returns the internal identifier that represents the named class.
 959
 960 =cut
 961
 962 */
 963
 964 PARROT_EXPORT
 965 Parrot_Int
 966 Parrot_PMC_typenum(PARROT_INTERP, ARGIN_NULLOK(const char *_class))
 967 {
 968     ASSERT_ARGS(Parrot_PMC_typenum)
 969     Parrot_Int retval;
 970     PARROT_CALLIN_START(interp);
 971     retval = pmc_type(interp, Parrot_str_new(interp, _class, 0));
 972     PARROT_CALLIN_END(interp);
 973     return retval;
 974 }
 975
 976 /*
 977
 978 =item C<Parrot_PMC Parrot_PMC_null(void)>
 979
 980 Returns the special C<NULL> PMC.
 981
 982 =cut
 983
 984 */
 985
 986 PARROT_EXPORT
 987 Parrot_PMC
 988 Parrot_PMC_null(void)
 989 {
 990     ASSERT_ARGS(Parrot_PMC_null)
 991     return PMCNULL;
 992 }
 993
 994 /*
 995
 996 =item C<void Parrot_free_cstring(char *string)>
 997
 998 Deallocate a C string that the interpreter has handed to you.
 999
1000 =cut
1001
1002 */
1003
1004 PARROT_EXPORT
1005 void
1006 Parrot_free_cstring(ARGIN_NULLOK(char *string))
1007 {
1008     ASSERT_ARGS(Parrot_free_cstring)
1009     Parrot_str_free_cstring(string);
1010 }
1011
1012 /*
1013
1014 =item C<void append_result(PARROT_INTERP, PMC *sig_object, Parrot_String type,
1015 void *result)>
1016
1017 Helper function between old and new style PCC to append return pointer to signature.
1018
1019 To be removed with deprecated functions.
1020
1021 =cut
1022
1023 */
1024
1025 void
1026 append_result(PARROT_INTERP, ARGIN(PMC *sig_object), ARGIN(Parrot_String type), ARGIN(void *result))
1027 {
1028     ASSERT_ARGS(append_result)
1029     Parrot_String full_sig;
1030     Parrot_PMC    returns;
1031     Parrot_PMC    return_flags;
1032     Parrot_Int    return_flags_size;
1033
1034     Parrot_String return_name       = Parrot_str_new_constant(interp, "returns");
1035     Parrot_String return_flags_name = Parrot_str_new_constant(interp, "return_flags");
1036     Parrot_String sig_name          = Parrot_str_new_constant(interp, "signature");
1037
1038     full_sig = VTABLE_get_string(interp, sig_object);
1039     /* Append ->[T] */
1040     Parrot_str_concat(interp, full_sig, Parrot_str_new_constant(interp, "->"), 0);
1041     Parrot_str_concat(interp, full_sig, type, 0);
1042
1043     returns = VTABLE_get_attr_str(interp, sig_object, return_name);
1044     if (PMC_IS_NULL(returns)) {
1045         returns = pmc_new(interp, enum_class_CallSignatureReturns);
1046         VTABLE_set_attr_str(interp, sig_object, return_name, returns);
1047     }
1048     VTABLE_set_pointer_keyed_int(interp, returns, VTABLE_elements(interp, returns), result);
1049
1050     /* Update returns_flag */
1051     return_flags = VTABLE_get_attr_str(interp, sig_object, return_flags_name);
1052     if (PMC_IS_NULL(return_flags)) {
1053         /* Create return_flags for single element */
1054         return_flags = pmc_new(interp, enum_class_FixedIntegerArray);
1055         return_flags_size = 0;
1056         VTABLE_set_integer_native(interp, return_flags, 1);
1057         VTABLE_set_attr_str(interp, sig_object, return_flags_name, return_flags);
1058     }
1059     else {
1060         /* Extend return_flags by one element */
1061         return_flags_size = VTABLE_elements(interp, return_flags);
1062         VTABLE_set_integer_native(interp, return_flags, return_flags_size + 1);
1063     }
1064     switch (Parrot_str_indexed(interp, type, 0)) {
1065         case 'I':
1066             VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
1067                     PARROT_ARG_INTVAL);
1068             VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
1069             break;
1070         case 'N':
1071             VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
1072                     PARROT_ARG_FLOATVAL);
1073             VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
1074             break;
1075         case 'S':
1076             VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
1077                     PARROT_ARG_STRING);
1078             VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
1079             break;
1080         case 'P':
1081             VTABLE_set_integer_keyed_int(interp, return_flags, return_flags_size,
1082                     PARROT_ARG_PMC);
1083             VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
1084             break;
1085         default:
1086             Parrot_ex_throw_from_c_args(interp, NULL,
1087                 EXCEPTION_INVALID_OPERATION,
1088                 "invalid signature string element!");
1089     }
1090
1091 }
1092
1093 /*
1094
1095 =item C<void Parrot_ext_call(PARROT_INTERP, Parrot_PMC sub_pmc, const char
1096 *signature, ...)>
1097
1098 Call a Parrot subroutine or method with the given function signature. The
1099 function signature holds one type character for each argument or return, these
1100 are:
1101
1102     I ... Parrot_Int
1103     N ... Parrot_Float
1104     S ... Parrot_String
1105     P ... Parrot_PMC
1106
1107 Returns come after the arguments, separated by an arrow, so "PN->S" takes a PMC
1108 and a float as arguments and returns a string.
1109
1110 Pass the variables for the arguments and returns in the same order as the
1111 signature, with returns as reference to the variable (so it can be modified).
1112
1113     Parrot_ext_call(interp, sub, "P->S", pmc_arg, &string_result);
1114
1115 To call a method, pass the object for the method as the first argument, and
1116 mark it in the signature as "Pi" ("i" stands for "invocant").
1117
1118     Parrot_ext_call(interp, sub, "PiP->S", object_arg, pmc_arg, &string_result);
1119
1120 =cut
1121
1122 */
1123
1124 PARROT_EXPORT
1125 void
1126 Parrot_ext_call(PARROT_INTERP, ARGIN(Parrot_PMC sub_pmc),
1127                  ARGIN(const char *signature), ...)
1128 {
1129     ASSERT_ARGS(Parrot_ext_call)
1130     va_list args;
1131     PMC  *sig_object;
1132
1133     va_start(args, signature);
1134     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, signature, args);
1135     va_end(args);
1136
1137     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1138 }
1139
1140 /*
1141
1142 =item C<void * Parrot_call_sub(PARROT_INTERP, Parrot_PMC sub_pmc, const char
1143 *signature, ...)>
1144
1145 Call a parrot subroutine with the given function signature. The first char in
1146 C<signature> denotes the return value. Next chars are arguments.
1147
1148 The return value of this function can be void or a pointer type.
1149
1150 Signature chars are:
1151
1152     v ... void return
1153     I ... Parrot_Int
1154     N ... Parrot_Float
1155     S ... Parrot_String
1156     P ... Parrot_PMC
1157
1158 =cut
1159
1160 */
1161
1162 PARROT_EXPORT
1163 PARROT_WARN_UNUSED_RESULT
1164 PARROT_CAN_RETURN_NULL
1165 void *
1166 Parrot_call_sub(PARROT_INTERP, Parrot_PMC sub_pmc,
1167                  ARGIN(const char *signature), ...)
1168 {
1169     ASSERT_ARGS(Parrot_call_sub)
1170     va_list     args;
1171     PMC        *sig_object;
1172     Parrot_sub *sub;
1173     void       *result     = NULL;
1174     const char *arg_sig    = signature;
1175     char        return_sig = signature[0];
1176
1177     arg_sig++;
1178     va_start(args, signature);
1179     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL,
1180         arg_sig, args);
1181     va_end(args);
1182
1183     /* Add the return argument onto the call signature object (a bit
1184      * hackish, added for backward compatibility in deprecated API function,
1185      * see TT #1145). */
1186     switch (return_sig) {
1187         case 'v':
1188         {
1189             Parrot_String full_sig = VTABLE_get_string(interp, sig_object);
1190             Parrot_str_concat(interp, full_sig,
1191                     Parrot_str_new_constant(interp, "->"), 0);
1192             break;
1193         }
1194         case 'V':
1195         case 'P':
1196         {
1197             append_result(interp, sig_object, Parrot_str_new_constant(interp, "P"), &result);
1198             break;
1199         }
1200         default:
1201             Parrot_ex_throw_from_c_args(interp, NULL,
1202                 EXCEPTION_INVALID_OPERATION,
1203                 "Dispatch: invalid return type %c!", return_sig);
1204     }
1205
1206     PMC_get_sub(interp, sub_pmc, sub);
1207     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp),
1208         sub->seg->const_table->constants);
1209     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1210
1211     return result;
1212 }
1213
1214
1215 /*
1216
1217 =item C<Parrot_Int Parrot_call_sub_ret_int(PARROT_INTERP, Parrot_PMC sub_pmc,
1218 const char *signature, ...)>
1219
1220 Like C<Parrot_call_sub>, with Parrot_Int return result.
1221
1222 =cut
1223
1224 */
1225
1226 PARROT_EXPORT
1227 Parrot_Int
1228 Parrot_call_sub_ret_int(PARROT_INTERP, Parrot_PMC sub_pmc,
1229                  ARGIN(const char *signature), ...)
1230 {
1231     ASSERT_ARGS(Parrot_call_sub_ret_int)
1232     va_list     args;
1233     PMC        *sig_object;
1234     Parrot_Int  result;
1235     char        return_sig  = signature[0];
1236     const char *arg_sig     = signature;
1237     Parrot_sub *sub;
1238
1239     arg_sig++;
1240     va_start(args, signature);
1241     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, arg_sig, args);
1242     va_end(args);
1243
1244     /* Add the return argument onto the call signature object (a bit
1245      * hackish, added for backward compatibility in deprecated API function,
1246      * see TT #1145). */
1247     append_result(interp, sig_object, Parrot_str_new_constant(interp, "I"), &result);
1248     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1249
1250     return result;
1251 }
1252
1253 /*
1254
1255 =item C<Parrot_Float Parrot_call_sub_ret_float(PARROT_INTERP, Parrot_PMC
1256 sub_pmc, const char *signature, ...)>
1257
1258 Like C<Parrot_call_sub>, with Parrot_Float return result.
1259
1260 =cut
1261
1262 */
1263
1264 PARROT_EXPORT
1265 Parrot_Float
1266 Parrot_call_sub_ret_float(PARROT_INTERP, Parrot_PMC sub_pmc,
1267                  ARGIN(const char *signature), ...)
1268 {
1269     ASSERT_ARGS(Parrot_call_sub_ret_float)
1270     va_list         args;
1271     PMC            *sig_object;
1272     Parrot_Float    result;
1273     char            return_sig  = signature[0];
1274     const char     *arg_sig     = signature;
1275     Parrot_sub     *sub;
1276
1277     arg_sig++;
1278     va_start(args, signature);
1279     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, PMCNULL, arg_sig, args);
1280     va_end(args);
1281
1282     /* Add the return argument onto the call signature object (a bit
1283      * hackish, added for backward compatibility in deprecated API function,
1284      * see TT #1145). */
1285     append_result(interp, sig_object, Parrot_str_new_constant(interp, "N"), &result);
1286     PMC_get_sub(interp, sub_pmc, sub);
1287     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
1288     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1289
1290     return result;
1291 }
1292
1293 /*
1294
1295 =item C<void * Parrot_call_method(PARROT_INTERP, Parrot_PMC sub_pmc, Parrot_PMC
1296 obj, Parrot_String method, const char *signature, ...)>
1297
1298 Call the parrot subroutine C<sub> as a method on PMC object C<obj>. The method
1299 should have the name C<method> as a Parrot_string, and should have a function
1300 signature C<signature>. Any arguments to the method can be passed at the end
1301 as a variadic argument list.
1302
1303 =cut
1304
1305 */
1306
1307 PARROT_EXPORT
1308 PARROT_WARN_UNUSED_RESULT
1309 PARROT_CAN_RETURN_NULL
1310 void *
1311 Parrot_call_method(PARROT_INTERP, Parrot_PMC sub_pmc, Parrot_PMC obj,
1312                         Parrot_String method, ARGIN(const char *signature), ...)
1313 {
1314     ASSERT_ARGS(Parrot_call_method)
1315     va_list args;
1316     PMC  *sig_object;
1317     void *result = NULL;
1318     char  return_sig = signature[0];
1319     char *arg_sig = (char*)malloc(strlen(signature)+2);
1320     Parrot_sub *sub;
1321     arg_sig[0] = 'P';
1322     arg_sig[1] = 'i';
1323     arg_sig[2] = 0;
1324     strcat(arg_sig, signature);
1325
1326     va_start(args, signature);
1327     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, obj, arg_sig, args);
1328     va_end(args);
1329     free(arg_sig);
1330
1331     /* Add the return argument onto the call signature object (a bit
1332      * hackish, added for backward compatibility in deprecated API function,
1333      * see TT #1145). */
1334     switch (return_sig) {
1335         case 'v':
1336         {
1337             Parrot_String full_sig = VTABLE_get_string(interp, sig_object);
1338             Parrot_str_concat(interp, full_sig,
1339                     Parrot_str_new_constant(interp, "->"), 0);
1340             break;
1341         }
1342         case 'V':
1343         case 'P':
1344         {
1345             append_result(interp, sig_object, Parrot_str_new_constant(interp, "P"), &result);
1346             break;
1347         }
1348         default:
1349             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
1350                         "Dispatch: invalid return type %c!", return_sig);
1351     }
1352
1353     PMC_get_sub(interp, sub_pmc, sub);
1354     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
1355     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1356
1357     return result;
1358 }
1359
1360 /*
1361
1362 =item C<Parrot_Int Parrot_call_method_ret_int(PARROT_INTERP, Parrot_PMC sub_pmc,
1363 Parrot_PMC obj, Parrot_String method, const char *signature, ...)>
1364
1365 Call the parrot subroutine C<sub> as a method on PMC object C<obj>. The method
1366 should have the name C<method> as a Parrot_string, and should have a function
1367 signature C<signature>. Any arguments to the method can be passed at the end
1368 as a variadic argument list.
1369
1370 =cut
1371
1372 */
1373
1374 PARROT_EXPORT
1375 Parrot_Int
1376 Parrot_call_method_ret_int(PARROT_INTERP, Parrot_PMC sub_pmc,
1377         Parrot_PMC obj, Parrot_String method, ARGIN(const char *signature), ...)
1378 {
1379     ASSERT_ARGS(Parrot_call_method_ret_int)
1380     va_list args;
1381     PMC  *sig_object;
1382     Parrot_Int result = 0;
1383     char  return_sig = signature[0];
1384     char *arg_sig = (char*)malloc(strlen(signature)+2);
1385     Parrot_sub *sub;
1386     arg_sig[0] = 'P';
1387     arg_sig[1] = 'i';
1388     arg_sig[2] = 0;
1389     strcat(arg_sig, signature);
1390
1391     va_start(args, signature);
1392     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, obj, arg_sig, args);
1393     va_end(args);
1394     free(arg_sig);
1395
1396     append_result(interp, sig_object, Parrot_str_new_constant(interp, "I"), &result);
1397     PMC_get_sub(interp, sub_pmc, sub);
1398     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
1399     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1400
1401     return result;
1402 }
1403
1404 /*
1405
1406 =item C<Parrot_Float Parrot_call_method_ret_float(PARROT_INTERP, Parrot_PMC
1407 sub_pmc, Parrot_PMC obj, Parrot_String method, const char *signature, ...)>
1408
1409 Call a parrot method for the given object.
1410
1411 =cut
1412
1413 */
1414
1415 PARROT_EXPORT
1416 Parrot_Float
1417 Parrot_call_method_ret_float(PARROT_INTERP, Parrot_PMC sub_pmc,
1418         Parrot_PMC obj, Parrot_String method, ARGIN(const char *signature), ...)
1419 {
1420     ASSERT_ARGS(Parrot_call_method_ret_float)
1421     va_list args;
1422     PMC  *sig_object;
1423     Parrot_Float result = 0.0;
1424     char  return_sig = signature[0];
1425     char *arg_sig = (char*)malloc(strlen(signature)+2);
1426     Parrot_sub *sub;
1427     arg_sig[0] = 'P';
1428     arg_sig[1] = 'i';
1429     arg_sig[2] = 0;
1430     strcat(arg_sig, signature);
1431
1432     va_start(args, signature);
1433     sig_object = Parrot_pcc_build_sig_object_from_varargs(interp, obj, arg_sig, args);
1434     va_end(args);
1435     free(arg_sig);
1436
1437     append_result(interp, sig_object, Parrot_str_new_constant(interp, "N"), &result);
1438     PMC_get_sub(interp, sub_pmc, sub);
1439     Parrot_pcc_set_constants(interp, CURRENT_CONTEXT(interp), sub->seg->const_table->constants);
1440     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, sig_object);
1441
1442     return result;
1443 }
1444
1445 /*
1446
1447 =item C<Parrot_Int Parrot_get_intreg(PARROT_INTERP, Parrot_Int regnum)>
1448
1449 Return the value of an integer register.
1450
1451 =cut
1452
1453 */
1454
1455 PARROT_EXPORT
1456 Parrot_Int
1457 Parrot_get_intreg(PARROT_INTERP, Parrot_Int regnum)
1458 {
1459     ASSERT_ARGS(Parrot_get_intreg)
1460     return REG_INT(interp, regnum);
1461 }
1462
1463 /*
1464
1465 =item C<Parrot_Float Parrot_get_numreg(PARROT_INTERP, Parrot_Int regnum)>
1466
1467 Return the value of a numeric register.
1468
1469 =cut
1470
1471 */
1472
1473 PARROT_EXPORT
1474 Parrot_Float
1475 Parrot_get_numreg(PARROT_INTERP, Parrot_Int regnum)
1476 {
1477     ASSERT_ARGS(Parrot_get_numreg)
1478     return REG_NUM(interp, regnum);
1479 }
1480
1481 /*
1482
1483 =item C<Parrot_String Parrot_get_strreg(PARROT_INTERP, Parrot_Int regnum)>
1484
1485 Return the value of a string register.
1486
1487 =cut
1488
1489 */
1490
1491 PARROT_EXPORT
1492 Parrot_String
1493 Parrot_get_strreg(PARROT_INTERP, Parrot_Int regnum)
1494 {
1495     ASSERT_ARGS(Parrot_get_strreg)
1496     return REG_STR(interp, regnum);
1497 }
1498
1499 /*
1500
1501 =item C<Parrot_PMC Parrot_get_pmcreg(PARROT_INTERP, Parrot_Int regnum)>
1502
1503 Return the value of a PMC register.
1504
1505 =cut
1506
1507 */
1508
1509 PARROT_EXPORT
1510 Parrot_PMC
1511 Parrot_get_pmcreg(PARROT_INTERP, Parrot_Int regnum)
1512 {
1513     ASSERT_ARGS(Parrot_get_pmcreg)
1514     return REG_PMC(interp, regnum);
1515 }
1516
1517 /*
1518
1519 =item C<void Parrot_set_intreg(PARROT_INTERP, Parrot_Int regnum, Parrot_Int
1520 value)>
1521
1522 Set the value of an I register.
1523
1524 =cut
1525
1526 */
1527
1528 PARROT_EXPORT
1529 void
1530 Parrot_set_intreg(PARROT_INTERP, Parrot_Int regnum,
1531                   Parrot_Int value)
1532 {
1533     ASSERT_ARGS(Parrot_set_intreg)
1534     REG_INT(interp, regnum) = value;
1535 }
1536
1537 /*
1538
1539 =item C<void Parrot_set_numreg(PARROT_INTERP, Parrot_Int regnum, Parrot_Float
1540 value)>
1541
1542 Set the value of an N register.
1543
1544 =cut
1545
1546 */
1547
1548 PARROT_EXPORT
1549 void
1550 Parrot_set_numreg(PARROT_INTERP, Parrot_Int regnum,
1551                   Parrot_Float value)
1552 {
1553     ASSERT_ARGS(Parrot_set_numreg)
1554     REG_NUM(interp, regnum) = value;
1555 }
1556
1557 /*
1558
1559 =item C<void Parrot_set_strreg(PARROT_INTERP, Parrot_Int regnum, Parrot_String
1560 value)>
1561
1562 Set the value of an S register.
1563
1564 =cut
1565
1566 */
1567
1568 PARROT_EXPORT
1569 void
1570 Parrot_set_strreg(PARROT_INTERP, Parrot_Int regnum,
1571                   Parrot_String value)
1572 {
1573     ASSERT_ARGS(Parrot_set_strreg)
1574     REG_STR(interp, regnum) = value;
1575 }
1576
1577 /*
1578
1579 =item C<void Parrot_set_pmcreg(PARROT_INTERP, Parrot_Int regnum, Parrot_PMC
1580 value)>
1581
1582 Set the value of a P register.
1583
1584 =cut
1585
1586 */
1587
1588 PARROT_EXPORT
1589 void
1590 Parrot_set_pmcreg(PARROT_INTERP, Parrot_Int regnum,
1591                   Parrot_PMC value)
1592 {
1593     ASSERT_ARGS(Parrot_set_pmcreg)
1594     REG_PMC(interp, regnum) = value;
1595 }
1596
1597 /*=for api extend Parrot_new_string
1598  *
1599  */
1600 /*
1601
1602 =item C<Parrot_String Parrot_new_string(PARROT_INTERP, const char *buffer,
1603 Parrot_UInt length, const char * const encoding_name, Parrot_UInt flags)>
1604
1605 Create a new Parrot string from a passed-in buffer. Pass in a 0 for
1606 flags for right now.
1607
1608 A copy of the buffer is made.
1609
1610 =cut
1611
1612 */
1613
1614 PARROT_EXPORT
1615 PARROT_WARN_UNUSED_RESULT
1616 PARROT_CANNOT_RETURN_NULL
1617 Parrot_String
1618 Parrot_new_string(PARROT_INTERP, ARGIN_NULLOK(const char *buffer),
1619     Parrot_UInt length, ARGIN_NULLOK(const char * const encoding_name),
1620     Parrot_UInt flags)
1621 {
1622     ASSERT_ARGS(Parrot_new_string)
1623     Parrot_String retval;
1624     PARROT_CALLIN_START(interp);
1625     retval = string_make(interp, buffer, length, encoding_name, flags);
1626     PARROT_CALLIN_END(interp);
1627     return retval;
1628 }
1629
1630 /*
1631
1632 =item C<Parrot_Language Parrot_find_language(PARROT_INTERP, char *language)>
1633
1634 Find the magic language token for a language, by language name.
1635
1636 =cut
1637
1638 */
1639
1640 PARROT_EXPORT
1641 PARROT_WARN_UNUSED_RESULT
1642 Parrot_Language
1643 Parrot_find_language(SHIM_INTERP, SHIM(char *language))
1644 {
1645     ASSERT_ARGS(Parrot_find_language)
1646     return 0;
1647 }
1648
1649 /*
1650
1651 =item C<void Parrot_register_pmc(PARROT_INTERP, Parrot_PMC pmc)>
1652
1653 Add a reference of the PMC to the interpreter's GC registry. This prevents PMCs
1654 only known to extension from getting destroyed during GC runs.
1655
1656 =cut
1657
1658 */
1659
1660 PARROT_EXPORT
1661 void
1662 Parrot_register_pmc(PARROT_INTERP, Parrot_PMC pmc)
1663 {
1664     ASSERT_ARGS(Parrot_register_pmc)
1665     PARROT_CALLIN_START(interp);
1666     gc_register_pmc(interp, pmc);
1667     PARROT_CALLIN_END(interp);
1668 }
1669
1670 /*
1671
1672 =item C<void Parrot_unregister_pmc(PARROT_INTERP, Parrot_PMC pmc)>
1673
1674 Remove a reference of the PMC from the interpreter's GC registry. If the
1675 reference count reaches zero, the PMC will be destroyed during the next GC run.
1676
1677 =cut
1678
1679 */
1680
1681 PARROT_EXPORT
1682 void
1683 Parrot_unregister_pmc(PARROT_INTERP, Parrot_PMC pmc)
1684 {
1685     ASSERT_ARGS(Parrot_unregister_pmc)
1686     PARROT_CALLIN_START(interp);
1687     gc_unregister_pmc(interp, pmc);
1688     PARROT_CALLIN_END(interp);
1689 }
1690
1691 /*
1692
1693 =item C<void Parrot_PMC_set_vtable(PARROT_INTERP, Parrot_PMC pmc, Parrot_VTABLE
1694 vtable)>
1695
1696 Replaces the vtable of the PMC.
1697
1698 =cut
1699
1700 */
1701
1702 PARROT_EXPORT
1703 void
1704 Parrot_PMC_set_vtable(SHIM_INTERP, Parrot_PMC pmc, Parrot_VTABLE vtable)
1705 {
1706     ASSERT_ARGS(Parrot_PMC_set_vtable)
1707     pmc->vtable = vtable;
1708 }
1709
1710 /*
1711
1712 =item C<Parrot_VTABLE Parrot_get_vtable(PARROT_INTERP, Parrot_Int id)>
1713
1714 Returns the vtable corresponding to the given PMC ID.
1715
1716 =cut
1717
1718 */
1719
1720 PARROT_EXPORT
1721 PARROT_PURE_FUNCTION
1722 Parrot_VTABLE
1723 Parrot_get_vtable(PARROT_INTERP, Parrot_Int id)
1724 {
1725     ASSERT_ARGS(Parrot_get_vtable)
1726     return interp->vtables[id];
1727 }
1728
1729 /*
1730
1731 =item C<Parrot_PMC Parrot_sub_new_from_c_func(PARROT_INTERP, void (*func(void)),
1732 const char * signature)>
1733
1734 Returns a PMC sub wrapper for a c function.
1735
1736 =cut
1737
1738 */
1739
1740 PARROT_EXPORT
1741 Parrot_PMC
1742 Parrot_sub_new_from_c_func(PARROT_INTERP,
1743         ARGIN(void (*func)(void)), ARGIN(const char * signature))
1744 {
1745     ASSERT_ARGS(Parrot_sub_new_from_c_func)
1746     Parrot_String sig = Parrot_new_string(interp, signature, strlen(signature),
1747         (char *) NULL, 0);
1748     Parrot_PMC sub = pmc_new(interp, enum_class_NCI);
1749     VTABLE_set_pointer_keyed_str(interp, sub, sig, F2DPTR(func));
1750     PObj_get_FLAGS(sub) |= PObj_private1_FLAG;
1751     return sub;
1752 }
1753
1754 /*
1755
1756 =item C<Parrot_PMC Parrot_PMC_newclass(PARROT_INTERP, Parrot_PMC classtype)>
1757
1758 Create a class with the type given
1759
1760 =cut
1761
1762 */
1763
1764 PARROT_EXPORT
1765 Parrot_PMC
1766 Parrot_PMC_newclass(PARROT_INTERP, Parrot_PMC classtype)
1767 {
1768     ASSERT_ARGS(Parrot_PMC_newclass)
1769     Parrot_PMC result;
1770     PARROT_CALLIN_START(interp);
1771
1772     result = pmc_new_init(interp, enum_class_Class, classtype);
1773
1774     PARROT_CALLIN_END(interp);
1775     return result;
1776 }
1777
1778 /*
1779
1780 =back
1781
1782 =head1 SEE ALSO
1783
1784 See F<include/parrot/extend.h> and F<docs/pdds/pdd11_extending.pod>.
1785
1786 =head1 HISTORY
1787
1788 Initial version by Dan Sugalski.
1789
1790 =cut
1791
1792 */
1793
1794
1795 /*
1796  * Local variables:
1797  *   c-file-style: "parrot"
1798  * End:
1799  * vim: expandtab shiftwidth=4:
1800  */