src/packfile/pf_items.c

   1 /*
   2 Copyright (C) 2001-2009, Parrot Foundation.
   3 $Id$
   4
   5 =head1 NAME
   6
   7 src/packfile/pf_items.c - Fetch/store packfile data
   8
   9 =head1 DESCRIPTION
  10
  11 Low level packfile functions to fetch and store Parrot data, i.e.
  12 C<INTVAL>, C<FLOATVAL>, C<STRING> ...
  13
  14 C<< PF_fetch_<item>() >> functions retrieve the datatype item from the
  15 opcode stream and convert byteordering or binary format on the fly,
  16 depending on the packfile header.
  17
  18 C<< PF_store_<item>() >> functions write the datatype item to the stream
  19 as is. These functions don't check the available size.
  20
  21 C<< PF_size_<item>() >> functions return the store size of item in
  22 C<opcode_t> units.
  23
  24 C<BE> and C<be> are short for "Big-endian", while C<LE> and C<le> are short
  25 for "little endian".
  26
  27 =head2 Functions
  28
  29 =over 4
  30
  31 =cut
  32
  33 */
  34
  35 #include "parrot/parrot.h"
  36
  37 /* HEADERIZER HFILE: include/parrot/packfile.h */
  38
  39 /* HEADERIZER BEGIN: static */
  40 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
  41
  42 static void cvt_num12_num16(
  43     ARGOUT(unsigned char *dest),
  44     ARGIN(const unsigned char *src))
  45         __attribute__nonnull__(1)
  46         __attribute__nonnull__(2)
  47         FUNC_MODIFIES(*dest);
  48
  49 static void cvt_num12_num16_le(
  50     ARGOUT(unsigned char *dest),
  51     ARGIN(const unsigned char *src))
  52         __attribute__nonnull__(1)
  53         __attribute__nonnull__(2)
  54         FUNC_MODIFIES(*dest);
  55
  56 static void cvt_num12_num8(
  57     ARGOUT(unsigned char *dest),
  58     ARGIN(const unsigned char *src))
  59         __attribute__nonnull__(1)
  60         __attribute__nonnull__(2)
  61         FUNC_MODIFIES(*dest);
  62
  63 static void cvt_num12_num8_le(
  64     ARGOUT(unsigned char *dest),
  65     ARGIN(const unsigned char *src))
  66         __attribute__nonnull__(1)
  67         __attribute__nonnull__(2)
  68         FUNC_MODIFIES(*dest);
  69
  70 static void cvt_num16_num12(
  71     ARGOUT(unsigned char *dest),
  72     ARGIN(const unsigned char *src))
  73         __attribute__nonnull__(1)
  74         __attribute__nonnull__(2)
  75         FUNC_MODIFIES(*dest);
  76
  77 static void cvt_num16_num12_be(
  78     ARGOUT(unsigned char *dest),
  79     ARGIN(const unsigned char *src))
  80         __attribute__nonnull__(1)
  81         __attribute__nonnull__(2)
  82         FUNC_MODIFIES(*dest);
  83
  84 static void cvt_num16_num8(
  85     ARGOUT(unsigned char *dest),
  86     ARGIN(const unsigned char *src))
  87         __attribute__nonnull__(1)
  88         __attribute__nonnull__(2)
  89         FUNC_MODIFIES(*dest);
  90
  91 static void cvt_num16_num8_be(
  92     ARGOUT(unsigned char *dest),
  93     ARGIN(const unsigned char *src))
  94         __attribute__nonnull__(1)
  95         __attribute__nonnull__(2)
  96         FUNC_MODIFIES(*dest);
  97
  98 static void cvt_num16_num8_le(
  99     ARGOUT(unsigned char *dest),
 100     ARGIN(const unsigned char *src))
 101         __attribute__nonnull__(1)
 102         __attribute__nonnull__(2)
 103         FUNC_MODIFIES(*dest);
 104
 105 static void cvt_num8_num12(
 106     ARGOUT(unsigned char *dest),
 107     ARGIN(const unsigned char *src))
 108         __attribute__nonnull__(1)
 109         __attribute__nonnull__(2)
 110         FUNC_MODIFIES(*dest);
 111
 112 static void cvt_num8_num12_be(
 113     ARGOUT(unsigned char *dest),
 114     ARGIN(const unsigned char *src))
 115         __attribute__nonnull__(1)
 116         __attribute__nonnull__(2)
 117         FUNC_MODIFIES(*dest);
 118
 119 static void cvt_num8_num16(
 120     ARGOUT(unsigned char *dest),
 121     ARGIN(const unsigned char *src))
 122         __attribute__nonnull__(1)
 123         __attribute__nonnull__(2)
 124         FUNC_MODIFIES(*dest);
 125
 126 static void cvt_num8_num16_be(
 127     ARGOUT(unsigned char *dest),
 128     ARGIN(const unsigned char *src))
 129         __attribute__nonnull__(1)
 130         __attribute__nonnull__(2)
 131         FUNC_MODIFIES(*dest);
 132
 133 static void cvt_num8_num16_le(
 134     ARGOUT(unsigned char *dest),
 135     ARGIN(const unsigned char *src))
 136         __attribute__nonnull__(1)
 137         __attribute__nonnull__(2)
 138         FUNC_MODIFIES(*dest);
 139
 140 PARROT_WARN_UNUSED_RESULT
 141 static opcode_t fetch_op_be_4(ARGIN(const unsigned char *b))
 142         __attribute__nonnull__(1);
 143
 144 PARROT_WARN_UNUSED_RESULT
 145 static opcode_t fetch_op_be_8(ARGIN(const unsigned char *b))
 146         __attribute__nonnull__(1);
 147
 148 PARROT_WARN_UNUSED_RESULT
 149 static opcode_t fetch_op_le_4(ARGIN(const unsigned char *b))
 150         __attribute__nonnull__(1);
 151
 152 PARROT_WARN_UNUSED_RESULT
 153 static opcode_t fetch_op_le_8(ARGIN(const unsigned char *b))
 154         __attribute__nonnull__(1);
 155
 156 PARROT_WARN_UNUSED_RESULT
 157 static opcode_t fetch_op_mixed_be(ARGIN(const unsigned char *b))
 158         __attribute__nonnull__(1);
 159
 160 PARROT_WARN_UNUSED_RESULT
 161 static opcode_t fetch_op_mixed_le(ARGIN(const unsigned char *b))
 162         __attribute__nonnull__(1);
 163
 164 #define ASSERT_ARGS_cvt_num12_num16 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 165        PARROT_ASSERT_ARG(dest) \
 166     , PARROT_ASSERT_ARG(src))
 167 #define ASSERT_ARGS_cvt_num12_num16_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 168        PARROT_ASSERT_ARG(dest) \
 169     , PARROT_ASSERT_ARG(src))
 170 #define ASSERT_ARGS_cvt_num12_num8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 171        PARROT_ASSERT_ARG(dest) \
 172     , PARROT_ASSERT_ARG(src))
 173 #define ASSERT_ARGS_cvt_num12_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 174        PARROT_ASSERT_ARG(dest) \
 175     , PARROT_ASSERT_ARG(src))
 176 #define ASSERT_ARGS_cvt_num16_num12 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 177        PARROT_ASSERT_ARG(dest) \
 178     , PARROT_ASSERT_ARG(src))
 179 #define ASSERT_ARGS_cvt_num16_num12_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 180        PARROT_ASSERT_ARG(dest) \
 181     , PARROT_ASSERT_ARG(src))
 182 #define ASSERT_ARGS_cvt_num16_num8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 183        PARROT_ASSERT_ARG(dest) \
 184     , PARROT_ASSERT_ARG(src))
 185 #define ASSERT_ARGS_cvt_num16_num8_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 186        PARROT_ASSERT_ARG(dest) \
 187     , PARROT_ASSERT_ARG(src))
 188 #define ASSERT_ARGS_cvt_num16_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 189        PARROT_ASSERT_ARG(dest) \
 190     , PARROT_ASSERT_ARG(src))
 191 #define ASSERT_ARGS_cvt_num8_num12 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 192        PARROT_ASSERT_ARG(dest) \
 193     , PARROT_ASSERT_ARG(src))
 194 #define ASSERT_ARGS_cvt_num8_num12_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 195        PARROT_ASSERT_ARG(dest) \
 196     , PARROT_ASSERT_ARG(src))
 197 #define ASSERT_ARGS_cvt_num8_num16 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 198        PARROT_ASSERT_ARG(dest) \
 199     , PARROT_ASSERT_ARG(src))
 200 #define ASSERT_ARGS_cvt_num8_num16_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 201        PARROT_ASSERT_ARG(dest) \
 202     , PARROT_ASSERT_ARG(src))
 203 #define ASSERT_ARGS_cvt_num8_num16_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 204        PARROT_ASSERT_ARG(dest) \
 205     , PARROT_ASSERT_ARG(src))
 206 #define ASSERT_ARGS_fetch_op_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 207        PARROT_ASSERT_ARG(b))
 208 #define ASSERT_ARGS_fetch_op_be_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 209        PARROT_ASSERT_ARG(b))
 210 #define ASSERT_ARGS_fetch_op_le_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 211        PARROT_ASSERT_ARG(b))
 212 #define ASSERT_ARGS_fetch_op_le_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 213        PARROT_ASSERT_ARG(b))
 214 #define ASSERT_ARGS_fetch_op_mixed_be __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 215        PARROT_ASSERT_ARG(b))
 216 #define ASSERT_ARGS_fetch_op_mixed_le __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
 217        PARROT_ASSERT_ARG(b))
 218 /* Don't modify between HEADERIZER BEGIN / HEADERIZER END.  Your changes will be lost. */
 219 /* HEADERIZER END: static */
 220
 221 /*
 222  * round val up to whole size, return result in bytes
 223  */
 224 #define ROUND_UP_B(val, size) ((((val) + ((size) - 1))/(size)) * (size))
 225
 226 /*
 227  * round val up to whole opcode_t, return result in opcodes
 228  */
 229 #define ROUND_UP(val, size) (((val) + ((size) - 1))/(size))
 230
 231 /*
 232  * offset not in ptr diff, but in byte
 233  */
 234 #define OFFS(pf, cursor) ((pf) ? ((const char *)(cursor) - (const char *)((pf)->src)) : 0)
 235
 236 /*
 237  * low level FLOATVAL fetch and convert functions
 238  *
 239  * Floattype 0 = IEEE-754 8 byte double
 240  * Floattype 1 = x86 little endian 12 byte long double
 241  * Floattype 2 = IEEE-754 16 byte long double
 242  *
 243  */
 244
 245 /*
 246
 247 =item C<static void cvt_num12_num8(unsigned char *dest, const unsigned char
 248 *src)>
 249
 250 Converts i386 LE 12-byte long double to IEEE 754 8-byte double.
 251
 252 Tested ok.
 253
 254 =cut
 255
 256 */
 257
 258 static void
 259 cvt_num12_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 260 {
 261     ASSERT_ARGS(cvt_num12_num8)
 262     int expo, i, s;
 263 #ifdef __LCC__
 264     int expo2;
 265 #endif
 266
 267     /*
 268        12-byte double (96 bits):
 269        sign  1  bit 95
 270        exp  15 bits 94-80
 271        man  80 bits 79-0
 272     to 8-byte double (64 bits):
 273        sign  1  bit 63
 274        exp  11 bits 62-52
 275        man  52 bits 51-0
 276
 277     +-------+-------+-------+-------+-------+-------+--...--+-------+
 278     |src[11]|src[10]|src[9] |src[8] |src[7] |src[6] | ...   |src[0] |
 279     S|     E        |                    F                          |
 280     +-------+-------+-------+-------+-------+-------+--...--+-------+
 281     1|<-----15----->|<----------------80 bits---------------------->|
 282     <----------------------------96 bits---------------------------->
 283
 284     +-------+-------+-------+-------+-------+-------+-------+-------+
 285     |dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]|
 286     S|    E    |                           F                        |
 287     +-------+-------+-------+-------+-------+-------+-------+-------+
 288     1|<---11-->|<---------------------52 bits---------------------->|
 289     <----------------------------64 bits---------------------------->
 290                        8-byte DOUBLE FLOATING-POINT
 291     */
 292
 293     memset(dest, 0, 8);
 294     /* exponents 15 -> 11 bits */
 295     s = src[9] & 0x80; /* sign */
 296     expo = ((src[9] & 0x7f)<< 8 | src[8]);
 297     if (expo == 0) {
 298 nul:
 299         if (s)
 300             dest[7] |= 0x80;
 301         return;
 302     }
 303 #ifdef __LCC__
 304     /* Yet again, LCC blows up mysteriously until a temporary variable is
 305      * added. */
 306     expo2 = expo - 16383;
 307     expo  = expo2;
 308 #else
 309     expo -= 16383;       /* - bias */
 310 #endif
 311     expo += 1023;       /* + bias 8byte */
 312     if (expo <= 0)       /* underflow */
 313         goto nul;
 314     if (expo > 0x7ff) {  /* inf/nan */
 315         dest[7] = 0x7f;
 316         dest[6] = src[7] == 0xc0 ? 0xf8 : 0xf0 ;
 317         goto nul;
 318     }
 319     expo <<= 4;
 320     dest[6] = (expo & 0xff);
 321     dest[7] = (expo & 0x7f00) >> 8;
 322     if (s)
 323         dest[7] |= 0x80;
 324     /* long double frac 63 bits => 52 bits
 325        src[7] &= 0x7f; reset integer bit */
 326     for (i = 0; i < 6; i++) {
 327         dest[i+1] |= (i==5 ? src[7]&0x7f : src[i+2]) >> 3;
 328         dest[i] |= (src[i+2] & 0x1f) << 5;
 329     }
 330     dest[0] |= src[1] >> 3;
 331 }
 332
 333 /*
 334
 335 =item C<static void cvt_num16_num12(unsigned char *dest, const unsigned char
 336 *src)>
 337
 338 Converts IEEE 754 LE 16-byte long double to i386 LE 12-byte long double .
 339 See http://babbage.cs.qc.cuny.edu/IEEE-754/References.xhtml
 340
 341 Untested.
 342
 343 =cut
 344
 345 */
 346
 347 #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
 348 static void
 349 cvt_num16_num12(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 350 {
 351     ASSERT_ARGS(cvt_num16_num12)
 352
 353     /*
 354        16-byte double (128 bits):
 355        sign  1  bit 127
 356        exp  15 bits 126-112
 357        man 112 bits 111-0
 358     to 12-byte double (96 bits):
 359        sign  1  bit 95
 360        exp  15 bits 94-80
 361        man  80 bits 79-0
 362
 363     +-------+-------+-------+-------+-------+-------+--...--+-------+
 364     |src[15]|src[14]|src[13]|src[12]|src[11]|src[10]| ...   |src[0] |
 365     S|     E        |                    F                          |
 366     +-------+-------+-------+-------+-------+-------+--...--+-------+
 367     1|<-----15----->|<----------------112 bits--------------------->|
 368     <---------------------------128 bits---------------------------->
 369             16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit)
 370
 371     +-------+-------+-------+-------+-------+-------+--...--+-------+
 372     |dest[11]dest[10]dest[9]|dest[8]|dest[7]|dest[6]| ...   |dest[0]|
 373     S|     E        |                    F                          |
 374     +-------+-------+-------+-------+-------+-------+--...--+-------+
 375     1|<-----15----->|<----------------80 bits---------------------->|
 376     <----------------------------96 bits---------------------------->
 377               12-byte LONG DOUBLE FLOATING-POINT (i386 special)
 378
 379     */
 380
 381     memset(dest, 0, 12);
 382     /* simply copy over sign + exp */
 383     TRACE_PRINTF_2(("  cvt_num16_num12: sign+exp=0x%2x\n", src[15]));
 384     dest[11] = src[15];
 385     dest[12] = src[14];
 386     /* and trunc the rest */
 387     memcpy(&dest[10], &src[13], 10);
 388     TRACE_PRINTF_2(("  cvt_num16_num12: mantissa=0x%10x, double=%lf\n",
 389                     src[13], (long double)*dest));
 390 }
 391 #endif
 392
 393 /*
 394
 395 =item C<static void cvt_num12_num16(unsigned char *dest, const unsigned char
 396 *src)>
 397
 398 Converts i386 LE 12-byte long double to IEEE 754 LE 16-byte long double.
 399
 400 Tested ok.
 401 Fallback 12->8->16 disabled.
 402
 403 =cut
 404
 405 */
 406
 407 #if (NUMVAL_SIZE == 16)
 408 static void
 409 cvt_num12_num16(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 410 {
 411     ASSERT_ARGS(cvt_num12_num16)
 412 #  if 0
 413     unsigned char b[8];
 414     cvt_num12_num8(b, src);
 415     cvt_num8_num16(dest, b);
 416 #  endif
 417     /*
 418        12-byte double (96 bits):
 419        sign  1  bit 95
 420        exp  15 bits 94-80
 421        man  80 bits 79-0
 422     to 16-byte double (128 bits):
 423        sign  1  bit 127
 424        exp  15 bits 126-112
 425        man 112 bits 111-0
 426
 427     +-------+-------+-------+-------+-------+-------+--...--+-------+
 428     |src[11]|src[10]| src[9]| src[8]| src[7]| src[6]| ...   | src[0]|
 429     S|     E        |                    F                          |
 430     +-------+-------+-------+-------+-------+-------+--...--+-------+
 431     1|<-----15----->|<----------------80 bits---------------------->|
 432     <----------------------------96 bits---------------------------->
 433               12-byte LONG DOUBLE FLOATING-POINT (i386 special)
 434
 435     +-------+-------+-------+-------+-------+-------+--...--+-------+
 436     |dest[15]dest[14]dest[13]dest[12]dest[11]dest[10] ...   |dest[0]|
 437     S|     E        |                    F                          |
 438     +-------+-------+-------+-------+-------+-------+--...--+-------+
 439     1|<-----15----->|<----------------112 bits--------------------->|
 440     <---------------------------128 bits---------------------------->
 441             16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit)
 442
 443     */
 444
 445     memset(dest, 0, 16);
 446     /* simply copy over sign + exp */
 447     TRACE_PRINTF_2(("  cvt_num12_num16: sign+exp=0x%2x\n", src[11]));
 448     dest[15] = src[11];
 449     dest[14] = src[12];
 450     /* and trunc the rest */
 451     memcpy(&dest[13], &src[9], 10);
 452     TRACE_PRINTF_2(("  cvt_num12_num15: mantissa=0x%10x, double=%lf\n",
 453                     src[19], (long double)*dest));
 454 }
 455 #endif
 456 /*
 457
 458 =item C<static void cvt_num16_num8(unsigned char *dest, const unsigned char
 459 *src)>
 460
 461 Converts IEEE 754 16-byte long double to IEEE 754 8 byte double.
 462
 463 First variant ok, 2nd not ok.
 464
 465 =cut
 466
 467 */
 468
 469 static void
 470 cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 471 {
 472     ASSERT_ARGS(cvt_num16_num8)
 473
 474     if ((sizeof (long double) == 16) && (sizeof (double) == 8)) {
 475
 476         long double ld;
 477         double d;
 478
 479         memcpy(&ld, src, 16);
 480         d = (double)ld; /* compiler cast */
 481         memcpy(dest, &d, 8);
 482
 483     }
 484     else {
 485         /* FIXME: This codepath fails */
 486         int expo, i, s;
 487 #ifdef __LCC__
 488         int expo2;
 489 #endif
 490         exit_fatal(1, "cvt_num16_num8: long double conversion unsupported");
 491
 492     /* Have only 12-byte long double, or no long double at all. Need to disect it */
 493
 494     /*
 495        16-byte double (128 bits):
 496        sign  1  bit 127
 497        exp  15 bits 126-112
 498        man 112 bits 111-0
 499     to 8-byte double (64 bits):
 500        sign  1  bit 63
 501        exp  11 bits 62-52
 502        man  52 bits 51-0
 503
 504     +-------+-------+-------+-------+-------+-------+--...--+-------+
 505     |src[15]|src[14]|src[13]|src[12]|src[11]|src[10]| ...   |src[0] |
 506     S|     E        |                    F                          |
 507     +-------+-------+-------+-------+-------+-------+--...--+-------+
 508     1|<-----15----->|<----------------112 bits--------------------->|
 509     <---------------------------128 bits---------------------------->
 510             16-byte LONG DOUBLE FLOATING-POINT (IA64 or BE 64-bit)
 511
 512     +-------+-------+-------+-------+-------+-------+-------+-------+
 513     |dest[7]|dest[6]|dest[5]|dest[4]|dest[3]|dest[2]|dest[1]|dest[0]|
 514     S|    E    |                           F                        |
 515     +-------+-------+-------+-------+-------+-------+-------+-------+
 516     1|<---11-->|<---------------------52 bits---------------------->|
 517     <----------------------------64 bits---------------------------->
 518                        8-byte DOUBLE FLOATING-POINT
 519
 520    */
 521
 522         memset(dest, 0, 8);
 523         s = src[15] & 0x80; /* 10000000 */
 524         /* 15->11 exponents bits */
 525         expo = ((src[15] & 0x7f)<< 8 | src[14]);
 526         if (expo == 0) {
 527           nul:
 528             if (s)
 529                 dest[7] |= 0x80;
 530             return;
 531         }
 532 #ifdef __LCC__
 533         /* LCC blows up mysteriously until a temporary variable is
 534          * added. */
 535         expo2 = expo - 16383;
 536         expo  = expo2;
 537 #else
 538         expo -= 16383;       /* - same bias as with 12-byte */
 539 #endif
 540         expo += 1023;       /* + bias 8byte */
 541         if (expo <= 0)       /* underflow */
 542             goto nul;
 543         if (expo > 0x7ff) {  /* inf/nan */
 544             dest[7] = 0x7f;
 545             dest[6] = src[7] == 0xc0 ? 0xf8 : 0xf0 ;
 546             goto nul;
 547         }
 548         expo <<= 4;
 549         dest[6] = (expo & 0xff);
 550         dest[7] = (expo & 0x7f00) >> 8;
 551         if (s)
 552             dest[7] |= 0x80;
 553         /* long double frac 112 bits => 52 bits
 554            src[13] &= 0x7f; reset integer bit */
 555         for (i = 0; i < 6; i++) {
 556             dest[i+1] |= (i==5 ? src[13]&0x7f : src[i+7]) >> 3;
 557             dest[i] |= (src[i+7] & 0x1f) << 5;
 558         }
 559         dest[0] |= src[1] >> 3;
 560     }
 561 }
 562
 563 /*
 564
 565 =item C<static void cvt_num8_num16(unsigned char *dest, const unsigned char
 566 *src)>
 567
 568 Converts IEEE 754 8-byte double to IEEE 754 16 byte long double.
 569
 570 Untested.
 571
 572 =cut
 573
 574 */
 575
 576 #if (NUMVAL_SIZE == 16)
 577 static void
 578 cvt_num8_num16(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 579 {
 580     ASSERT_ARGS(cvt_num8_num16)
 581     /* The compiler can do this for us */
 582     long double ld;
 583     double d;
 584     memcpy(&d, src, 8);
 585     ld = (long double)d; /* TODO: test compiler cast */
 586     /*TRACE_PRINTF_2(("  cvt_num8_num16: d=%f, ld=%lf\n", d, ld));*/
 587     memcpy(dest, &ld, 16);
 588 }
 589 #endif
 590
 591 /*
 592
 593 =item C<static void cvt_num8_num12(unsigned char *dest, const unsigned char
 594 *src)>
 595
 596 Converts i386 8-byte double to i386 12 byte long double.
 597
 598 Tested ok.
 599
 600 =cut
 601
 602 */
 603
 604 #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
 605 static void
 606 cvt_num8_num12(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 607 {
 608     ASSERT_ARGS(cvt_num8_num12)
 609     long double ld;
 610     double d;
 611     memcpy(&d, src, 8);
 612     ld = (long double)d; /* compiler cast */
 613     /*TRACE_PRINTF_2(("  cvt_num8_num12: ld=%lf, d=%f\n", ld, d));*/
 614     memcpy(dest, &ld, 12);
 615 }
 616 #endif
 617
 618
 619 /*
 620
 621 =item C<static void cvt_num8_num12_be(unsigned char *dest, const unsigned char
 622 *src)>
 623
 624 Converts a big-endian IEEE 754 8-byte double to i386 LE 12-byte long double.
 625
 626 Tested ok.
 627
 628 =cut
 629
 630 */
 631
 632 #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
 633 static void
 634 cvt_num8_num12_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 635 {
 636     ASSERT_ARGS(cvt_num8_num12_be)
 637     unsigned char b[8];
 638     fetch_buf_be_8(b, src);
 639     /*TRACE_PRINTF_2(("  cvt_num8_num12_be: 0x%8x\n", b));*/
 640     cvt_num8_num12(dest, b);
 641 }
 642 #endif
 643
 644 /*
 645
 646 =item C<static void cvt_num8_num16_le(unsigned char *dest, const unsigned char
 647 *src)>
 648
 649 Converts a little-endian IEEE 754 8-byte double to big-endian 16-byte long double.
 650
 651 Untested.
 652
 653 =cut
 654
 655 */
 656
 657 #if (NUMVAL_SIZE == 16) && PARROT_BIGENDIAN
 658 static void
 659 cvt_num8_num16_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 660 {
 661     ASSERT_ARGS(cvt_num8_num16_le)
 662     unsigned char b[8];
 663     fetch_buf_be_8(b, src);  /* TODO test endianize */
 664     TRACE_PRINTF_2(("  cvt_num8_num16_le: 0x%8x\n", b));
 665     cvt_num8_num16(dest, b);
 666 }
 667 #endif
 668
 669 /*
 670
 671 =item C<static void cvt_num12_num16_le(unsigned char *dest, const unsigned char
 672 *src)>
 673
 674 Converts a little-endian 12-byte double to big-endian 16-byte long double.
 675
 676 Tested nok.
 677
 678 =cut
 679
 680 */
 681
 682 #if (NUMVAL_SIZE == 16) && PARROT_BIGENDIAN
 683 static void
 684 cvt_num12_num16_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 685 {
 686     ASSERT_ARGS(cvt_num12_num16_le)
 687     unsigned char b[12];
 688     fetch_buf_be_12(b, src);  /* TODO test endianize */
 689     TRACE_PRINTF_2(("  cvt_num12_num16_le: 0x%8x\n", b));
 690     cvt_num12_num16(dest, b);
 691 }
 692 #endif
 693
 694 /*
 695
 696 =item C<static void cvt_num12_num8_le(unsigned char *dest, const unsigned char
 697 *src)>
 698
 699 Converts a little-endian 12-byte i386 long double into a big-endian IEEE 754 8-byte double.
 700
 701 Tested nok.
 702
 703 =cut
 704
 705 */
 706
 707 #if PARROT_BIGENDIAN
 708 static void
 709 cvt_num12_num8_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 710 {
 711     ASSERT_ARGS(cvt_num12_num8_le)
 712     unsigned char b[12];
 713     fetch_buf_le_12(b, src);  /* TODO test endianize */
 714     TRACE_PRINTF_2(("  cvt_num12_num8_le: 0x%12x\n", b));
 715     cvt_num12_num8(dest, b);
 716     exit_fatal(1, "cvt_num12_num8_le: long double conversion unsupported");
 717 }
 718 #endif
 719
 720 /*
 721
 722 =item C<static void cvt_num16_num8_le(unsigned char *dest, const unsigned char
 723 *src)>
 724
 725 Converts a little-endian IEEE 754 intel 16-byte long double into a
 726 big-endian IEEE 754 8-byte double.
 727
 728 Tested nok. Produces all zeros.
 729
 730 =cut
 731
 732 */
 733
 734 #if PARROT_BIGENDIAN
 735 static void
 736 cvt_num16_num8_le(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 737 {
 738     ASSERT_ARGS(cvt_num16_num8_le)
 739     unsigned char b[16];
 740     fetch_buf_le_16(b, src);
 741     TRACE_PRINTF_2(("  cvt_num16_num8_le: 0x%16x\n", b));
 742     cvt_num16_num8(dest, b);
 743     exit_fatal(1, "cvt_num16_num8_le: long double conversion unsupported");
 744 }
 745 #endif
 746
 747 /*
 748
 749 =item C<static void cvt_num16_num8_be(unsigned char *dest, const unsigned char
 750 *src)>
 751
 752 Converts a big-endian IEEE 754 16-byte long double into a IEEE 754 8-byte double.
 753
 754 Untested.
 755
 756 =cut
 757
 758 */
 759
 760 #if !PARROT_BIGENDIAN
 761 static void
 762 cvt_num16_num8_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 763 {
 764     ASSERT_ARGS(cvt_num16_num8_be)
 765     unsigned char b[16];
 766     fetch_buf_be_16(b, src);
 767     TRACE_PRINTF_2(("  cvt_num16_num8_be: 0x%16x\n", b));
 768     cvt_num16_num8(dest, b);
 769 }
 770 #endif
 771
 772 /*
 773
 774 =item C<static void cvt_num16_num12_be(unsigned char *dest, const unsigned char
 775 *src)>
 776
 777 Converts a big-endian IEEE 754 16-byte long double into a 12-byte i386 long double.
 778
 779 Untested.
 780
 781 =cut
 782
 783 */
 784
 785 #if (NUMVAL_SIZE == 12) && !PARROT_BIGENDIAN
 786 static void
 787 cvt_num16_num12_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 788 {
 789     ASSERT_ARGS(cvt_num16_num12_be)
 790     unsigned char b[16];
 791     fetch_buf_be_16(b, src);
 792     TRACE_PRINTF_2(("  cvt_num16_num12_be: 0x%16x\n", b));
 793     cvt_num16_num12(dest, b);
 794 }
 795 #endif
 796
 797 /*
 798
 799 =item C<static void cvt_num8_num16_be(unsigned char *dest, const unsigned char
 800 *src)>
 801
 802 Converts a big-endian IEEE 754 8-byte double to little-endian IEEE 754 16 byte
 803 long double.
 804
 805 Untested.
 806
 807 =cut
 808
 809 */
 810
 811 #if (NUMVAL_SIZE == 16) && !PARROT_BIGENDIAN
 812 static void
 813 cvt_num8_num16_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src))
 814 {
 815     ASSERT_ARGS(cvt_num8_num16_be)
 816     unsigned char b[8];
 817     fetch_buf_be_8(b, src);
 818     cvt_num8_num16(dest, b);
 819 }
 820 #endif
 821
 822 #if 0
 823
 824 /*
 825
 826 =item C<static opcode_t fetch_op_mixed_le(const unsigned char *b)>
 827
 828 opcode fetch helper function
 829
 830 This is mostly wrong or at least untested
 831
 832 Fetch an opcode and convert to LE
 833
 834 =cut
 835
 836 */
 837
 838 PARROT_WARN_UNUSED_RESULT
 839 static opcode_t
 840 fetch_op_mixed_le(ARGIN(const unsigned char *b))
 841 {
 842     ASSERT_ARGS(fetch_op_mixed_le)
 843 #  if OPCODE_T_SIZE == 4
 844     union {
 845         unsigned char buf[8];
 846         opcode_t o[2];
 847     } u;
 848     /* wordsize = 8 then */
 849     fetch_buf_le_8(u.buf, b);
 850     return u.o[0]; /* or u.o[1] */
 851 #  else
 852     union {
 853         unsigned char buf[4];
 854         opcode_t o;
 855     } u;
 856
 857     /* wordsize = 4 */
 858     u.o = 0;
 859     fetch_buf_le_4(u.buf, b);
 860     return u.o;
 861 #  endif
 862 }
 863
 864 /*
 865
 866 =item C<static opcode_t fetch_op_mixed_be(const unsigned char *b)>
 867
 868 Fetch an opcode and convert to BE. Determines size of opcode from
 869 C<OPCODE_T_SIZE> macro, and proceeds accordingly.
 870
 871 =cut
 872
 873 */
 874
 875 PARROT_WARN_UNUSED_RESULT
 876 static opcode_t
 877 fetch_op_mixed_be(ARGIN(const unsigned char *b))
 878 {
 879     ASSERT_ARGS(fetch_op_mixed_be)
 880 #  if OPCODE_T_SIZE == 4
 881     union {
 882         unsigned char buf[8];
 883         opcode_t o[2];
 884     } u;
 885     /* wordsize = 8 then */
 886     fetch_buf_be_8(u.buf, b);
 887     return u.o[1]; /* or u.o[0] */
 888 #  else
 889     union {
 890         unsigned char buf[4];
 891         opcode_t o;
 892     } u;
 893     /* wordsize = 4 */
 894     u.o = 0;
 895     fetch_buf_be_4(u.buf, b);
 896     return u.o;
 897 #  endif
 898 }
 899
 900 #endif
 901
 902 /*
 903
 904 =item C<static opcode_t fetch_op_be_4(const unsigned char *b)>
 905
 906 Fetches a 4-byte big-endian opcode.
 907
 908 =cut
 909
 910 */
 911
 912 PARROT_WARN_UNUSED_RESULT
 913 static opcode_t
 914 fetch_op_be_4(ARGIN(const unsigned char *b))
 915 {
 916     ASSERT_ARGS(fetch_op_be_4)
 917     union {
 918         unsigned char buf[4];
 919         opcode_t o;
 920     } u;
 921     fetch_buf_be_4(u.buf, b);
 922 #if PARROT_BIGENDIAN
 923 #  if OPCODE_T_SIZE == 8
 924     return (Parrot_Int4)(u.o >> 32);
 925 #  else
 926     return u.o;
 927 #  endif
 928 #else
 929 #  if OPCODE_T_SIZE == 8
 930     return (Parrot_Int4)(fetch_iv_le((INTVAL)u.o) & 0xffffffff);
 931 #  else
 932     return (opcode_t) fetch_iv_le((INTVAL)u.o);
 933 #  endif
 934 #endif
 935 }
 936
 937 /*
 938
 939 =item C<static opcode_t fetch_op_be_8(const unsigned char *b)>
 940
 941 Fetches an 8-byte big-endian opcode.
 942
 943 =cut
 944
 945 */
 946
 947 PARROT_WARN_UNUSED_RESULT
 948 static opcode_t
 949 fetch_op_be_8(ARGIN(const unsigned char *b))
 950 {
 951     ASSERT_ARGS(fetch_op_be_8)
 952     union {
 953         unsigned char buf[8];
 954         opcode_t o[2];
 955     } u;
 956     fetch_buf_be_8(u.buf, b);
 957 #if PARROT_BIGENDIAN
 958 #  if OPCODE_T_SIZE == 8
 959     return u.o[0];
 960 #  else
 961     return u.o[1];
 962 #  endif
 963 #else
 964     return (opcode_t) fetch_iv_le((INTVAL)u.o[0]);
 965 #endif
 966 }
 967
 968 /*
 969
 970 =item C<static opcode_t fetch_op_le_4(const unsigned char *b)>
 971
 972 Fetches a 4-byte little-endian opcode
 973
 974 =cut
 975
 976 */
 977
 978 PARROT_WARN_UNUSED_RESULT
 979 static opcode_t
 980 fetch_op_le_4(ARGIN(const unsigned char *b))
 981 {
 982     ASSERT_ARGS(fetch_op_le_4)
 983     union {
 984         unsigned char buf[4];
 985         opcode_t o;
 986     } u;
 987     fetch_buf_le_4(u.buf, b);
 988 #if PARROT_BIGENDIAN
 989 #  if OPCODE_T_SIZE == 8
 990     return (Parrot_Int4)(u.o >> 32);
 991 #  else
 992     return (opcode_t) fetch_iv_be((INTVAL)u.o);
 993 #  endif
 994 #else
 995 #  if OPCODE_T_SIZE == 8
 996     /* without the cast we would not get a negative int, the vtable indices */
 997     return (Parrot_Int4)(u.o & 0xffffffff);
 998 #  else
 999     return u.o;
1000 #  endif
1001 #endif
1002 }
1003
1004 /*
1005
1006 =item C<static opcode_t fetch_op_le_8(const unsigned char *b)>
1007
1008 Fetches an 8-byte little-endian opcode
1009
1010 =cut
1011
1012 */
1013
1014 PARROT_WARN_UNUSED_RESULT
1015 static opcode_t
1016 fetch_op_le_8(ARGIN(const unsigned char *b))
1017 {
1018     ASSERT_ARGS(fetch_op_le_8)
1019     union {
1020         unsigned char buf[8];
1021         opcode_t o[2];
1022     } u;
1023     fetch_buf_le_8(u.buf, b);
1024 #if PARROT_BIGENDIAN
1025 #  if OPCODE_T_SIZE == 8
1026     return u.o[0];
1027 #  else
1028     return (opcode_t) fetch_op_be((INTVAL)u.o[1]);
1029 #  endif
1030 #else
1031     return u.o[0];
1032 #endif
1033 }
1034
1035 /*
1036
1037 =item C<opcode_t PF_fetch_opcode(const PackFile *pf, const opcode_t **stream)>
1038
1039 Fetches an C<opcode_t> from the stream, converting byteorder if needed.
1040
1041 When used for freeze/thaw the C<pf> argument might be NULL.
1042
1043 =cut
1044
1045 */
1046
1047 PARROT_WARN_UNUSED_RESULT
1048 PARROT_CANNOT_RETURN_NULL
1049 opcode_t
1050 PF_fetch_opcode(ARGIN_NULLOK(const PackFile *pf), ARGMOD(const opcode_t **stream))
1051 {
1052     ASSERT_ARGS(PF_fetch_opcode)
1053     opcode_t o;
1054     if (!pf || !pf->fetch_op)
1055         return *(*stream)++;
1056     o = (pf->fetch_op)(*((const unsigned char **)stream));
1057     TRACE_PRINTF_VAL(("  PF_fetch_opcode: 0x%lx (%ld), at 0x%x\n",
1058                       o, o, OFFS(pf, *stream)));
1059     *((const unsigned char **) (stream)) += pf->header->wordsize;
1060     return o;
1061 }
1062
1063 /*
1064
1065 =item C<opcode_t* PF_store_opcode(opcode_t *cursor, opcode_t val)>
1066
1067 Stores an C<opcode_t> to stream as-is.
1068
1069 =cut
1070
1071 */
1072
1073 PARROT_WARN_UNUSED_RESULT
1074 PARROT_CANNOT_RETURN_NULL
1075 opcode_t*
1076 PF_store_opcode(ARGOUT(opcode_t *cursor), opcode_t val)
1077 {
1078     ASSERT_ARGS(PF_store_opcode)
1079     *cursor++ = val;
1080     return cursor;
1081 }
1082
1083 /*
1084
1085 =item C<size_t PF_size_opcode(void)>
1086
1087 Returns the size of an item in C<opcode_t> units. The size of C<opcode_t>
1088 is 1 I<per definition>.
1089
1090 =cut
1091
1092 */
1093
1094 PARROT_CONST_FUNCTION
1095 size_t
1096 PF_size_opcode(void)
1097 {
1098     ASSERT_ARGS(PF_size_opcode)
1099     return 1;
1100 }
1101
1102 /*
1103
1104 =item C<INTVAL PF_fetch_integer(PackFile *pf, const opcode_t **stream)>
1105
1106 Fetches an C<INTVAL> from the stream, converting byteorder if needed.
1107
1108 XXX assumes C<sizeof (INTVAL) == sizeof (opcode_t)> - we don't have
1109 C<INTVAL> size in the PackFile header.
1110
1111 When used for freeze/thaw the C<pf> argument might be NULL.
1112
1113 =cut
1114
1115 */
1116
1117 PARROT_WARN_UNUSED_RESULT
1118 INTVAL
1119 PF_fetch_integer(ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **stream))
1120 {
1121     ASSERT_ARGS(PF_fetch_integer)
1122     INTVAL i;
1123
1124     if (!pf || pf->fetch_iv == NULL)
1125         return *(*stream)++;
1126     i = (pf->fetch_iv)(*((const unsigned char **)stream));
1127     TRACE_PRINTF_VAL(("  PF_fetch_integer: 0x%x (%d) at 0x%x\n", i, i,
1128                       OFFS(pf, *stream)));
1129     /* XXX assume sizeof (opcode_t) == sizeof (INTVAL) on the
1130      * machine producing this PBC.
1131      *
1132      * TODO TT #364 on Sparc 64bit: On pbc wordsize=4 but native ptrsize=8 and
1133      * ptr_alignment=8 the advance by 4 will signal BUS (invalid address alignment)
1134      * in PF_fetch_integer and elsewhere.
1135      */
1136     *((const unsigned char **) (stream)) += pf->header->wordsize;
1137     return i;
1138 }
1139
1140
1141 /*
1142
1143 =item C<opcode_t* PF_store_integer(opcode_t *cursor, INTVAL val)>
1144
1145 Stores an C<INTVAL> to stream as is.
1146
1147 =cut
1148
1149 */
1150
1151 PARROT_WARN_UNUSED_RESULT
1152 PARROT_CANNOT_RETURN_NULL
1153 opcode_t*
1154 PF_store_integer(ARGOUT(opcode_t *cursor), INTVAL val)
1155 {
1156     ASSERT_ARGS(PF_store_integer)
1157     *cursor++ = (opcode_t)val; /* XXX */
1158     return cursor;
1159 }
1160
1161 /*
1162
1163 =item C<size_t PF_size_integer(void)>
1164
1165 Returns stored size of C<INTVAL> in C<opcode_t> units.
1166
1167 =cut
1168
1169 */
1170
1171 PARROT_CONST_FUNCTION
1172 size_t
1173 PF_size_integer(void)
1174 {
1175     ASSERT_ARGS(PF_size_integer)
1176     return sizeof (INTVAL) / sizeof (opcode_t);
1177 }
1178
1179 /*
1180
1181 =item C<FLOATVAL PF_fetch_number(PackFile *pf, const opcode_t **stream)>
1182
1183 Fetches a C<FLOATVAL> from the stream, converting byteorder if needed.
1184 Then advances the stream pointer by the packfile float size.
1185
1186 =cut
1187
1188 */
1189
1190 PARROT_WARN_UNUSED_RESULT
1191 FLOATVAL
1192 PF_fetch_number(ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **stream))
1193 {
1194     ASSERT_ARGS(PF_fetch_number)
1195     /* When we have alignment all squared away we don't need
1196      * to use memcpy() for native byteorder.  */
1197     FLOATVAL f;
1198     double d;
1199     if (!pf || !pf->fetch_nv) {
1200         TRACE_PRINTF(("PF_fetch_number: Native [%d bytes]\n",
1201                       sizeof (FLOATVAL)));
1202         memcpy(&f, (const char *)*stream, sizeof (FLOATVAL));
1203         TRACE_PRINTF_VAL(("PF_fetch_number: %f at 0x%x\n", f, OFFS(pf, *stream)));
1204         (*stream) += (sizeof (FLOATVAL) + sizeof (opcode_t) - 1)/
1205             sizeof (opcode_t);
1206         return f;
1207     }
1208     f = (FLOATVAL) 0;
1209     TRACE_PRINTF(("PF_fetch_number at 0x%x: Converting...\n", OFFS(pf, *stream)));
1210     /* 12->8 has a messy cast. */
1211     if (NUMVAL_SIZE == 8 && pf->header->floattype == FLOATTYPE_12) {
1212         (pf->fetch_nv)((unsigned char *)&d, (const unsigned char *) *stream);
1213         f = d;
1214         TRACE_PRINTF_VAL(("PF_fetch_number: cast %f\n", f));
1215     }
1216     else {
1217         (pf->fetch_nv)((unsigned char *)&f, (const unsigned char *) *stream);
1218         TRACE_PRINTF_VAL(("PF_fetch_number: %f\n", f));
1219     }
1220     if (pf->header->floattype == FLOATTYPE_8) {
1221         *((const unsigned char **) (stream)) += 8;
1222     }
1223     else if (pf->header->floattype == FLOATTYPE_12) {
1224         *((const unsigned char **) (stream)) += 12;
1225     }
1226     else if (pf->header->floattype == FLOATTYPE_16) {
1227         *((const unsigned char **) (stream)) += 16;
1228     }
1229     else if (pf->header->floattype == FLOATTYPE_16MIPS) {
1230         *((const unsigned char **) (stream)) += 16;
1231     }
1232     else if (pf->header->floattype == FLOATTYPE_16AIX) {
1233         *((const unsigned char **) (stream)) += 16;
1234     }
1235     else if (pf->header->floattype == FLOATTYPE_4) {
1236         *((const unsigned char **) (stream)) += 4;
1237     }
1238     return f;
1239 }
1240
1241 /*
1242
1243 =item C<opcode_t* PF_store_number(opcode_t *cursor, const FLOATVAL *val)>
1244
1245 Writes a C<FLOATVAL> to the opcode stream as-is.
1246
1247 =cut
1248
1249 */
1250
1251 PARROT_WARN_UNUSED_RESULT
1252 PARROT_CANNOT_RETURN_NULL
1253 opcode_t*
1254 PF_store_number(ARGOUT(opcode_t *cursor), ARGIN(const FLOATVAL *val))
1255 {
1256     ASSERT_ARGS(PF_store_number)
1257     opcode_t padded_size  = (sizeof (FLOATVAL) + sizeof (opcode_t) - 1) /
1258         sizeof (opcode_t);
1259     mem_sys_memcopy(cursor, val, sizeof (FLOATVAL));
1260     cursor += padded_size;
1261     return cursor;
1262 }
1263
1264 /*
1265
1266 =item C<size_t PF_size_number(void)>
1267
1268 Returns stored size of FLOATVAL in C<opcode_t> units.
1269
1270 =cut
1271
1272 */
1273
1274 PARROT_CONST_FUNCTION
1275 size_t
1276 PF_size_number(void)
1277 {
1278     ASSERT_ARGS(PF_size_number)
1279     return ROUND_UP(sizeof (FLOATVAL), sizeof (opcode_t));
1280 }
1281
1282 /*
1283
1284 =item C<STRING * PF_fetch_string(PARROT_INTERP, PackFile *pf, const opcode_t
1285 **cursor)>
1286
1287 Fetches a C<STRING> from bytecode and return a new C<STRING>.
1288
1289 Opcode format is:
1290
1291     opcode_t flags
1292     opcode_t encoding
1293     opcode_t type
1294     opcode_t size
1295     * data
1296
1297 When used for freeze/thaw the C<pf> argument might be NULL.
1298
1299 =cut
1300
1301 */
1302
1303 PARROT_WARN_UNUSED_RESULT
1304 PARROT_CANNOT_RETURN_NULL
1305 STRING *
1306 PF_fetch_string(PARROT_INTERP, ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **cursor))
1307 {
1308     ASSERT_ARGS(PF_fetch_string)
1309     STRING   *s;
1310     UINTVAL   flags    = PF_fetch_opcode(pf, cursor);
1311     const int wordsize = pf ? pf->header->wordsize : sizeof (opcode_t);
1312     size_t    size;
1313     opcode_t  charset_nr;
1314
1315     /* don't let PBC mess our internals - only constant or not */
1316     flags      &= (PObj_constant_FLAG | PObj_private7_FLAG);
1317     charset_nr  = PF_fetch_opcode(pf, cursor);
1318
1319     /* These may need to be separate */
1320     size        = (size_t)PF_fetch_opcode(pf, cursor);
1321
1322     TRACE_PRINTF(("PF_fetch_string(): flags=0x%04x, ", flags));
1323     TRACE_PRINTF(("charset_nr=%ld, ", charset_nr));
1324     TRACE_PRINTF(("size=%ld.\n", size));
1325
1326     s            = string_make_from_charset(interp, (const char *)*cursor,
1327                         size, charset_nr, flags);
1328
1329     /* print only printable characters */
1330     TRACE_PRINTF_VAL(("PF_fetch_string(): string is '%s' at 0x%x\n",
1331                       s->strstart, OFFS(pf, *cursor)));
1332
1333     TRACE_PRINTF_ALIGN(("-s ROUND_UP_B: cursor=0x%x, size=%d, wordsize=%d\n",
1334                         (const char *)*cursor + size, size, wordsize));
1335
1336     size = ROUND_UP_B(size, wordsize);
1337
1338     TRACE_PRINTF(("PF_fetch_string(): round size up to %ld.\n", size));
1339     *((const unsigned char **) (cursor)) += size;
1340
1341     TRACE_PRINTF_ALIGN(("+s ROUND_UP_B: cursor=0x%x, size=%d\n", *cursor, size));
1342     return s;
1343 }
1344
1345
1346 /*
1347
1348 =item C<opcode_t* PF_store_string(opcode_t *cursor, const STRING *s)>
1349
1350 Writes a C<STRING> to the opcode stream.
1351
1352 =cut
1353
1354 */
1355
1356 PARROT_WARN_UNUSED_RESULT
1357 PARROT_CANNOT_RETURN_NULL
1358 opcode_t*
1359 PF_store_string(ARGOUT(opcode_t *cursor), ARGIN(const STRING *s))
1360 {
1361     ASSERT_ARGS(PF_store_string)
1362     opcode_t padded_size = s->bufused;
1363     char *charcursor;
1364
1365 #if TRACE_PACKFILE == 3
1366     Parrot_io_eprintf(NULL, "PF_store_string(): size is %ld...\n", s->bufused);
1367 #endif
1368
1369     if (padded_size % sizeof (opcode_t)) {
1370         padded_size += sizeof (opcode_t) - (padded_size % sizeof (opcode_t));
1371     }
1372
1373     *cursor++ = PObj_get_FLAGS(s); /* only constant_FLAG and private7 */
1374     /*
1375      * TODO as soon as we have dynamically loadable charsets
1376      *      we have to store the charset name, not the number
1377      *
1378      * TODO encoding
1379      *
1380      * see also PF_fetch_string
1381      */
1382     *cursor++ = Parrot_charset_number_of_str(NULL, s);
1383     *cursor++ = s->bufused;
1384
1385     /* Switch to char * since rest of string is addressed by
1386      * characters to ensure padding.  */
1387     charcursor = (char *)cursor;
1388
1389     if (s->strstart) {
1390         mem_sys_memcopy(charcursor, s->strstart, s->bufused);
1391         charcursor += s->bufused;
1392         /* Pad up to sizeof (opcode_t) boundary. */
1393         while ((unsigned long) (charcursor - (char *) cursor) % sizeof (opcode_t)) {
1394             *charcursor++ = 0;
1395         }
1396     }
1397     PARROT_ASSERT(((unsigned long) (charcursor - (char *) cursor) % sizeof (opcode_t)) == 0);
1398     cursor += (charcursor - (char *) cursor) / sizeof (opcode_t);
1399
1400     return cursor;
1401 }
1402
1403 /*
1404
1405 =item C<size_t PF_size_string(const STRING *s)>
1406
1407 Reports stored size of C<STRING> in C<opcode_t> units.
1408
1409 =cut
1410
1411 */
1412
1413 PARROT_PURE_FUNCTION
1414 size_t
1415 PF_size_string(ARGIN(const STRING *s))
1416 {
1417     ASSERT_ARGS(PF_size_string)
1418     opcode_t padded_size = s->bufused;
1419
1420     if (padded_size % sizeof (opcode_t)) {
1421         padded_size += sizeof (opcode_t) - (padded_size % sizeof (opcode_t));
1422     }
1423
1424     /* Include space for flags, representation, and size fields.  */
1425     return 3 + (size_t)padded_size / sizeof (opcode_t);
1426 }
1427
1428 /*
1429
1430 =item C<char * PF_fetch_cstring(PackFile *pf, const opcode_t **cursor)>
1431
1432 Fetches a cstring from bytecode and returns an allocated copy
1433
1434 =cut
1435
1436 */
1437
1438 PARROT_MALLOC
1439 PARROT_CANNOT_RETURN_NULL
1440 char *
1441 PF_fetch_cstring(ARGIN(PackFile *pf), ARGIN(const opcode_t **cursor))
1442 {
1443     ASSERT_ARGS(PF_fetch_cstring)
1444     const size_t str_len = strlen((const char *)(*cursor)) + 1;
1445     char * const p = (char *)mem_sys_allocate(str_len);
1446     const int wordsize = pf->header->wordsize;
1447
1448     TRACE_PRINTF(("PF_fetch_cstring(): size is %ld...\n", str_len));
1449     strcpy(p, (const char*) (*cursor));
1450     TRACE_PRINTF_VAL(("PF_fetch_cstring(): string is '%s' at 0x%x\n",
1451                       p, OFFS(pf, *cursor)));
1452     TRACE_PRINTF_ALIGN(("-s ROUND_UP_B: cursor=0x%x, size=%d, wordsize=%d (cstring)\n",
1453                         *cursor, str_len, wordsize));
1454     *((const unsigned char **) (cursor)) += ROUND_UP_B(str_len, wordsize);
1455     TRACE_PRINTF_ALIGN(("+s ROUND_UP_B: cursor=0x%x, offset=0x%x\n",
1456                         *cursor, OFFS(pf, *cursor)));
1457
1458     return p;
1459 }
1460
1461 /*
1462
1463 =item C<opcode_t* PF_store_cstring(opcode_t *cursor, const char *s)>
1464
1465 Writes a C<NULL>-terminated string to the stream.
1466
1467 =cut
1468
1469 */
1470
1471 PARROT_WARN_UNUSED_RESULT
1472 PARROT_CANNOT_RETURN_NULL
1473 opcode_t*
1474 PF_store_cstring(ARGOUT(opcode_t *cursor), ARGIN(const char *s))
1475 {
1476     ASSERT_ARGS(PF_store_cstring)
1477     /*
1478      * This is not very efficient for filling padding with zeros.
1479      * But it's more efficient than calculate strlen twice.
1480      */
1481     size_t store_size = PF_size_cstring(s);
1482     memset((char *) cursor, 0, store_size * sizeof (opcode_t));
1483     strcpy((char *) cursor, s);
1484     return cursor + store_size;
1485 }
1486
1487 /*
1488
1489 =item C<size_t PF_size_cstring(const char *s)>
1490
1491 Returns store size of a C-string in C<opcode_t> units.
1492
1493 =cut
1494
1495 */
1496
1497 PARROT_PURE_FUNCTION
1498 size_t
1499 PF_size_cstring(ARGIN(const char *s))
1500 {
1501     ASSERT_ARGS(PF_size_cstring)
1502     size_t str_len;
1503
1504     PARROT_ASSERT(s);
1505     str_len = strlen(s);
1506     return ROUND_UP(str_len + 1, sizeof (opcode_t));
1507 }
1508
1509 /*
1510
1511 =item C<void PackFile_assign_transforms(PackFile *pf)>
1512
1513 Assigns transform functions to the vtable.
1514
1515 =cut
1516
1517 */
1518
1519 void
1520 PackFile_assign_transforms(ARGMOD(PackFile *pf))
1521 {
1522     ASSERT_ARGS(PackFile_assign_transforms)
1523     const int need_endianize = pf->header->byteorder != PARROT_BIGENDIAN;
1524     const int need_wordsize  = pf->header->wordsize  != sizeof (opcode_t);
1525
1526     pf->need_endianize = need_endianize;
1527     pf->need_wordsize  = need_wordsize;
1528
1529 #if PARROT_BIGENDIAN
1530     /* this Parrot is on a BIG ENDIAN machine */
1531     if (need_endianize) {
1532         if (pf->header->wordsize == 4)
1533             pf->fetch_op = fetch_op_le_4;
1534         else
1535             pf->fetch_op = fetch_op_le_8;
1536         pf->fetch_iv = pf->fetch_op;
1537
1538         switch (pf->header->floattype) {
1539 #  if NUMVAL_SIZE == 8
1540           case FLOATTYPE_8:
1541             pf->fetch_nv = fetch_buf_le_8;
1542             break;
1543           case FLOATTYPE_12:
1544             pf->fetch_nv = cvt_num12_num8_le;
1545             break;
1546           case FLOATTYPE_16:
1547             pf->fetch_nv = cvt_num16_num8_le;
1548             break;
1549 #  endif
1550 #  if NUMVAL_SIZE == 16
1551           case FLOATTYPE_8:
1552             pf->fetch_nv = cvt_num8_num16_le;
1553             break;
1554           case FLOATTYPE_12:
1555             pf->fetch_nv = cvt_num12_num16_le;
1556             break;
1557           case FLOATTYPE_16:
1558             pf->fetch_nv = fetch_buf_le_16;
1559             break;
1560 #  endif
1561           default:
1562             exit_fatal(1,
1563               "PackFile_unpack: unsupported float conversion %d to %d, "
1564               "PARROT_BIGENDIAN=%d\n",
1565               NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
1566             break;
1567         }
1568         return;
1569     }
1570     else {  /* no need_endianize */
1571         if (pf->header->wordsize == 4)
1572             pf->fetch_op = fetch_op_be_4;
1573         else
1574             pf->fetch_op = fetch_op_be_8;
1575         pf->fetch_iv = pf->fetch_op;
1576
1577         switch (pf->header->floattype) {
1578 #  if NUMVAL_SIZE == 8
1579           case FLOATTYPE_8: /* native */
1580             break;
1581           case FLOATTYPE_12:
1582             pf->fetch_nv = cvt_num12_num8;
1583             break;
1584           case FLOATTYPE_16:
1585             pf->fetch_nv = cvt_num16_num8;
1586             break;
1587 #  endif
1588 #  if NUMVAL_SIZE == 16
1589           case FLOATTYPE_8:
1590             pf->fetch_nv = cvt_num8_num16;
1591             break;
1592           case FLOATTYPE_12:
1593             pf->fetch_nv = cvt_num12_num16;
1594             break;
1595           case FLOATTYPE_16: /* native */
1596             break;
1597 #  endif
1598           default:
1599             exit_fatal(1,
1600               "PackFile_unpack: unsupported float conversion %d to %d, "
1601               "PARROT_BIGENDIAN=%d\n",
1602               NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
1603             break;
1604         }
1605         return;
1606     }
1607
1608 #else  /* ENDIAN */
1609
1610     /* this Parrot is on a LITTLE ENDIAN machine */
1611     if (need_endianize) {
1612         if (pf->header->wordsize == 4)
1613             pf->fetch_op = fetch_op_be_4;
1614         else
1615             pf->fetch_op = fetch_op_be_8;
1616         pf->fetch_iv = pf->fetch_op;
1617
1618         switch (pf->header->floattype) {
1619 #  if NUMVAL_SIZE == 8
1620           case FLOATTYPE_8:
1621             pf->fetch_nv = fetch_buf_be_8;
1622             break;
1623           case FLOATTYPE_12:
1624             exit_fatal(1, "PackFile_unpack: invalid floattype 1 big-endian");
1625             break;
1626           case FLOATTYPE_16:
1627             pf->fetch_nv = cvt_num16_num8_be;
1628             break;
1629 #  endif
1630 #  if NUMVAL_SIZE == 12
1631           case FLOATTYPE_8:
1632             pf->fetch_nv = cvt_num8_num12_be;
1633             break;
1634           case FLOATTYPE_12:
1635             exit_fatal(1, "PackFile_unpack: invalid floattype 1 big-endian");
1636             break;
1637           case FLOATTYPE_16:
1638             pf->fetch_nv = cvt_num16_num12_be;
1639             break;
1640 #  endif
1641 #  if NUMVAL_SIZE == 16
1642           case FLOATTYPE_8:
1643             pf->fetch_nv = cvt_num8_num16_be;
1644             break;
1645           case FLOATTYPE_12:
1646             exit_fatal(1, "PackFile_unpack: invalid floattype 1 big-endian");
1647             break;
1648           case FLOATTYPE_16:
1649             pf->fetch_nv = fetch_buf_be_16;
1650             break;
1651 #  endif
1652           default:
1653             exit_fatal(1,
1654               "PackFile_unpack: unsupported float conversion %d to %d, "
1655               "PARROT_BIGENDIAN=%d\n",
1656               NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
1657             break;
1658         }
1659         return;
1660     }
1661     else {
1662         if (pf->header->wordsize == 4)
1663             pf->fetch_op = fetch_op_le_4;
1664         else
1665             pf->fetch_op = fetch_op_le_8;
1666         pf->fetch_iv = pf->fetch_op;
1667
1668         switch (pf->header->floattype) {
1669 #  if NUMVAL_SIZE == 8
1670           case FLOATTYPE_8: /* native */
1671             break;
1672           case FLOATTYPE_12:
1673             pf->fetch_nv = cvt_num12_num8;
1674             break;
1675           case FLOATTYPE_16:
1676             pf->fetch_nv = cvt_num16_num8;
1677             break;
1678 #  endif
1679 #  if NUMVAL_SIZE == 12
1680           case FLOATTYPE_8:
1681             pf->fetch_nv = cvt_num8_num12;
1682             break;
1683           case FLOATTYPE_12: /* native */
1684             break;
1685           case FLOATTYPE_16:
1686             pf->fetch_nv = cvt_num16_num12;
1687             break;
1688 #  endif
1689 #  if NUMVAL_SIZE == 16
1690           case FLOATTYPE_8:
1691             pf->fetch_nv = cvt_num8_num16;
1692             break;
1693           case FLOATTYPE_12:
1694             pf->fetch_nv = cvt_num12_num16;
1695             break;
1696           case FLOATTYPE_16: /* native */
1697             break;
1698 #  endif
1699           default:
1700             exit_fatal(1,
1701               "PackFile_unpack: unsupported float conversion %d to %d, "
1702               "PARROT_BIGENDIAN=%d\n",
1703               NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN);
1704             break;
1705         }
1706         return;
1707     }
1708 #endif
1709 }
1710
1711 /*
1712
1713 =back
1714
1715 =head1 HISTORY
1716
1717 Initial review by leo 2003.11.21
1718
1719 Most routines moved from F<src/packfile.c>.
1720
1721 Renamed PackFile_* to PF_*
1722
1723 Added 16 byte types.
1724
1725 =head1 TODO
1726
1727 C<<PF_store_<type>()>> - write an opcode_t stream to cursor in natural
1728 byte-ordering.
1729
1730 C<<PF_fetch_<type>()>> - read items and possibly convert the foreign
1731 format.
1732
1733 C<<PF_size_<type>()>> - return the needed size in C<opcode_t> units.
1734
1735 =cut
1736
1737 */
1738
1739
1740 /*
1741  * Local variables:
1742  *   c-file-style: "parrot"
1743  * End:
1744  * vim: expandtab shiftwidth=4:
1745  */