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