src/key.c

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