src/spf_vtable.c

   1 /*
   2 Copyright (C) 2001-2007, The Perl Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/spf_vtable.c - Parrot sprintf
   8
   9 =head1 DESCRIPTION
  10
  11 Implements the two families of functions C<Parrot_sprintf> may use to
  12 retrieve arguments.
  13
  14 =head2 Var args Functions
  15
  16 =over 4
  17
  18 =cut
  19
  20 */
  21
  22 #define IN_SPF_SYSTEM
  23
  24 #include "parrot/parrot.h"
  25
  26 #include <stdarg.h>
  27 #include "spf_vtable.str"
  28
  29 /* HEADERIZER HFILE: none */
  30
  31 /* HEADERIZER BEGIN: static */
  32 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  33
  34 PARROT_CANNOT_RETURN_NULL
  35 PARROT_WARN_UNUSED_RESULT
  36 static STRING * getchr_pmc(PARROT_INTERP,
  37     SHIM(INTVAL size),
  38     ARGMOD(SPRINTF_OBJ *obj))
  39         __attribute__nonnull__(1)
  40         __attribute__nonnull__(3)
  41         FUNC_MODIFIES(*obj);
  42
  43 PARROT_CANNOT_RETURN_NULL
  44 PARROT_WARN_UNUSED_RESULT
  45 static STRING * getchr_va(PARROT_INTERP,
  46     SHIM(INTVAL size),
  47     ARGIN(SPRINTF_OBJ *obj))
  48         __attribute__nonnull__(1)
  49         __attribute__nonnull__(3);
  50
  51 PARROT_WARN_UNUSED_RESULT
  52 static HUGEFLOATVAL getfloat_pmc(PARROT_INTERP,
  53     INTVAL size,
  54     ARGIN(SPRINTF_OBJ *obj))
  55         __attribute__nonnull__(1)
  56         __attribute__nonnull__(3);
  57
  58 PARROT_WARN_UNUSED_RESULT
  59 static HUGEFLOATVAL getfloat_va(PARROT_INTERP,
  60     INTVAL size,
  61     ARGIN(SPRINTF_OBJ *obj))
  62         __attribute__nonnull__(1)
  63         __attribute__nonnull__(3);
  64
  65 PARROT_WARN_UNUSED_RESULT
  66 static HUGEINTVAL getint_pmc(PARROT_INTERP,
  67     INTVAL size,
  68     ARGIN(SPRINTF_OBJ *obj))
  69         __attribute__nonnull__(1)
  70         __attribute__nonnull__(3);
  71
  72 PARROT_WARN_UNUSED_RESULT
  73 static HUGEINTVAL getint_va(PARROT_INTERP,
  74     INTVAL size,
  75     ARGIN(SPRINTF_OBJ *obj))
  76         __attribute__nonnull__(1)
  77         __attribute__nonnull__(3);
  78
  79 PARROT_WARN_UNUSED_RESULT
  80 PARROT_CANNOT_RETURN_NULL
  81 static void * getptr_pmc(PARROT_INTERP,
  82     SHIM(INTVAL size),
  83     ARGIN(SPRINTF_OBJ *obj))
  84         __attribute__nonnull__(1)
  85         __attribute__nonnull__(3);
  86
  87 PARROT_WARN_UNUSED_RESULT
  88 PARROT_CAN_RETURN_NULL
  89 static void * getptr_va(SHIM_INTERP,
  90     SHIM(INTVAL size),
  91     ARGIN(SPRINTF_OBJ *obj))
  92         __attribute__nonnull__(3);
  93
  94 PARROT_WARN_UNUSED_RESULT
  95 PARROT_CANNOT_RETURN_NULL
  96 static STRING * getstring_pmc(PARROT_INTERP,
  97     SHIM(INTVAL size),
  98     ARGIN(SPRINTF_OBJ *obj))
  99         __attribute__nonnull__(1)
 100         __attribute__nonnull__(3);
 101
 102 PARROT_WARN_UNUSED_RESULT
 103 PARROT_CANNOT_RETURN_NULL
 104 static STRING * getstring_va(PARROT_INTERP,
 105     INTVAL size,
 106     ARGIN(SPRINTF_OBJ *obj))
 107         __attribute__nonnull__(1)
 108         __attribute__nonnull__(3);
 109
 110 PARROT_WARN_UNUSED_RESULT
 111 static UHUGEINTVAL getuint_pmc(PARROT_INTERP,
 112     INTVAL size,
 113     ARGIN(SPRINTF_OBJ *obj))
 114         __attribute__nonnull__(1)
 115         __attribute__nonnull__(3);
 116
 117 PARROT_WARN_UNUSED_RESULT
 118 static UHUGEINTVAL getuint_va(PARROT_INTERP,
 119     INTVAL size,
 120     ARGIN(SPRINTF_OBJ *obj))
 121         __attribute__nonnull__(1)
 122         __attribute__nonnull__(3);
 123
 124 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 125 /* HEADERIZER END: static */
 126
 127 /*
 128
 129 =item C<static STRING * getchr_va>
 130
 131 Gets a C<char> out of the C<va_list> in C<obj> and returns it as a
 132 Parrot C<STRING>.
 133
 134 C<size> is unused.
 135
 136 =cut
 137
 138 */
 139
 140 PARROT_CANNOT_RETURN_NULL
 141 PARROT_WARN_UNUSED_RESULT
 142 static STRING *
 143 getchr_va(PARROT_INTERP, SHIM(INTVAL size), ARGIN(SPRINTF_OBJ *obj))
 144 {
 145     va_list *arg = (va_list *)(obj->data);
 146
 147     /* char promoted to int */
 148     char ch = (char)va_arg(*arg, int);
 149
 150     return string_make(interp, &ch, 1, "iso-8859-1", 0);
 151 }
 152
 153 /*
 154
 155 =item C<static HUGEINTVAL getint_va>
 156
 157 Gets an integer out of the C<va_list> in C<obj> and returns it as a
 158 Parrot C<STRING>.
 159
 160 C<size> is an C<enum spf_type_t> value which indicates the storage type
 161 of the integer.
 162
 163 =cut
 164
 165 */
 166
 167 PARROT_WARN_UNUSED_RESULT
 168 static HUGEINTVAL
 169 getint_va(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 170 {
 171     va_list * const arg = (va_list *)(obj->data);
 172
 173     switch (size) {
 174     case SIZE_REG:
 175         return va_arg(*arg, int);
 176
 177     case SIZE_SHORT:
 178         /* "'short int' is promoted to 'int' when passed through '...'" */
 179         return (short)va_arg(*arg, int);
 180
 181     case SIZE_LONG:
 182         return va_arg(*arg, long);
 183
 184     case SIZE_HUGE:
 185         return va_arg(*arg, HUGEINTVAL);
 186
 187     case SIZE_XVAL:
 188         return va_arg(*arg, INTVAL);
 189
 190     case SIZE_OPCODE:
 191         return va_arg(*arg, opcode_t);
 192
 193     case SIZE_PMC:{
 194             PMC * const pmc = (PMC *)va_arg(*arg, PMC *);
 195             return VTABLE_get_integer(interp, pmc);
 196         }
 197     default:
 198         PANIC(interp, "Invalid int type!");
 199     }
 200 }
 201
 202 /*
 203
 204 =item C<static UHUGEINTVAL getuint_va>
 205
 206 Gets an unsigned integer out of the C<va_list> in C<obj> and returns it
 207 as a Parrot C<STRING>.
 208
 209 C<size> is an C<enum spf_type_t> value which indicates the storage type
 210 of the integer.
 211
 212 =cut
 213
 214 */
 215
 216 PARROT_WARN_UNUSED_RESULT
 217 static UHUGEINTVAL
 218 getuint_va(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 219 {
 220     va_list * const arg = (va_list *)(obj->data);
 221
 222     switch (size) {
 223     case SIZE_REG:
 224         return va_arg(*arg, unsigned int);
 225
 226     case SIZE_SHORT:
 227         /* short int promoted HLAGHLAGHLAGH. See note above */
 228         return (unsigned short)va_arg(*arg, unsigned int);
 229
 230     case SIZE_LONG:
 231         return va_arg(*arg, unsigned long);
 232
 233     case SIZE_HUGE:
 234         return va_arg(*arg, UHUGEINTVAL);
 235
 236     case SIZE_XVAL:
 237         return va_arg(*arg, UINTVAL);
 238
 239     case SIZE_OPCODE:
 240         return va_arg(*arg, opcode_t);
 241
 242     case SIZE_PMC:{
 243             PMC * const pmc = va_arg(*arg, PMC *);
 244             return (UINTVAL)VTABLE_get_integer(interp, pmc);
 245         }
 246     default:
 247         PANIC(interp, "Invalid uint type!");
 248     }
 249 }
 250
 251 /*
 252
 253 =item C<static HUGEFLOATVAL getfloat_va>
 254
 255 Gets an floating-point number out of the C<va_list> in C<obj> and
 256 returns it as a Parrot C<STRING>.
 257
 258 C<size> is an C<enum spf_type_t> value which indicates the storage type of
 259 the number.
 260
 261 =cut
 262
 263 */
 264
 265 PARROT_WARN_UNUSED_RESULT
 266 static HUGEFLOATVAL
 267 getfloat_va(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 268 {
 269     va_list * const arg = (va_list *)(obj->data);
 270
 271     switch (size) {
 272     case SIZE_SHORT:
 273         /* float is promoted to double */
 274         return (HUGEFLOATVAL)(float)va_arg(*arg, double);
 275
 276     case SIZE_REG:
 277         return (HUGEFLOATVAL)(double)va_arg(*arg, double);
 278
 279     case SIZE_HUGE:
 280         return (HUGEFLOATVAL)(HUGEFLOATVAL) va_arg(*arg, HUGEFLOATVAL);
 281
 282     case SIZE_XVAL:
 283         return (HUGEFLOATVAL)(FLOATVAL) va_arg(*arg, FLOATVAL);
 284
 285     case SIZE_PMC:{
 286             PMC * const pmc = (PMC *)va_arg(*arg, PMC *);
 287
 288             return (HUGEFLOATVAL)(VTABLE_get_number(interp, pmc));
 289         }
 290     default:
 291         real_exception(interp, NULL, INVALID_CHARACTER,
 292                 "Internal sprintf doesn't recognize size %d for a float", size);
 293     }
 294 }
 295
 296 /*
 297
 298 =item C<static STRING * getstring_va>
 299
 300 Gets an string out of the C<va_list> in C<obj> and returns it as a
 301 Parrot C<STRING>.
 302
 303 C<size> is an C<enum spf_type_t> value which indicates the storage type
 304 of the string.
 305
 306 =cut
 307
 308 */
 309
 310 PARROT_WARN_UNUSED_RESULT
 311 PARROT_CANNOT_RETURN_NULL
 312 static STRING *
 313 getstring_va(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 314 {
 315     va_list * const arg = (va_list *)(obj->data);
 316
 317     switch (size) {
 318     case SIZE_REG:
 319         {
 320             const char * const cstr = (char *)va_arg(*arg, char *);
 321
 322             return cstr2pstr(cstr);
 323         }
 324
 325     case SIZE_PSTR:
 326         {
 327             STRING * const s = (STRING *)va_arg(*arg, STRING *);
 328             return s ? s : CONST_STRING(interp, "(null)");
 329
 330         }
 331
 332     case SIZE_PMC:
 333         {
 334             PMC * const pmc = (PMC *)va_arg(*arg, PMC *);
 335             STRING * const s = VTABLE_get_string(interp, pmc);
 336
 337             return s;
 338         }
 339
 340     default:
 341         real_exception(interp, NULL, INVALID_CHARACTER,
 342                 "Internal sprintf doesn't recognize size %d for a string",
 343                 size);
 344     }
 345 }
 346
 347 /*
 348
 349 =item C<static void * getptr_va>
 350
 351 Gets a C<void *> out of the C<va_list> in C<obj> and returns it.
 352
 353 C<size> is unused.
 354
 355 =cut
 356
 357 */
 358
 359 PARROT_WARN_UNUSED_RESULT
 360 PARROT_CAN_RETURN_NULL
 361 static void *
 362 getptr_va(SHIM_INTERP, SHIM(INTVAL size), ARGIN(SPRINTF_OBJ *obj))
 363 {
 364     va_list * const arg = (va_list *)(obj->data);
 365
 366     return (void *)va_arg(*arg, void *);
 367 }
 368
 369 const SPRINTF_OBJ va_core = {
 370     NULL, 0, getchr_va, getint_va, getuint_va,
 371     getfloat_va, getstring_va, getptr_va
 372 };
 373
 374 /*
 375
 376 =back
 377
 378 =head2 PMC Functions
 379
 380 =over 4
 381
 382 =item C<static STRING * getchr_pmc>
 383
 384 Same as C<getchr_va()> except that a vtable is used to get the value
 385 from C<obj>.
 386
 387 =cut
 388
 389 */
 390
 391 PARROT_CANNOT_RETURN_NULL
 392 PARROT_WARN_UNUSED_RESULT
 393 static STRING *
 394 getchr_pmc(PARROT_INTERP, SHIM(INTVAL size), ARGMOD(SPRINTF_OBJ *obj))
 395 {
 396     STRING *s;
 397     PMC * const tmp = VTABLE_get_pmc_keyed_int(interp,
 398             ((PMC *)obj->data),
 399             (obj->index));
 400
 401     obj->index++;
 402     s = VTABLE_get_string(interp, tmp);
 403     /* XXX string_copy like below? + adjusting bufused */
 404     return string_substr(interp, s, 0, 1, NULL, 0);
 405 }
 406
 407 /*
 408
 409 =item C<static HUGEINTVAL getint_pmc>
 410
 411 Same as C<getint_va()> except that a vtable is used to get the value
 412 from C<obj>.
 413
 414 =cut
 415
 416 */
 417
 418 PARROT_WARN_UNUSED_RESULT
 419 static HUGEINTVAL
 420 getint_pmc(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 421 {
 422     HUGEINTVAL ret;
 423     PMC * const tmp = VTABLE_get_pmc_keyed_int(interp,
 424             ((PMC *)obj->data),
 425             (obj->index));
 426
 427     obj->index++;
 428     ret = VTABLE_get_integer(interp, tmp);
 429
 430     switch (size) {
 431     case SIZE_SHORT:
 432         ret = (short)ret;
 433         break;
 434         /* case SIZE_REG: ret=(HUGEINTVAL)(int)ret; break; */
 435     case SIZE_LONG:
 436         ret = (long)ret;
 437         break;
 438     default:
 439         /* nothing */ ;
 440     }
 441
 442     return ret;
 443 }
 444
 445 /*
 446
 447 =item C<static UHUGEINTVAL getuint_pmc>
 448
 449 Same as C<getuint_va()> except that a vtable is used to get the value
 450 from C<obj>.
 451
 452 =cut
 453
 454 */
 455
 456 PARROT_WARN_UNUSED_RESULT
 457 static UHUGEINTVAL
 458 getuint_pmc(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 459 {
 460     UHUGEINTVAL ret;
 461     PMC * const tmp = VTABLE_get_pmc_keyed_int(interp,
 462             ((PMC *)obj->data),
 463             (obj->index));
 464
 465     obj->index++;
 466     ret = (UINTVAL)VTABLE_get_integer(interp, tmp);
 467
 468     switch (size) {
 469     case SIZE_SHORT:
 470         ret = (unsigned short)ret;
 471         break;
 472         /* case SIZE_REG: * ret=(UHUGEINTVAL)(unsigned int)ret; * break; */
 473     case SIZE_LONG:
 474         ret = (unsigned long)ret;
 475         break;
 476     default:
 477         /* nothing */ ;
 478     }
 479
 480     return ret;
 481 }
 482
 483 /*
 484
 485 =item C<static HUGEFLOATVAL getfloat_pmc>
 486
 487 Same as C<getfloat_va()> except that a vtable is used to get the value
 488 from C<obj>.
 489
 490 =cut
 491
 492 */
 493
 494 PARROT_WARN_UNUSED_RESULT
 495 static HUGEFLOATVAL
 496 getfloat_pmc(PARROT_INTERP, INTVAL size, ARGIN(SPRINTF_OBJ *obj))
 497 {
 498     HUGEFLOATVAL ret;
 499     PMC * const tmp = VTABLE_get_pmc_keyed_int(interp,
 500             ((PMC *)obj->data),
 501             (obj->index));
 502
 503     obj->index++;
 504     ret = (HUGEFLOATVAL)(VTABLE_get_number(interp, tmp));
 505
 506     switch (size) {
 507     case SIZE_SHORT:
 508         ret = (HUGEFLOATVAL)(float)ret;
 509         break;
 510         /* case SIZE_REG: * ret=(HUGEFLOATVAL)(double)ret; * break; */
 511     default:
 512         /* nothing */ ;
 513     }
 514
 515     return ret;
 516 }
 517
 518 /*
 519
 520 =item C<static STRING * getstring_pmc>
 521
 522 Same as C<getstring_va()> except that a vtable is used to get the value
 523 from C<obj>.
 524
 525 =cut
 526
 527 */
 528
 529 PARROT_WARN_UNUSED_RESULT
 530 PARROT_CANNOT_RETURN_NULL
 531 static STRING *
 532 getstring_pmc(PARROT_INTERP, SHIM(INTVAL size), ARGIN(SPRINTF_OBJ *obj))
 533 {
 534     STRING *s;
 535     PMC * const tmp = VTABLE_get_pmc_keyed_int(interp,
 536             ((PMC *)obj->data),
 537             (obj->index));
 538
 539     obj->index++;
 540     s = (STRING *)(VTABLE_get_string(interp, tmp));
 541     return s;
 542 }
 543
 544 /*
 545
 546 =item C<static void * getptr_pmc>
 547
 548 Same as C<getptr_va()> except that a vtable is used to get the value
 549 from C<obj>.
 550
 551 =cut
 552
 553 */
 554
 555 PARROT_WARN_UNUSED_RESULT
 556 PARROT_CANNOT_RETURN_NULL
 557 static void *
 558 getptr_pmc(PARROT_INTERP, SHIM(INTVAL size), ARGIN(SPRINTF_OBJ *obj))
 559 {
 560     PMC * const tmp = VTABLE_get_pmc_keyed_int(interp,
 561             ((PMC *)obj->data), (obj->index));
 562     const INTVAL i  = VTABLE_get_integer(interp, tmp);
 563
 564     obj->index++;
 565
 566     /* XXX correct? */
 567     return (void *)i;
 568 }
 569
 570 SPRINTF_OBJ pmc_core = {
 571     NULL, 0, getchr_pmc, getint_pmc, getuint_pmc,
 572     getfloat_pmc, getstring_pmc, getptr_pmc
 573 };
 574
 575 /*
 576
 577 =back
 578
 579 =head1 SEE ALSO
 580
 581 F<src/misc.h>, F<src/misc.c>, F<src/spf_render.c>.
 582
 583 =head1 HISTORY
 584
 585 When I was first working on this implementation of sprintf, I ran into a
 586 problem.  I wanted to re-use the implementation for a Parrot
 587 bytecode-level sprintf, but that couldn't be done, since it used C<va_*>
 588 directly.  For a while I thought about generating two versions of the
 589 source with a Perl script, but that seemed like overkill. Eventually I
 590 came across this idea -- pass in a specialized vtable with methods for
 591 extracting things from the arglist, whatever it happened to be.  This is
 592 the result.
 593
 594 =head1 TODO
 595
 596 In the future, it may be deemed desirable to similarly vtable-ize
 597 appending things to the string, allowing for faster C<PIO_printf()> &c,
 598 as well as a version that writes directly to a C string. However, at
 599 this point neither of those is needed.
 600
 601 =cut
 602
 603 */
 604
 605
 606 /*
 607  * Local variables:
 608  *   c-file-style: "parrot"
 609  * End:
 610  * vim: expandtab shiftwidth=4:
 611  */