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