src/key.c

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