src/key.c

   1 /*
   2 Copyright (C) 2001-2008, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/key.c - Base vtable calling functions
   8
   9 =head1 DESCRIPTION
  10
  11 The base vtable calling functions.
  12
  13 =head2 Functions
  14
  15 =over 4
  16
  17 =cut
  18
  19 */
  20
  21 #include "parrot/parrot.h"
  22 #include "parrot/key.h"
  23 #include "key.str"
  24 #include "pmc/pmc_key.h"
  25 #include "pmc/pmc_context.h"
  26
  27 /* HEADERIZER HFILE: include/parrot/key.h */
  28
  29 /*
  30
  31 =item C<PMC * key_new(PARROT_INTERP)>
  32
  33 Returns a new C<Key> PMC.
  34
  35 =cut
  36
  37 */
  38
  39 PARROT_EXPORT
  40 PARROT_CANNOT_RETURN_NULL
  41 PARROT_WARN_UNUSED_RESULT
  42 PMC *
  43 key_new(PARROT_INTERP)
  44 {
  45     ASSERT_ARGS(key_new)
  46     return pmc_new(interp, enum_class_Key);
  47 }
  48
  49
  50 /*
  51
  52 =item C<PMC * key_new_integer(PARROT_INTERP, INTVAL value)>
  53
  54 Returns a new integer C<Key> PMC with value C<value>.
  55
  56 =cut
  57
  58 */
  59
  60 PARROT_EXPORT
  61 PARROT_CANNOT_RETURN_NULL
  62 PARROT_WARN_UNUSED_RESULT
  63 PMC *
  64 key_new_integer(PARROT_INTERP, INTVAL value)
  65 {
  66     ASSERT_ARGS(key_new_integer)
  67     PMC * const key = pmc_new(interp, enum_class_Key);
  68
  69     PObj_get_FLAGS(key) |= KEY_integer_FLAG;
  70     SETATTR_Key_int_key(interp, key, value);
  71
  72     return key;
  73 }
  74
  75
  76 /*
  77
  78 =item C<PMC * key_new_number(PARROT_INTERP, FLOATVAL value)>
  79
  80 Returns a new number C<Key> PMC with value C<value>.
  81
  82 =cut
  83
  84 */
  85
  86 PARROT_EXPORT
  87 PARROT_CANNOT_RETURN_NULL
  88 PARROT_WARN_UNUSED_RESULT
  89 PMC *
  90 key_new_number(PARROT_INTERP, FLOATVAL value)
  91 {
  92     ASSERT_ARGS(key_new_number)
  93     PMC * const key = pmc_new(interp, enum_class_Key);
  94
  95     PObj_get_FLAGS(key) |= KEY_number_FLAG;
  96     SETATTR_Key_num_key(interp, key, value);
  97
  98     return key;
  99 }
 100
 101
 102 /*
 103
 104 =item C<PMC * key_new_string(PARROT_INTERP, STRING *value)>
 105
 106 Returns a new string C<Key> PMC with value C<value>.
 107
 108 =cut
 109
 110 */
 111
 112 PARROT_EXPORT
 113 PARROT_CANNOT_RETURN_NULL
 114 PARROT_WARN_UNUSED_RESULT
 115 PMC *
 116 key_new_string(PARROT_INTERP, ARGIN(STRING *value))
 117 {
 118     ASSERT_ARGS(key_new_string)
 119     PMC * const key = pmc_new(interp, enum_class_Key);
 120
 121     PObj_get_FLAGS(key) |= KEY_string_FLAG;
 122     SETATTR_Key_str_key(interp, key, value);
 123
 124     return key;
 125 }
 126
 127
 128 /*
 129
 130 =item C<PMC * key_new_cstring(PARROT_INTERP, const char *value)>
 131
 132 Returns a new string C<Key> PMC with value C<value> converted to a
 133 C<STRING>.
 134
 135 =cut
 136
 137 */
 138
 139 PARROT_EXPORT
 140 PARROT_CANNOT_RETURN_NULL
 141 PARROT_WARN_UNUSED_RESULT
 142 PMC *
 143 key_new_cstring(PARROT_INTERP, ARGIN_NULLOK(const char *value))
 144 {
 145     ASSERT_ARGS(key_new_cstring)
 146     return key_new_string(interp, Parrot_str_new(interp, value, 0));
 147 }
 148
 149
 150 /*
 151
 152 =item C<PMC * key_new_pmc(PARROT_INTERP, PMC *value)>
 153
 154 Returns a new PMC C<Key> PMC with value C<value>.
 155
 156 =cut
 157
 158 */
 159
 160 PARROT_EXPORT
 161 PARROT_CANNOT_RETURN_NULL
 162 PARROT_WARN_UNUSED_RESULT
 163 PMC *
 164 key_new_pmc(PARROT_INTERP, ARGIN(PMC *value))
 165 {
 166     ASSERT_ARGS(key_new_pmc)
 167     PMC * const key = pmc_new(interp, enum_class_Key);
 168
 169     PObj_get_FLAGS(key) |= KEY_pmc_FLAG;
 170     Parrot_ex_throw_from_c_args(interp, NULL, 1, "this is broken - see slice.pmc");
 171 }
 172
 173
 174 /*
 175
 176 =item C<void key_set_integer(PARROT_INTERP, PMC *key, INTVAL value)>
 177
 178 Set the integer C<value> in C<key>.
 179
 180 =cut
 181
 182 */
 183
 184 PARROT_EXPORT
 185 void
 186 key_set_integer(PARROT_INTERP, ARGMOD(PMC *key), INTVAL value)
 187 {
 188     ASSERT_ARGS(key_set_integer)
 189     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 190     PObj_get_FLAGS(key) |=  KEY_integer_FLAG;
 191     SETATTR_Key_int_key(interp, key, value);
 192
 193     return;
 194 }
 195
 196
 197 /*
 198
 199 =item C<void key_set_register(PARROT_INTERP, PMC *key, INTVAL value, INTVAL
 200 flag)>
 201
 202 Set the register C<value> in C<key>.
 203
 204 =cut
 205
 206 */
 207
 208 PARROT_EXPORT
 209 void
 210 key_set_register(PARROT_INTERP, ARGMOD(PMC *key), INTVAL value, INTVAL flag)
 211 {
 212     ASSERT_ARGS(key_set_register)
 213     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 214     PObj_get_FLAGS(key) |=  KEY_register_FLAG | flag;
 215     SETATTR_Key_int_key(interp, key, value);
 216
 217     return;
 218 }
 219
 220
 221 /*
 222
 223 =item C<void key_set_number(PARROT_INTERP, PMC *key, FLOATVAL value)>
 224
 225 Set the number C<value> in C<key>.
 226
 227 =cut
 228
 229 */
 230
 231 PARROT_EXPORT
 232 void
 233 key_set_number(PARROT_INTERP, ARGMOD(PMC *key), FLOATVAL value)
 234 {
 235     ASSERT_ARGS(key_set_number)
 236     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 237     PObj_get_FLAGS(key) |=  KEY_number_FLAG;
 238     SETATTR_Key_num_key(interp, key, value);
 239
 240     return;
 241 }
 242
 243
 244 /*
 245
 246 =item C<void key_set_string(PARROT_INTERP, PMC *key, STRING *value)>
 247
 248 Set the string C<value> in C<key>.
 249
 250 =cut
 251
 252 */
 253
 254 PARROT_EXPORT
 255 void
 256 key_set_string(PARROT_INTERP, ARGMOD(PMC *key), ARGIN(STRING *value))
 257 {
 258     ASSERT_ARGS(key_set_string)
 259     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 260     PObj_get_FLAGS(key) |=  KEY_string_FLAG;
 261     SETATTR_Key_str_key(interp, key, value);
 262
 263     return;
 264 }
 265
 266
 267 /*
 268
 269 =item C<void key_set_pmc(PARROT_INTERP, PMC *key, PMC *value)>
 270
 271 Set the PMC C<value> in C<key>.
 272
 273 =cut
 274
 275 */
 276
 277 PARROT_EXPORT
 278 void
 279 key_set_pmc(PARROT_INTERP, ARGMOD(PMC *key), ARGIN(PMC *value))
 280 {
 281     ASSERT_ARGS(key_set_pmc)
 282     PObj_get_FLAGS(key) &= ~KEY_type_FLAGS;
 283     PObj_get_FLAGS(key) |=  KEY_pmc_FLAG;
 284
 285     /*
 286      * XXX leo
 287      * what for is this indirection?
 288      */
 289     Parrot_ex_throw_from_c_args(interp, NULL, 1, "this is broken - see slice.pmc");
 290 }
 291
 292
 293 /*
 294
 295 =item C<INTVAL key_type(PARROT_INTERP, const PMC *key)>
 296
 297 Returns the type of C<key>.
 298
 299 =cut
 300
 301 */
 302
 303 PARROT_EXPORT
 304 PARROT_WARN_UNUSED_RESULT
 305 INTVAL
 306 key_type(SHIM_INTERP, ARGIN(const PMC *key))
 307 {
 308     ASSERT_ARGS(key_type)
 309     return (PObj_get_FLAGS(key) & KEY_type_FLAGS) & ~KEY_register_FLAG;
 310 }
 311
 312
 313 /*
 314
 315 =item C<INTVAL key_integer(PARROT_INTERP, PMC *key)>
 316
 317 Translates a key value into an integer.
 318 Takes an interpreter name and pointer to a key.
 319 Returns an integer value corresponding to the key.
 320
 321 =cut
 322
 323 */
 324
 325 PARROT_EXPORT
 326 PARROT_WARN_UNUSED_RESULT
 327 INTVAL
 328 key_integer(PARROT_INTERP, ARGIN(PMC *key))
 329 {
 330     ASSERT_ARGS(key_integer)
 331     INTVAL   int_key;
 332     STRING  *str_key;
 333     FLOATVAL num_key;
 334
 335     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 336         case KEY_integer_FLAG:
 337             GETATTR_Key_int_key(interp, key, int_key);
 338             return int_key;
 339         case KEY_integer_FLAG | KEY_register_FLAG:
 340             GETATTR_Key_int_key(interp, key, int_key);
 341             return REG_INT(interp, int_key);
 342
 343         case KEY_number_FLAG:
 344             GETATTR_Key_num_key(interp, key, num_key);
 345             return (INTVAL)num_key;
 346         case KEY_number_FLAG | KEY_register_FLAG:
 347             GETATTR_Key_int_key(interp, key, int_key);
 348             return (INTVAL)REG_NUM(interp, int_key);
 349
 350         case KEY_pmc_FLAG | KEY_register_FLAG:
 351             {
 352             PMC *reg;
 353             GETATTR_Key_int_key(interp, key, int_key);
 354             reg = REG_PMC(interp, int_key);
 355             return VTABLE_get_integer(interp, reg);
 356             }
 357
 358         case KEY_string_FLAG:
 359             GETATTR_Key_str_key(interp, key, str_key);
 360             return Parrot_str_to_int(interp, str_key);
 361         case KEY_string_FLAG | KEY_register_FLAG:
 362             {
 363             STRING *s_reg;
 364             GETATTR_Key_int_key(interp, key, int_key);
 365             s_reg = REG_STR(interp, int_key);
 366             return Parrot_str_to_int(interp, s_reg);
 367             }
 368
 369         default:
 370             break;
 371     }
 372
 373     return VTABLE_get_integer(interp, key);
 374 }
 375
 376
 377 /*
 378
 379 =item C<FLOATVAL key_number(PARROT_INTERP, PMC *key)>
 380
 381 Translates a key value into a number.
 382 Takes an interpreter name and pointer to a key.
 383 Returns a number value corresponding to the key.
 384 Throws an exception if the key is not a valid number.
 385
 386 =cut
 387
 388 */
 389
 390 PARROT_EXPORT
 391 PARROT_WARN_UNUSED_RESULT
 392 FLOATVAL
 393 key_number(PARROT_INTERP, ARGIN(PMC *key))
 394 {
 395     ASSERT_ARGS(key_number)
 396     INTVAL   int_key;
 397     FLOATVAL num_key;
 398
 399     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 400     case KEY_number_FLAG:
 401         GETATTR_Key_num_key(interp, key, num_key);
 402         return num_key;
 403     case KEY_number_FLAG | KEY_register_FLAG:
 404         GETATTR_Key_int_key(interp, key, int_key);
 405         return REG_NUM(interp, int_key);
 406     case KEY_pmc_FLAG:
 407         return VTABLE_get_number(interp, key);
 408     case KEY_pmc_FLAG | KEY_register_FLAG:
 409         {
 410         PMC *reg;
 411         GETATTR_Key_int_key(interp, key, int_key);
 412         reg = REG_PMC(interp, int_key);
 413         return VTABLE_get_number(interp, reg);
 414         }
 415     default:
 416         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
 417             "Key not a number!\n");
 418     }
 419 }
 420
 421
 422 /*
 423
 424 =item C<STRING * key_string(PARROT_INTERP, PMC *key)>
 425
 426 Translates a key value into a string.  Takes an interpreter name and pointer to
 427 a key.  Returns a string value corresponding to the key.
 428
 429 =cut
 430
 431 */
 432
 433 PARROT_WARN_UNUSED_RESULT
 434 PARROT_CAN_RETURN_NULL
 435 STRING *
 436 key_string(PARROT_INTERP, ARGIN(PMC *key))
 437 {
 438     ASSERT_ARGS(key_string)
 439
 440     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 441         /* remember to COW strings instead of returning them directly */
 442         case KEY_string_FLAG:
 443         {
 444             STRING *s;
 445             GETATTR_Key_str_key(interp, key, s);
 446             if (s)
 447                 s = Parrot_str_new_COW(interp, s);
 448             return s;
 449         }
 450         case KEY_string_FLAG | KEY_register_FLAG:
 451         {
 452             INTVAL int_key;
 453             STRING *s;
 454             GETATTR_Key_int_key(interp, key, int_key);
 455             s = REG_STR(interp, int_key);
 456             if (s)
 457                 s = Parrot_str_new_COW(interp, s);
 458             return s;
 459         }
 460         case KEY_pmc_FLAG | KEY_register_FLAG:
 461         {
 462             INTVAL int_key;
 463             PMC *reg;
 464             GETATTR_Key_int_key(interp, key, int_key);
 465             reg = REG_PMC(interp, int_key);
 466             return VTABLE_get_string(interp, reg);
 467         }
 468         case KEY_integer_FLAG:
 469         {
 470             INTVAL int_key;
 471             GETATTR_Key_int_key(interp, key, int_key);
 472             return Parrot_str_from_int(interp, int_key);
 473         }
 474         case KEY_integer_FLAG | KEY_register_FLAG:
 475         {
 476             INTVAL int_key;
 477             GETATTR_Key_int_key(interp, key, int_key);
 478             return Parrot_str_from_int(interp, REG_INT(interp, int_key));
 479         }
 480         case KEY_number_FLAG:
 481         {
 482             FLOATVAL num_key;
 483             GETATTR_Key_num_key(interp, key, num_key);
 484             return Parrot_str_from_num(interp, num_key);
 485         }
 486         case KEY_number_FLAG | KEY_register_FLAG:
 487         {
 488             INTVAL int_key;
 489             GETATTR_Key_int_key(interp, key, int_key);
 490             return Parrot_str_from_num(interp, REG_NUM(interp, int_key));
 491         }
 492         default:
 493         case KEY_pmc_FLAG:
 494             return VTABLE_get_string(interp, key);
 495     }
 496 }
 497
 498
 499 /*
 500
 501 =item C<PMC * key_pmc(PARROT_INTERP, PMC *key)>
 502
 503 These functions return the integer/number/string/PMC values of C<key> if
 504 possible. Otherwise they throw exceptions.
 505
 506 =cut
 507
 508 */
 509
 510 PARROT_EXPORT
 511 PARROT_CANNOT_RETURN_NULL
 512 PARROT_WARN_UNUSED_RESULT
 513 PMC *
 514 key_pmc(PARROT_INTERP, ARGIN(PMC *key))
 515 {
 516     ASSERT_ARGS(key_pmc)
 517     INTVAL int_key;
 518
 519     switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 520     case KEY_pmc_FLAG | KEY_register_FLAG:
 521         GETATTR_Key_int_key(interp, key, int_key);
 522         return REG_PMC(interp, int_key);
 523     default:
 524         return key;
 525     }
 526 }
 527
 528
 529 /*
 530
 531 =item C<PMC * key_next(PARROT_INTERP, PMC *key)>
 532
 533 Returns the next key if C<key> is in a sequence of linked keys.
 534
 535 =cut
 536
 537 */
 538
 539 PARROT_EXPORT
 540 PARROT_CAN_RETURN_NULL
 541 PARROT_WARN_UNUSED_RESULT
 542 PMC *
 543 key_next(PARROT_INTERP, ARGIN(PMC *key))
 544 {
 545     ASSERT_ARGS(key_next)
 546     PMC *next_key;
 547
 548     if (VTABLE_isa(interp, key, CONST_STRING(interp, "Key"))) {
 549         GETATTR_Key_next_key(interp, key, next_key);
 550         return next_key;
 551     }
 552
 553     return NULL;
 554 }
 555
 556
 557 /*
 558
 559 =item C<PMC * key_append(PARROT_INTERP, PMC *key1, PMC *key2)>
 560
 561 Appends C<key2> to C<key1>.
 562
 563 Note that if C<key1> is not the last key in a sequence of linked keys then the
 564 last key will be found and C<key2> appended to that.
 565
 566 Returns C<key1>.
 567
 568 =cut
 569
 570 */
 571
 572 PARROT_EXPORT
 573 PARROT_CANNOT_RETURN_NULL
 574 PARROT_IGNORABLE_RESULT
 575 PMC *
 576 key_append(PARROT_INTERP, ARGMOD(PMC *key1), ARGIN(PMC *key2))
 577 {
 578     ASSERT_ARGS(key_append)
 579     PMC *tail = key1;
 580     PMC *tail_next;
 581
 582     GETATTR_Key_next_key(interp, tail, tail_next);
 583
 584     while (tail_next) {
 585         tail = tail_next;
 586         GETATTR_Key_next_key(interp, tail, tail_next);
 587     }
 588
 589     SETATTR_Key_next_key(interp, tail, key2);
 590
 591     return key1;
 592 }
 593
 594
 595 /*
 596
 597 =item C<void key_mark(PARROT_INTERP, PMC *key)>
 598
 599 Marks C<key> as live.
 600
 601 =cut
 602
 603 */
 604
 605 PARROT_EXPORT
 606 void
 607 key_mark(PARROT_INTERP, ARGIN(PMC *key))
 608 {
 609     ASSERT_ARGS(key_mark)
 610     PMC          *next_key;
 611     const UINTVAL flags = PObj_get_FLAGS(key) & KEY_type_FLAGS;
 612
 613     if (flags == KEY_string_FLAG) {
 614         STRING *str_key;
 615         GETATTR_Key_str_key(interp, key, str_key);
 616         Parrot_gc_mark_STRING_alive(interp, str_key);
 617     }
 618
 619     /* Mark next key */
 620     if ((flags == KEY_string_FLAG) || (flags == KEY_pmc_FLAG)) {
 621         GETATTR_Key_next_key(interp, key, next_key);
 622         Parrot_gc_mark_PMC_alive(interp, next_key);
 623     }
 624
 625 }
 626
 627
 628 /*
 629
 630 =item C<STRING * key_set_to_string(PARROT_INTERP, PMC *key)>
 631
 632 Translates a series of key values into strings, quoted or bracketed if
 633 appropriate.  Takes an interpreter name and pointer to a key.  Returns a
 634 string value corresponding to the key.
 635
 636 =cut
 637
 638 */
 639
 640 PARROT_EXPORT
 641 PARROT_CANNOT_RETURN_NULL
 642 PARROT_WARN_UNUSED_RESULT
 643 STRING *
 644 key_set_to_string(PARROT_INTERP, ARGIN_NULLOK(PMC *key))
 645 {
 646     ASSERT_ARGS(key_set_to_string)
 647     STRING * const semicolon = CONST_STRING(interp, " ; ");
 648     STRING * const quote     = CONST_STRING(interp, "'");
 649     STRING        *value     = Parrot_str_new(interp, "[ ", 2);
 650     PMC           *next_key;
 651     INTVAL         int_key;
 652     STRING        *str_key;
 653
 654     while (key != NULL) {
 655         switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
 656             case KEY_integer_FLAG:
 657                 GETATTR_Key_int_key(interp, key, int_key);
 658                 value = Parrot_str_append(interp, value,
 659                     Parrot_str_from_int(interp, int_key));
 660                 break;
 661             case KEY_number_FLAG:
 662                 GETATTR_Key_int_key(interp, key, int_key);
 663                 value = Parrot_str_append(interp, value,
 664                     Parrot_str_from_num(interp, (FLOATVAL)int_key));
 665                 break;
 666             case KEY_string_FLAG:
 667                 GETATTR_Key_str_key(interp, key, str_key);
 668                 value = Parrot_str_append(interp, value, quote);
 669                 value = Parrot_str_append(interp, value, str_key);
 670                 value = Parrot_str_append(interp, value, quote);
 671                 break;
 672             case KEY_pmc_FLAG:
 673                 value = Parrot_str_append(interp, value,
 674                     VTABLE_get_string(interp, key));
 675                 break;
 676             case KEY_integer_FLAG | KEY_register_FLAG:
 677                 GETATTR_Key_int_key(interp, key, int_key);
 678                 value = Parrot_str_append(interp, value,
 679                         Parrot_str_from_int(interp,
 680                             REG_INT(interp, int_key)));
 681                 break;
 682             case KEY_number_FLAG | KEY_register_FLAG:
 683                 GETATTR_Key_int_key(interp, key, int_key);
 684                 value = Parrot_str_append(interp, value,
 685                         Parrot_str_from_num(interp,
 686                             REG_NUM(interp, int_key)));
 687                 break;
 688             case KEY_string_FLAG | KEY_register_FLAG:
 689                 value = Parrot_str_append(interp, value, quote);
 690                 GETATTR_Key_int_key(interp, key, int_key);
 691                 value = Parrot_str_append(interp, value,
 692                     REG_STR(interp, int_key));
 693                 value = Parrot_str_append(interp, value, quote);
 694                 break;
 695             case KEY_pmc_FLAG | KEY_register_FLAG:
 696                 {
 697                 PMC *reg;
 698                 GETATTR_Key_int_key(interp, key, int_key);
 699                 reg = REG_PMC(interp, int_key);
 700                 value           = Parrot_str_append(interp, value,
 701                                     VTABLE_get_string(interp, reg));
 702                 }
 703                 break;
 704             default:
 705                 value = Parrot_str_append(interp, value, CONST_STRING(interp, "Key type unknown"));
 706                 break;
 707         }
 708
 709         GETATTR_Key_next_key(interp, key, next_key);
 710         if (next_key)
 711             value = Parrot_str_append(interp, value, semicolon);
 712
 713         GETATTR_Key_next_key(interp, key, key);
 714     }
 715
 716     value = Parrot_str_append(interp, value, Parrot_str_new(interp, " ]", 2));
 717     return value;
 718 }
 719
 720 /*
 721
 722 =back
 723
 724 =head1 SEE ALSO
 725
 726 F<include/parrot/key.h>.
 727
 728 =head1 HISTORY
 729
 730 Initial version by Jeff G. on 2001.12.05.
 731
 732 =cut
 733
 734 */
 735
 736
 737 /*
 738  * Local variables:
 739  *   c-file-style: "parrot"
 740  * End:
 741  * vim: expandtab shiftwidth=4:
 742  */