src/spf_vtable.c

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