src/extend.c

   1 /*
   2 Copyright (C) 2001-2010, 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_callcontext.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_PMC Parrot_PMC_new(PARROT_INTERP, Parrot_Int type)>
 193
 194 Create and return a new PMC.
 195
 196 =cut
 197
 198 */
 199
 200 PARROT_EXPORT
 201 Parrot_PMC
 202 Parrot_PMC_new(PARROT_INTERP, Parrot_Int type)
 203 {
 204     ASSERT_ARGS(Parrot_PMC_new)
 205     Parrot_PMC newpmc;
 206     PARROT_CALLIN_START(interp);
 207     newpmc = Parrot_pmc_new_noinit(interp, type);
 208     VTABLE_init(interp, newpmc);
 209     PARROT_CALLIN_END(interp);
 210     return newpmc;
 211 }
 212
 213 /*
 214
 215 =item C<Parrot_Int Parrot_PMC_typenum(PARROT_INTERP, const char *_class)>
 216
 217 Returns the internal identifier that represents the named class.
 218
 219 =cut
 220
 221 */
 222
 223 PARROT_EXPORT
 224 Parrot_Int
 225 Parrot_PMC_typenum(PARROT_INTERP, ARGIN_NULLOK(const char *_class))
 226 {
 227     ASSERT_ARGS(Parrot_PMC_typenum)
 228     Parrot_Int retval;
 229     PARROT_CALLIN_START(interp);
 230     retval = Parrot_pmc_get_type_str(interp, Parrot_str_new(interp, _class, 0));
 231     PARROT_CALLIN_END(interp);
 232     return retval;
 233 }
 234
 235 /*
 236
 237 =item C<Parrot_PMC Parrot_PMC_null(void)>
 238
 239 Returns the special C<NULL> PMC.
 240
 241 =cut
 242
 243 */
 244
 245 PARROT_EXPORT
 246 Parrot_PMC
 247 Parrot_PMC_null(void)
 248 {
 249     ASSERT_ARGS(Parrot_PMC_null)
 250     return PMCNULL;
 251 }
 252
 253 /*
 254
 255 =item C<void Parrot_free_cstring(char *string)>
 256
 257 Deallocate a C string that the interpreter has handed to you.
 258
 259 =cut
 260
 261 */
 262
 263 PARROT_EXPORT
 264 void
 265 Parrot_free_cstring(ARGFREE(char *string))
 266 {
 267     ASSERT_ARGS(Parrot_free_cstring)
 268     Parrot_str_free_cstring(string);
 269 }
 270
 271 /*
 272
 273 =item C<void Parrot_ext_call(PARROT_INTERP, Parrot_PMC sub_pmc, const char
 274 *signature, ...)>
 275
 276 Call a Parrot subroutine or method with the given function signature. The
 277 function signature holds one type character for each argument or return, these
 278 are:
 279
 280     I ... Parrot_Int
 281     N ... Parrot_Float
 282     S ... Parrot_String
 283     P ... Parrot_PMC
 284
 285 Returns come after the arguments, separated by an arrow, so "PN->S" takes a PMC
 286 and a float as arguments and returns a string.
 287
 288 Pass the variables for the arguments and returns in the same order as the
 289 signature, with returns as reference to the variable (so it can be modified).
 290
 291     Parrot_ext_call(interp, sub, "P->S", pmc_arg, &string_result);
 292
 293 To call a method, pass the object for the method as the first argument, and
 294 mark it in the signature as "Pi" ("i" stands for "invocant").
 295
 296     Parrot_ext_call(interp, sub, "PiP->S", object_arg, pmc_arg, &string_result);
 297
 298 =cut
 299
 300 */
 301
 302 PARROT_EXPORT
 303 void
 304 Parrot_ext_call(PARROT_INTERP, ARGIN(Parrot_PMC sub_pmc),
 305                  ARGIN(const char *signature), ...)
 306 {
 307     ASSERT_ARGS(Parrot_ext_call)
 308     va_list args;
 309     PMC  *call_obj;
 310     const char *arg_sig, *ret_sig;
 311
 312     PMC  * const old_call_obj = Parrot_pcc_get_signature(interp,
 313         CURRENT_CONTEXT(interp));
 314     Parrot_pcc_split_signature_string(signature, &arg_sig, &ret_sig);
 315
 316     va_start(args, signature);
 317     call_obj = Parrot_pcc_build_call_from_varargs(interp, PMCNULL,
 318         arg_sig, &args);
 319
 320     Parrot_pcc_invoke_from_sig_object(interp, sub_pmc, call_obj);
 321     call_obj = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
 322     Parrot_pcc_fill_params_from_varargs(interp, call_obj, ret_sig, &args,
 323             PARROT_ERRORS_RESULT_COUNT_FLAG);
 324     va_end(args);
 325     Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_call_obj);
 326 }
 327
 328
 329 /*
 330
 331 =item C<Parrot_Int Parrot_get_intreg(PARROT_INTERP, Parrot_Int regnum)>
 332
 333 Return the value of an integer register.
 334
 335 =cut
 336
 337 */
 338
 339 PARROT_EXPORT
 340 Parrot_Int
 341 Parrot_get_intreg(PARROT_INTERP, Parrot_Int regnum)
 342 {
 343     ASSERT_ARGS(Parrot_get_intreg)
 344     return REG_INT(interp, regnum);
 345 }
 346
 347 /*
 348
 349 =item C<Parrot_Float Parrot_get_numreg(PARROT_INTERP, Parrot_Int regnum)>
 350
 351 Return the value of a numeric register.
 352
 353 =cut
 354
 355 */
 356
 357 PARROT_EXPORT
 358 Parrot_Float
 359 Parrot_get_numreg(PARROT_INTERP, Parrot_Int regnum)
 360 {
 361     ASSERT_ARGS(Parrot_get_numreg)
 362     return REG_NUM(interp, regnum);
 363 }
 364
 365 /*
 366
 367 =item C<Parrot_String Parrot_get_strreg(PARROT_INTERP, Parrot_Int regnum)>
 368
 369 Return the value of a string register.
 370
 371 =cut
 372
 373 */
 374
 375 PARROT_EXPORT
 376 Parrot_String
 377 Parrot_get_strreg(PARROT_INTERP, Parrot_Int regnum)
 378 {
 379     ASSERT_ARGS(Parrot_get_strreg)
 380     return REG_STR(interp, regnum);
 381 }
 382
 383 /*
 384
 385 =item C<Parrot_PMC Parrot_get_pmcreg(PARROT_INTERP, Parrot_Int regnum)>
 386
 387 Return the value of a PMC register.
 388
 389 =cut
 390
 391 */
 392
 393 PARROT_EXPORT
 394 Parrot_PMC
 395 Parrot_get_pmcreg(PARROT_INTERP, Parrot_Int regnum)
 396 {
 397     ASSERT_ARGS(Parrot_get_pmcreg)
 398     return REG_PMC(interp, regnum);
 399 }
 400
 401 /*
 402
 403 =item C<void Parrot_set_intreg(PARROT_INTERP, Parrot_Int regnum, Parrot_Int
 404 value)>
 405
 406 Set the value of an I register.
 407
 408 =cut
 409
 410 */
 411
 412 PARROT_EXPORT
 413 void
 414 Parrot_set_intreg(PARROT_INTERP, Parrot_Int regnum,
 415                   Parrot_Int value)
 416 {
 417     ASSERT_ARGS(Parrot_set_intreg)
 418     REG_INT(interp, regnum) = value;
 419 }
 420
 421 /*
 422
 423 =item C<void Parrot_set_numreg(PARROT_INTERP, Parrot_Int regnum, Parrot_Float
 424 value)>
 425
 426 Set the value of an N register.
 427
 428 =cut
 429
 430 */
 431
 432 PARROT_EXPORT
 433 void
 434 Parrot_set_numreg(PARROT_INTERP, Parrot_Int regnum,
 435                   Parrot_Float value)
 436 {
 437     ASSERT_ARGS(Parrot_set_numreg)
 438     REG_NUM(interp, regnum) = value;
 439 }
 440
 441 /*
 442
 443 =item C<void Parrot_set_strreg(PARROT_INTERP, Parrot_Int regnum, Parrot_String
 444 value)>
 445
 446 Set the value of an S register.
 447
 448 =cut
 449
 450 */
 451
 452 PARROT_EXPORT
 453 void
 454 Parrot_set_strreg(PARROT_INTERP, Parrot_Int regnum,
 455                   Parrot_String value)
 456 {
 457     ASSERT_ARGS(Parrot_set_strreg)
 458     REG_STR(interp, regnum) = value;
 459 }
 460
 461 /*
 462
 463 =item C<void Parrot_set_pmcreg(PARROT_INTERP, Parrot_Int regnum, Parrot_PMC
 464 value)>
 465
 466 Set the value of a P register.
 467
 468 =cut
 469
 470 */
 471
 472 PARROT_EXPORT
 473 void
 474 Parrot_set_pmcreg(PARROT_INTERP, Parrot_Int regnum,
 475                   Parrot_PMC value)
 476 {
 477     ASSERT_ARGS(Parrot_set_pmcreg)
 478     REG_PMC(interp, regnum) = value;
 479 }
 480
 481 /*=for api extend Parrot_new_string
 482  *
 483  */
 484 /*
 485
 486 =item C<Parrot_String Parrot_new_string(PARROT_INTERP, const char *buffer,
 487 Parrot_UInt length, const char * const encoding_name, Parrot_UInt flags)>
 488
 489 Create a new Parrot string from a passed-in buffer. Pass in a 0 for
 490 flags for right now.
 491
 492 A copy of the buffer is made.
 493
 494 =cut
 495
 496 */
 497
 498 PARROT_EXPORT
 499 PARROT_WARN_UNUSED_RESULT
 500 PARROT_CANNOT_RETURN_NULL
 501 Parrot_String
 502 Parrot_new_string(PARROT_INTERP, ARGIN_NULLOK(const char *buffer),
 503     Parrot_UInt length, ARGIN_NULLOK(const char * const encoding_name),
 504     Parrot_UInt flags)
 505 {
 506     ASSERT_ARGS(Parrot_new_string)
 507     Parrot_String retval;
 508     PARROT_CALLIN_START(interp);
 509     retval = string_make(interp, buffer, length, encoding_name, flags);
 510     PARROT_CALLIN_END(interp);
 511     return retval;
 512 }
 513
 514 /*
 515
 516 =item C<Parrot_Language Parrot_find_language(PARROT_INTERP, char *language)>
 517
 518 Find the magic language token for a language, by language name.
 519
 520 =cut
 521
 522 */
 523
 524 PARROT_EXPORT
 525 PARROT_WARN_UNUSED_RESULT
 526 Parrot_Language
 527 Parrot_find_language(SHIM_INTERP, SHIM(char *language))
 528 {
 529     ASSERT_ARGS(Parrot_find_language)
 530     return 0;
 531 }
 532
 533 /*
 534
 535 =item C<void Parrot_register_pmc(PARROT_INTERP, Parrot_PMC pmc)>
 536
 537 Add a reference of the PMC to the interpreter's GC registry. This prevents PMCs
 538 only known to extension from getting destroyed during GC runs.
 539
 540 =cut
 541
 542 */
 543
 544 PARROT_EXPORT
 545 void
 546 Parrot_register_pmc(PARROT_INTERP, Parrot_PMC pmc)
 547 {
 548     ASSERT_ARGS(Parrot_register_pmc)
 549     PARROT_CALLIN_START(interp);
 550     Parrot_pmc_gc_register(interp, pmc);
 551     PARROT_CALLIN_END(interp);
 552 }
 553
 554 /*
 555
 556 =item C<void Parrot_unregister_pmc(PARROT_INTERP, Parrot_PMC pmc)>
 557
 558 Remove a reference of the PMC from the interpreter's GC registry. If the
 559 reference count reaches zero, the PMC will be destroyed during the next GC run.
 560
 561 =cut
 562
 563 */
 564
 565 PARROT_EXPORT
 566 void
 567 Parrot_unregister_pmc(PARROT_INTERP, Parrot_PMC pmc)
 568 {
 569     ASSERT_ARGS(Parrot_unregister_pmc)
 570     PARROT_CALLIN_START(interp);
 571     Parrot_pmc_gc_unregister(interp, pmc);
 572     PARROT_CALLIN_END(interp);
 573 }
 574
 575 /*
 576
 577 =item C<Parrot_PMC Parrot_sub_new_from_c_func(PARROT_INTERP, void (*func(void)),
 578 const char * signature)>
 579
 580 Returns a PMC sub wrapper for a c function.
 581
 582 =cut
 583
 584 */
 585
 586 PARROT_EXPORT
 587 Parrot_PMC
 588 Parrot_sub_new_from_c_func(PARROT_INTERP,
 589         ARGIN(void (*func)(void)), ARGIN(const char * signature))
 590 {
 591     ASSERT_ARGS(Parrot_sub_new_from_c_func)
 592     Parrot_String sig = Parrot_new_string(interp, signature, strlen(signature),
 593         (char *) NULL, 0);
 594     Parrot_PMC sub = Parrot_pmc_new(interp, enum_class_NCI);
 595     VTABLE_set_pointer_keyed_str(interp, sub, sig, F2DPTR(func));
 596     return sub;
 597 }
 598
 599 /*
 600
 601 =item C<Parrot_PMC Parrot_PMC_newclass(PARROT_INTERP, Parrot_PMC classtype)>
 602
 603 Create a class with the type given
 604
 605 =cut
 606
 607 */
 608
 609 PARROT_EXPORT
 610 Parrot_PMC
 611 Parrot_PMC_newclass(PARROT_INTERP, Parrot_PMC classtype)
 612 {
 613     ASSERT_ARGS(Parrot_PMC_newclass)
 614     Parrot_PMC result;
 615     PARROT_CALLIN_START(interp);
 616
 617     result = Parrot_pmc_new_init(interp, enum_class_Class, classtype);
 618
 619     PARROT_CALLIN_END(interp);
 620     return result;
 621 }
 622
 623 /*
 624
 625 =back
 626
 627 =head1 SEE ALSO
 628
 629 See F<include/parrot/extend.h> and F<docs/pdds/pdd11_extending.pod>.
 630
 631 =head1 HISTORY
 632
 633 Initial version by Dan Sugalski.
 634
 635 =cut
 636
 637 */
 638
 639
 640 /*
 641  * Local variables:
 642  *   c-file-style: "parrot"
 643  * End:
 644  * vim: expandtab shiftwidth=4:
 645  */