Ticket #308: tt308-long-double16.patch

File tt308-long-double16.patch, 34.2 KB (added by rurban, 13 years ago)

rel-2

  • src/byteorder.c

     
    5454#  if INTVAL_SIZE == 4 
    5555    return (w << 24) | ((w & 0xff00) << 8) | ((w & 0xff0000) >> 8) | (w >> 24); 
    5656#  else 
     57#    if INTVAL_SIZE == 8 
    5758    INTVAL r; 
    5859 
    5960    r = w << 56; 
    … …  
    6566    r |= (w & 0xff000000000000) >> 40; 
    6667    r |= (w & 0xff00000000000000) >> 56; 
    6768    return r; 
     69#    else 
     70    exit_fatal(1, "Unsupported INTVAL_SIZE=%d\n", 
     71               INTVAL_SIZE); 
     72#    endif 
    6873#  endif 
    6974#endif 
    7075} 
    … …  
    9297#  if INTVAL_SIZE == 4 
    9398    return (w << 24) | ((w & 0xff00) << 8) | ((w & 0xff0000) >> 8) | (w >> 24); 
    9499#  else 
     100#      if INTVAL_SIZE == 8 
    95101    INTVAL r; 
    96102    r = w << 56; 
    97103    r |= (w & 0xff00) << 40; 
    … …  
    102108    r |= (w & 0xff000000000000) >> 40; 
    103109    r |= (w & 0xff00000000000000) >> 56; 
    104110    return r; 
     111#      else 
     112    exit_fatal(1, "Unsupported INTVAL_SIZE=%d\n", 
     113               INTVAL_SIZE); 
     114#      endif 
    105115#  endif 
    106116#endif 
    107117} 
    … …  
    436446 
    437447/* 
    438448 
     449=item C<void fetch_buf_le_32> 
     450 
     451Converts a 32-byte little-endian buffer C<b> into a big-endian buffer C<b>. 
     452 
     453=cut 
     454 
     455*/ 
     456 
     457void 
     458fetch_buf_le_32(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) 
     459{ 
     460    ASSERT_ARGS(fetch_buf_le_32) 
     461#if !PARROT_BIGENDIAN 
     462    memcpy(rb, b, 32); 
     463#else 
     464    rb[0] = b[31]; 
     465    rb[1] = b[30]; 
     466    rb[2] = b[29]; 
     467    rb[3] = b[28]; 
     468    rb[4] = b[27]; 
     469    rb[5] = b[26]; 
     470    rb[6] = b[25]; 
     471    rb[7] = b[24]; 
     472    rb[8] = b[23]; 
     473    rb[9] = b[22]; 
     474    rb[10] = b[21]; 
     475    rb[11] = b[20]; 
     476    rb[12] = b[19]; 
     477    rb[13] = b[18]; 
     478    rb[14] = b[17]; 
     479    rb[15] = b[16]; 
     480    rb[16] = b[15]; 
     481    rb[17] = b[14]; 
     482    rb[18] = b[13]; 
     483    rb[19] = b[12]; 
     484    rb[20] = b[11]; 
     485    rb[21] = b[10]; 
     486    rb[22] = b[9]; 
     487    rb[23] = b[8]; 
     488    rb[24] = b[7]; 
     489    rb[25] = b[6]; 
     490    rb[26] = b[5]; 
     491    rb[27] = b[4]; 
     492    rb[28] = b[3]; 
     493    rb[29] = b[2]; 
     494    rb[30] = b[1]; 
     495    rb[31] = b[0]; 
     496#endif 
     497} 
     498 
     499/* 
     500 
     501=item C<void fetch_buf_be_32> 
     502 
     503Converts a 32-byte big-endian buffer C<b> into a little-endian buffer C<b>. 
     504 
     505=cut 
     506 
     507*/ 
     508 
     509void 
     510fetch_buf_be_32(ARGOUT(unsigned char *rb), ARGIN(const unsigned char *b)) 
     511{ 
     512    ASSERT_ARGS(fetch_buf_be_32) 
     513#if PARROT_BIGENDIAN 
     514    memcpy(rb, b, 32); 
     515#else 
     516    rb[0] = b[31]; 
     517    rb[1] = b[30]; 
     518    rb[2] = b[29]; 
     519    rb[3] = b[28]; 
     520    rb[4] = b[27]; 
     521    rb[5] = b[26]; 
     522    rb[6] = b[25]; 
     523    rb[7] = b[24]; 
     524    rb[8] = b[23]; 
     525    rb[9] = b[22]; 
     526    rb[10] = b[21]; 
     527    rb[11] = b[20]; 
     528    rb[12] = b[19]; 
     529    rb[13] = b[18]; 
     530    rb[14] = b[17]; 
     531    rb[15] = b[16]; 
     532    rb[16] = b[15]; 
     533    rb[17] = b[14]; 
     534    rb[18] = b[13]; 
     535    rb[19] = b[12]; 
     536    rb[20] = b[11]; 
     537    rb[21] = b[10]; 
     538    rb[22] = b[9]; 
     539    rb[23] = b[8]; 
     540    rb[24] = b[7]; 
     541    rb[25] = b[6]; 
     542    rb[26] = b[5]; 
     543    rb[27] = b[4]; 
     544    rb[28] = b[3]; 
     545    rb[29] = b[2]; 
     546    rb[30] = b[1]; 
     547    rb[31] = b[0]; 
     548#endif 
     549} 
     550 
     551/* 
     552 
    439553=back 
    440554 
    441555=head1 HISTORY 

  • src/packfile/pf_items.c

     
    11/* 
    2 Copyright (C) 2001-2008, The Perl Foundation. 
     2Copyright (C) 2001-2009, Parrot Foundation. 
    33$Id$ 
    44 
    55=head1 NAME 
    … …  
    6060        __attribute__nonnull__(2) 
    6161        FUNC_MODIFIES(*dest); 
    6262 
     63static void cvt_num16_num12( 
     64    ARGOUT(unsigned char *dest), 
     65    ARGIN(const unsigned char *src)) 
     66        __attribute__nonnull__(1) 
     67        __attribute__nonnull__(2) 
     68        FUNC_MODIFIES(*dest); 
     69 
     70static void cvt_num16_num12_le( 
     71    ARGOUT(unsigned char *dest), 
     72    ARGIN(unsigned char *src)) 
     73        __attribute__nonnull__(1) 
     74        __attribute__nonnull__(2) 
     75        FUNC_MODIFIES(*dest); 
     76 
     77static void cvt_num16_num8( 
     78    ARGOUT(unsigned char *dest), 
     79    ARGIN(const unsigned char *src)) 
     80        __attribute__nonnull__(1) 
     81        __attribute__nonnull__(2) 
     82        FUNC_MODIFIES(*dest); 
     83 
     84static void cvt_num16_num8_be( 
     85    ARGOUT(unsigned char *dest), 
     86    ARGIN(const unsigned char *src)) 
     87        __attribute__nonnull__(1) 
     88        __attribute__nonnull__(2) 
     89        FUNC_MODIFIES(*dest); 
     90 
     91static void cvt_num16_num8_le( 
     92    ARGOUT(unsigned char *dest), 
     93    ARGIN(unsigned char *src)) 
     94        __attribute__nonnull__(1) 
     95        __attribute__nonnull__(2) 
     96        FUNC_MODIFIES(*dest); 
     97 
    6398PARROT_WARN_UNUSED_RESULT 
    6499static opcode_t fetch_op_be_4(ARGIN(const unsigned char *b)) 
    65100        __attribute__nonnull__(1); 
    … …  
    97132#define ASSERT_ARGS_cvt_num12_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    98133       PARROT_ASSERT_ARG(dest) \ 
    99134    || PARROT_ASSERT_ARG(src) 
     135#define ASSERT_ARGS_cvt_num16_num12 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     136       PARROT_ASSERT_ARG(dest) \ 
     137    || PARROT_ASSERT_ARG(src) 
     138#define ASSERT_ARGS_cvt_num16_num12_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     139       PARROT_ASSERT_ARG(dest) \ 
     140    || PARROT_ASSERT_ARG(src) 
     141#define ASSERT_ARGS_cvt_num16_num8 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     142       PARROT_ASSERT_ARG(dest) \ 
     143    || PARROT_ASSERT_ARG(src) 
     144#define ASSERT_ARGS_cvt_num16_num8_be __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     145       PARROT_ASSERT_ARG(dest) \ 
     146    || PARROT_ASSERT_ARG(src) 
     147#define ASSERT_ARGS_cvt_num16_num8_le __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     148       PARROT_ASSERT_ARG(dest) \ 
     149    || PARROT_ASSERT_ARG(src) 
    100150#define ASSERT_ARGS_fetch_op_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    101151       PARROT_ASSERT_ARG(b) 
    102152#define ASSERT_ARGS_fetch_op_be_8 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    … …  
    129179 * 
    130180 * Floattype 0 = IEEE-754 8 byte double 
    131181 * Floattype 1 = x86 little endian 12 byte long double 
     182 * Floattype 2 = IEEE-754 16 byte long double 
    132183 * 
    133184 */ 
    134185 
    … …  
    193244 
    194245/* 
    195246 
     247=item C<static void cvt_num12_num8> 
     248 
     249Converts i386 LE 12-byte long double to IEEE 754 8 byte double. 
     250 
     251not yet implemented (throws internal_exception). 
     252 
     253=cut 
     254 
     255*/ 
     256 
     257static void 
     258cvt_num16_num8(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) 
     259{ 
     260    ASSERT_ARGS(cvt_num16_num8) 
     261    exit_fatal(1, "TODO cvt_num16_num8\n"); 
     262} 
     263 
     264/* 
     265 
     266=item C<static void cvt_num16_num12> 
     267 
     268Converts IEEE 754 LE 16-byte long double to i386 LE 12-byte long double . 
     269 
     270Not yet implemented (throws internal_exception). 
     271 
     272=cut 
     273 
     274*/ 
     275 
     276static void 
     277cvt_num16_num12(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) 
     278{ 
     279    ASSERT_ARGS(cvt_num16_num12) 
     280    exit_fatal(1, "TODO cvt_num16_num12\n"); 
     281} 
     282 
     283/* 
     284 
    196285=item C<static void cvt_num12_num8_be> 
    197286 
    198287Converts a 12-byte i386 long double into a big-endian IEEE 754 8-byte double. 
    199 converting to BE not yet implemented (throws internal_exception). 
    200288 
     289Converting to BE not yet implemented (throws internal_exception). 
     290 
    201291=cut 
    202292 
    203293*/ 
    … …  
    206296cvt_num12_num8_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) 
    207297{ 
    208298    ASSERT_ARGS(cvt_num12_num8_be) 
    209     cvt_num12_num8(dest, src); 
    210     /* TODO endianize */ 
    211     exit_fatal(1, "TODO cvt_num12_num8_be\n"); 
     299    unsigned char b[8]; 
     300    cvt_num12_num8(b, src); 
     301    /* TODO test endianize */ 
     302    fetch_buf_le_8(dest, b); 
    212303} 
    213304 
    214305/* 
    … …  
    233324 
    234325/* 
    235326 
     327=item C<static void cvt_num16_num8_le> 
     328 
     329Converts a IEEE 754 16-byte long double into a little-endian IEEE 754 
     3308-byte double. 
     331 
     332Not yet implemented (throws internal_exception). 
     333 
     334=cut 
     335 
     336*/ 
     337 
     338static void 
     339cvt_num16_num8_le(ARGOUT(unsigned char *dest), ARGIN(unsigned char *src)) 
     340{ 
     341    ASSERT_ARGS(cvt_num16_num8_le) 
     342    unsigned char b[8]; 
     343    cvt_num16_num8(b, src); 
     344    fetch_buf_le_8(dest, b); 
     345} 
     346 
     347/* 
     348 
     349=item C<static void cvt_num16_num8_be> 
     350 
     351Converts a IEEE 754 16-byte IA64 long double into a big-endian IEEE 754 8-byte double. 
     352 
     353Not yet implemented (throws internal_exception). 
     354 
     355=cut 
     356 
     357*/ 
     358 
     359static void 
     360cvt_num16_num8_be(ARGOUT(unsigned char *dest), ARGIN(const unsigned char *src)) 
     361{ 
     362    ASSERT_ARGS(cvt_num16_num8_be) 
     363    unsigned char b[8]; 
     364    cvt_num16_num8(b, src); 
     365    fetch_buf_be_8(dest, b); 
     366} 
     367 
     368/* 
     369 
     370=item C<static void cvt_num16_num12_le> 
     371 
     372Converts a IEEE 754 16-byte BE long double into a 12-byte i386 long double. 
     373 
     374Not yet implemented (throws internal_exception). 
     375 
     376=cut 
     377 
     378*/ 
     379 
     380static void 
     381cvt_num16_num12_le(ARGOUT(unsigned char *dest), ARGIN(unsigned char *src)) 
     382{ 
     383    ASSERT_ARGS(cvt_num16_num12_le) 
     384    unsigned char b[12]; 
     385    cvt_num16_num12(b, src); 
     386    fetch_buf_le_12(dest, b); 
     387} 
     388 
     389/* 
     390 
    236391=item C<static opcode_t fetch_op_test> 
    237392 
    238393Fetches an C<opcode_t> operation in little-endian format. 
    … …  
    643798    else if (pf->header->floattype == FLOATTYPE_12) { 
    644799        *((const unsigned char **) (stream)) += 12; 
    645800    } 
     801    else if (pf->header->floattype == FLOATTYPE_16) { 
     802        *((const unsigned char **) (stream)) += 16; 
     803    } 
    646804    return f; 
    647805} 
    648806 
    … …  
    9331091        else 
    9341092            pf->fetch_op = fetch_op_le_8; 
    9351093 
    936         if (pf->header->floattype) 
     1094        if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8) 
     1095            pf->fetch_nv = fetch_buf_le_8; 
     1096        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 12) 
     1097            pf->fetch_nv = fetch_buf_le_12; 
     1098        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16) 
     1099            pf->fetch_nv = fetch_buf_le_16; 
     1100        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8) 
    9371101            pf->fetch_nv = cvt_num12_num8_le; 
     1102        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 12) 
     1103            pf->fetch_nv = cvt_num16_num12_le; 
     1104        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8) 
     1105            pf->fetch_nv = cvt_num16_num8_le; 
    9381106        else 
    939             pf->fetch_nv = fetch_buf_le_8; 
     1107            exit_fatal(1, 
     1108              "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n", 
     1109              NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); 
     1110        return 0; 
    9401111    } 
    9411112    else { 
    9421113        if (pf->header->wordsize == 4) 
    9431114            pf->fetch_op = fetch_op_be_4; 
    9441115        else 
    9451116            pf->fetch_op = fetch_op_be_8; 
     1117 
     1118        if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8) 
     1119            pf->fetch_nv = fetch_buf_be_8; 
     1120        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 12) 
     1121            pf->fetch_nv = fetch_buf_be_12; 
     1122        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16) 
     1123            pf->fetch_nv = fetch_buf_be_16; 
     1124        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8) 
     1125            pf->fetch_nv = cvt_num12_num8; 
     1126        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 12) 
     1127            pf->fetch_nv = cvt_num16_num12; 
     1128        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8) 
     1129            pf->fetch_nv = cvt_num16_num8; 
     1130        else { 
     1131            exit_fatal(1, 
     1132                       "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n", 
     1133                       NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); 
     1134        } 
    9461135    } 
    9471136 
    9481137#else 
    9491138 
     1139    pf->fetch_iv = pf->fetch_op; 
    9501140    /* this Parrot is on a LITTLE ENDIAN machine */ 
    9511141    if (need_endianize) { 
    9521142        if (pf->header->wordsize == 4) 
    … …  
    9541144        else 
    9551145            pf->fetch_op = fetch_op_be_8; 
    9561146 
    957         if (pf->header->floattype) 
     1147        if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8) 
     1148            pf->fetch_nv = fetch_buf_be_8; 
     1149        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16) 
     1150            pf->fetch_nv = fetch_buf_be_16; 
     1151        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8) 
    9581152            pf->fetch_nv = cvt_num12_num8_be; 
    959         else 
    960             pf->fetch_nv = fetch_buf_be_8; 
     1153        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8) 
     1154            pf->fetch_nv = cvt_num16_num8_be; 
     1155        else { 
     1156            exit_fatal(1, 
     1157                       "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n", 
     1158                       NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); 
     1159            return; 
     1160        } 
    9611161    } 
    9621162    else { 
    9631163        if (pf->header->wordsize == 4) 
    9641164            pf->fetch_op = fetch_op_le_4; 
    9651165        else 
    9661166            pf->fetch_op = fetch_op_le_8; 
    967         if (NUMVAL_SIZE == 8 && pf->header->floattype) 
     1167 
     1168        if (pf->header->floattype == FLOATTYPE_8 && NUMVAL_SIZE == 8) 
     1169            pf->fetch_nv = fetch_buf_le_8; 
     1170        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 12) 
     1171            pf->fetch_nv = fetch_buf_le_12; 
     1172        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 16) 
     1173            pf->fetch_nv = fetch_buf_le_16; 
     1174        else if (pf->header->floattype == FLOATTYPE_12 && NUMVAL_SIZE == 8) 
    9681175            pf->fetch_nv = cvt_num12_num8; 
    969         else if (NUMVAL_SIZE != 8 && ! pf->header->floattype) 
    970             pf->fetch_nv = fetch_buf_le_8; 
     1176        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 12) 
     1177            pf->fetch_nv = cvt_num16_num12; 
     1178        else if (pf->header->floattype == FLOATTYPE_16 && NUMVAL_SIZE == 8) 
     1179            pf->fetch_nv = cvt_num16_num8; 
     1180        else { 
     1181            exit_fatal(1, 
     1182                       "PackFile_unpack: unsupported float conversion %d to %d, PARROT_BIGENDIAN=%d\n", 
     1183                       NUMVAL_SIZE, pf->header->floattype, PARROT_BIGENDIAN); 
     1184        } 
    9711185    } 
    9721186#endif 
    973     pf->fetch_iv = pf->fetch_op; 
    9741187} 
    9751188 
    9761189/* 
    … …  
    9851198 
    9861199Renamed PackFile_* to PF_* 
    9871200 
     1201Added 16 byte types. 
     1202 
    9881203=head1 TODO 
    9891204 
    9901205C<<PF_store_<type>()>> - write an opcode_t stream to cursor in natural 

  • src/packfile.c

     
    939939    } 
    940940 
    941941    /* Ensure the bytecode version is one we can read. Currently, we only 
    942      * support bytecode versions matching the current one. */ 
     942     * support bytecode versions matching the current one. 
     943     * 
     944     * tools/dev/pbc_header.pl --upd t/native_pbc/ *.pbc 
     945     * stamps version and fingerprint in the native tests. */ 
    943946    if (header->bc_major != PARROT_PBC_MAJOR 
    944947    &&  header->bc_minor != PARROT_PBC_MINOR) { 
    945948        Parrot_io_eprintf(NULL, "PackFile_unpack: This Parrot cannot read bytecode " 
    … …  
    970973    TRACE_PRINTF(("PackFile_unpack: Wordsize %d.\n", header->wordsize)); 
    971974    TRACE_PRINTF(("PackFile_unpack: Floattype %d (%s).\n", 
    972975                  header->floattype, 
    973                   header->floattype ? 
    974                   "x86 little endian 12 byte long double" : 
    975                   "IEEE-754 8 byte double")); 
     976                  header->floattype == FLOATTYPE_8 
     977                      ? FLOATTYPE_8_NAME 
     978                      : header->floattype == FLOATTYPE_16 
     979                          ? FLOATTYPE_16_NAME 
     980                          : FLOATTYPE_12_NAME)); 
    976981    TRACE_PRINTF(("PackFile_unpack: Byteorder %d (%sendian).\n", 
    977982                  header->byteorder, header->byteorder ? "big " : "little-")); 
    978983 
    … …  
    12251230    header->bc_major    = PARROT_PBC_MAJOR; 
    12261231    header->bc_minor    = PARROT_PBC_MINOR; 
    12271232#if NUMVAL_SIZE == 8 
    1228     header->floattype = 0; 
     1233    header->floattype = FLOATTYPE_8; 
    12291234#else 
    12301235#  if (NUMVAL_SIZE == 12) && PARROT_BIGENDIAN 
    1231     header->floattype = 1; 
     1236    header->floattype = FLOATTYPE_12; 
    12321237#  else 
     1238#    if (NUMVAL_SIZE == 16) 
     1239    header->floattype = FLOATTYPE_16; 
     1240#    else 
    12331241    exit_fatal(1, "PackFile_set_header: Unsupported floattype NUMVAL_SIZE=%d," 
    12341242               " PARROT_BIGENDIAN=%d\n", NUMVAL_SIZE, PARROT_BIGENDIAN); 
     1243#    endif 
    12351244#  endif 
    12361245#endif 
    12371246} 
    … …  
    40614070        self->groups[i]                  = mem_allocate_typed(PackFile_Annotations_Group); 
    40624071        self->groups[i]->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor); 
    40634072        self->groups[i]->entries_offset  = PF_fetch_opcode(seg->pf, &cursor); 
    4064         TRACE_PRINTF_VAL(("PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n", 
    4065                           i, self->num_groups, self->groups[i]->bytecode_offset, self->groups[i]->entries_offset)); 
     4073        TRACE_PRINTF_VAL(( 
     4074           "PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n", 
     4075           i, self->num_groups, self->groups[i]->bytecode_offset, 
     4076           self->groups[i]->entries_offset)); 
    40664077    } 
    40674078 
    40684079    /* Unpack entries. */ 

  • tools/dev/mk_native_pbc

     
    1212#        update the VERSION and rm .parrot_current_rev 
    1313 
    1414#  _1   i386 32 bit opcode_t, 32 bit intval   (linux-gcc-ix86, freebsd-gcc, cygwin) 
    15 #  _2   i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86) 
     15#  _2   i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86) 
    1616#  _3   PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc) 
    1717#  _4   x86_64 double float 64 bit opcode_t   (linux-gcc-x86_64, solaris-cc-64int) 
    18 #  _5   big-endian 64-bit                     (irix or similar) 
     18#  _5   x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int) 
     19#  _6   big-endian 64-bit                     (irix or similar) 
    1920 
    2021#tests: 
    2122#parrot -o i.pbc -a - <<EOF 
    … …  
    3940then 
    4041    if [ "$byteorder" == "1234" ] 
    4142    then 
     43        echo "1: i386 32 bit opcode_t, 32 bit intval" 
    4244        N=1 
    4345        if [ "$(perl -V:uselongdouble)" == "uselongdouble='define';" ]; then 
    4446            enable_long_double=1 
    45             conf=" --floatval=double" 
     47            # force double on 2nd run not to default to long double 
     48            conf=" --floatval='double'" 
    4649        fi 
    4750    else 
    4851        if [ "$byteorder" == "4321" ] 
    4952        then 
     53            echo "3: PPC BE 32 bit opcode_t, 32 bit intval" 
    5054            N=3 
    5155        else 
    5256            if [ "$byteorder" == "12345678" \ 
    5357                 -a "$(perl -V:osname)" == "osname='cygwin';" ] 
    5458            then 
    55                 echo "detected cygwin use64bitint: ok" 
     59                echo "1: cygwin use64bitint" 
    5660                N=1 
    5761                exe=.exe 
    5862            else 
    59                 echo "unsupported perl -V:byteorder $byteorder" 
    60                 exit 1 
     63                echo "Sorry, unsupported perl - parrot ptrsize mismatch." 
     64                exit 
    6165            fi 
    6266        fi 
    6367    fi 
    … …  
    6670    then 
    6771        if [ "$byteorder" == "12345678" ] 
    6872        then 
     73            echo "4+5: x86_64 double float 64 bit opcode_t + long double" 
    6974            N=4 
     75            enable_long_double=1 
    7076        else 
    71             N=5 
     77            echo "6: big-endian 64-bit" 
     78            N=6 
    7279        fi 
    7380    else 
    7481        echo "unsupported perl -V:ptrsize $ptrsize" 
    … …  
    8390    fi 
    8491    tail myconfig 
    8592    make -s || exit 1 
     93    M=$((N+1)) 
    8694    [ -e t/op/number_1.pasm ] || perl t/harness t/op/number.t 
    87     [ -e t/op/string_133.pasm ] || perl t/harness t/op/string.t 
    88     ./parrot -o t/native_pbc/integer_2.pbc -a - <<EOF 
    89 print 0x10203040 
    90 end 
    91 EOF 
    92     [ $? -le 0 ] && echo "t/native_pbc/integer_2.pbc updated" 
    93     ./parrot -o t/native_pbc/number_2.pbc t/op/number_1.pasm && echo "t/native_pbc/number_2.pbc updated" 
    94     ./parrot -o t/native_pbc/string_2.pbc t/op/string_133.pasm  && echo "t/native_pbc/string_2.pbc updated" 
    95  
     95    ./parrot -o t/native_pbc/number_${M}.pbc t/op/number_1.pasm && echo "t/native_pbc/number_${M}.pbc updated" 
    9696    make pbc_dump$exe 
    97     ./pbc_dump -h t/native_pbc/number_2.pbc 
     97    ./pbc_dump -h t/native_pbc/number_${M}.pbc 
    9898fi 
    9999 
    100100if [ "$1" != "--noconf" ]; then 

  • include/parrot/packfile.h

     
    2828#define FLOATTYPE_8_NAME      "IEEE-754 8 byte double" 
    2929#define FLOATTYPE_12          1 
    3030#define FLOATTYPE_12_NAME     "x86 little endian 12 byte long double" 
    31 #define FLOATTYPE_MAX         1 
     31#define FLOATTYPE_16          2 
     32#define FLOATTYPE_16_NAME     "IEEE-754 16 byte long double" 
     33#define FLOATTYPE_MAX         2 
     34/* Unsupported NaN difference, but patches welcome */ 
     35#define FLOATTYPE_16MIPS      3 
     36#define FLOATTYPE_16MIPS_NAME "MIPS 16 byte long double" 
     37/* Not yet set into silicon AFAIK */ 
     38#define FLOATTYPE_32          4 
     39#define FLOATTYPE_32_NAME     "256-bit extended double" 
    3240 
    3341#define TRACE_PACKFILE 0 
    3442 
    … …  
    11231131        __attribute__nonnull__(2) 
    11241132        FUNC_MODIFIES(*rb); 
    11251133 
     1134void fetch_buf_be_32( 
     1135    ARGOUT(unsigned char *rb), 
     1136    ARGIN(const unsigned char *b)) 
     1137        __attribute__nonnull__(1) 
     1138        __attribute__nonnull__(2) 
     1139        FUNC_MODIFIES(*rb); 
     1140 
    11261141void fetch_buf_be_4( 
    11271142    ARGOUT(unsigned char *rb), 
    11281143    ARGIN(const unsigned char *b)) 
    … …  
    11511166        __attribute__nonnull__(2) 
    11521167        FUNC_MODIFIES(*rb); 
    11531168 
     1169void fetch_buf_le_32( 
     1170    ARGOUT(unsigned char *rb), 
     1171    ARGIN(const unsigned char *b)) 
     1172        __attribute__nonnull__(1) 
     1173        __attribute__nonnull__(2) 
     1174        FUNC_MODIFIES(*rb); 
     1175 
    11541176void fetch_buf_le_4( 
    11551177    ARGOUT(unsigned char *rb), 
    11561178    ARGIN(const unsigned char *b)) 
    … …  
    11871209#define ASSERT_ARGS_fetch_buf_be_16 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    11881210       PARROT_ASSERT_ARG(rb) \ 
    11891211    || PARROT_ASSERT_ARG(b) 
     1212#define ASSERT_ARGS_fetch_buf_be_32 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     1213       PARROT_ASSERT_ARG(rb) \ 
     1214    || PARROT_ASSERT_ARG(b) 
    11901215#define ASSERT_ARGS_fetch_buf_be_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    11911216       PARROT_ASSERT_ARG(rb) \ 
    11921217    || PARROT_ASSERT_ARG(b) 
    … …  
    11991224#define ASSERT_ARGS_fetch_buf_le_16 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    12001225       PARROT_ASSERT_ARG(rb) \ 
    12011226    || PARROT_ASSERT_ARG(b) 
     1227#define ASSERT_ARGS_fetch_buf_le_32 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
     1228       PARROT_ASSERT_ARG(rb) \ 
     1229    || PARROT_ASSERT_ARG(b) 
    12021230#define ASSERT_ARGS_fetch_buf_le_4 __attribute__unused__ int _ASSERT_ARGS_CHECK = \ 
    12031231       PARROT_ASSERT_ARG(rb) \ 
    12041232    || PARROT_ASSERT_ARG(b) 

  • compilers/imcc/optimizer.c

     
    910910    const char *debug_fmt = NULL;   /* gcc -O uninit warn */ 
    911911    int found, branched; 
    912912 
    913     /* construct a FLOATVAL_FMT with needed precision */ 
     913    /* construct a FLOATVAL_FMT with needed precision. 
     914      TT #308  XXX Should use Configure.pl to figure these out, 
     915      but it's not clear just what is needed. 
     916      The value of '16' for NUMVAL_SIZE == 8 was one larger than the 
     917      default FLOATVAL_FMT of '15' determined by Configure.pl.  The 
     918      reason for this difference, if there is one, should be documented. 
     919      The values of.18Lg and .31Lg are guesses. 
     920    */ 
    914921#if NUMVAL_SIZE == 8 
    915922    fmt = "%0.16g"; 
    916923#elif NUMVAL_SIZE == 12 
    917924    fmt = "%0.18Lg"; 
     925#elif NUMVAL_SIZE == 16 
     926    fmt = "%0.31Lg"; 
    918927#else 
    919928    fmt = FLOATVAL_FMT; 
    920     IMCC_warning(interp, "subs_constants", "used default FLOATVAL_FMT\n"); 
     929    /* Since it's not clear why this is needed, it's not clear what to 
     930       do if it's an unknown case. 
     931    */ 
     932    IMCC_fatal(interp, 0, 
     933       "IMCC_subst_constants:  unexpected NUMVAL_SIZE = %d\n", 
     934       NUMVAL_SIZE); 
    921935#endif 
    922936 
    923937    tmp = NULL; 

  • t/compilers/imcc/imcpasm/opt1.t

     
    66use warnings; 
    77use lib qw( . lib ../lib ../../lib ); 
    88use Parrot::Test tests => 78; 
     9use Parrot::Config; 
    910 
     11my $output; 
     12 
    1013# these tests are run with -O1 by TestCompiler and show 
    1114# generated PASM code for various optimizations at level 1 
    1215 
    … …  
    11511154 
    11521155############################## 
    11531156 
    1154 pir_2_pasm_like( <<'CODE', <<'OUT', "constant add big nums" ); 
     1157$output = $PConfig{numvalsize} == 8 
     1158  ? '/^# IMCC does produce b0rken PASM files 
     1159# see http://guest@rt.perl.org/rt3/Ticket/Display.html\?id=32392 
     1160_main: 
     1161   set N0, 1\.6e\+0?22 
     1162   end$/ 
     1163' : '/^# IMCC does produce b0rken PASM files 
     1164# see http://guest@rt.perl.org/rt3/Ticket/Display.html\?id=32392 
     1165_main: 
     1166   set N0, 16000000000000000000000 
     1167   end$/ 
     1168'; 
     1169 
     1170pir_2_pasm_like( <<'CODE', $output, "constant add big nums" ); 
    11551171.sub _main 
    11561172   add $N0, 10.0e20, 15.0e21 
    11571173   end 
    11581174.end 
    11591175CODE 
    1160 /^# IMCC does produce b0rken PASM files 
    1161 # see http://guest@rt.perl.org/rt3/Ticket/Display.html\?id=32392 
    1162 _main: 
    1163    set N0, 1\.6e\+0?22 
    1164    end$/ 
    1165 OUT 
    11661176 
    11671177############################## 
    11681178SKIP: { 

  • t/native_pbc/number.t

     
    88use Test::More; 
    99use Parrot::Config; 
    1010 
    11 use Parrot::Test tests => 4; 
     11use Parrot::Test tests => 5; 
    1212 
    1313=head1 NAME 
    1414 
    … …  
    3030=head1 PLATFORMS 
    3131 
    3232  _1   i386 32 bit opcode_t, 32 bit intval   (linux-gcc-ix86, freebsd-gcc, cygwin) 
    33   _2   i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86) 
     33  _2   i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86) 
    3434  _3   PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc) 
    3535  _4   x86_64 double float 64 bit opcode_t   (linux-gcc-x86_64, solaris-cc-64int) 
    36   _5   big-endian 64-bit                     (irix or similar) 
     36  _5   x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int) 
     37  _6   big-endian 64-bit                     (MIPS irix or similar) 
    3738 
    3839=cut 
    3940 
    … …  
    116117pbc_output_is( undef, $output, "i386 double float 32 bit opcode_t" ) 
    117118    or diag "May need to regenerate t/native_pbc/number_1.pbc; read test file"; 
    118119 
     120# HEADER => [ 
     121#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
     122#         byteorder = 0   (interpreter's byteorder       = 0) 
     123#         floattype = 1   (interpreter's NUMVAL_SIZE     = 12) 
     124#         parrot-version 0.9.0, bytecode-version 3.34 
     125#         UUID type = 0, UUID size = 0 
     126#         no endianize, no opcode, no numval transform 
     127#         dirformat = 1 
     128# ] 
    119129pbc_output_is( undef, $output, "i386 long double float 32 bit opcode_t") 
    120130    or diag "May need to regenerate t/native_pbc/number_2.pbc; read test file"; 
    121131 
    122 } 
    123  
    124132# darwin/ppc: 
    125133# HEADER => [ 
    126134#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
    … …  
    132140#         dirformat = 1 
    133141# ] 
    134142 
     143pbc_output_is(undef, $output, "PPC double float 32 bit BE opcode_t") 
     144    or diag "May need to regenerate t/native_pbc/number_3.pbc; read test file"; 
     145} 
     146 
    135147TODO: { 
    136148local $TODO = "devel versions are not guaranteed to succeed" 
    137149  if $PConfig{DEVEL}; 
    138150 
    139 pbc_output_is(undef, $output, "PPC double float 32 bit BE opcode_t") 
    140     or diag "May need to regenerate t/native_pbc/number_3.pbc; read test file"; 
    141  
    142151# any ordinary 64-bit intel unix: 
    143152# HEADER => [ 
    144153#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
    … …  
    153162pbc_output_is(undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval") 
    154163    or diag "May need to regenerate t/native_pbc/number_4.pbc; read test file"; 
    155164 
     165# HEADER => [ 
     166#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
     167#         byteorder = 0   (interpreter's byteorder       = 0) 
     168#         floattype = 2   (interpreter's NUMVAL_SIZE     = 16) 
     169#         parrot-version 0.9.0, bytecode-version 3.34 
     170#         UUID type = 0, UUID size = 0 
     171#         no endianize, no opcode, no numval transform 
     172#         dirformat = 1 
     173# ] 
     174pbc_output_is(undef, $output, "i86_64 LE 64 bit opcode_t, 64 bit intval, long double") 
     175    or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file"; 
     176 
    156177# Formerly there were also a test for: 
    157178# pbc_output_is(undef, $output, "big-endian 64-bit irix") 
    158 #   or diag "May need to regenerate t/native_pbc/number_5.pbc; read test file"; 
     179#   or diag "May need to regenerate t/native_pbc/number_6.pbc; read test file"; 
    159180 
    160181} 
    161182 

  • t/native_pbc/header.t

     
    6666is( $h{magic}, "\xfe\x50\x42\x43\x0a\x1a\x0a", "magic string 0xfePBC0x0a0x1a0x0a len=7" ); 
    6767ok( $h{wordsize} == 2 || $h{wordsize} == 4 || $h{wordsize} == 8,  "wordsize: $h{wordsize}" ); 
    6868ok( $h{byteorder} < 2, "byteorder: $h{byteorder}" ); 
    69 ok( $h{floattype} < 4, "floattype: $h{floattype}" ); 
     69ok( $h{floattype} < 3, "floattype: $h{floattype}" ); 
    7070is( $h{major}, $PConfig{MAJOR}, "major version: $h{major} vs $PConfig{MAJOR}" ); 
    7171is( $h{minor}, $PConfig{MINOR}, "minor version: $h{minor} vs $PConfig{MINOR}" ); 
    7272is( $h{patch}, $PConfig{PATCH}, "patch version: $h{patch} vs $PConfig{PATCH}" ); 

  • t/native_pbc/integer.t

     
    88use Test::More; 
    99use Parrot::Config; 
    1010 
    11 use Parrot::Test tests => 4; 
     11use Parrot::Test tests => 5; 
    1212 
    1313=head1 NAME 
    1414 
    … …  
    3030=head1 PLATFORMS 
    3131 
    3232  _1   i386 32 bit opcode_t, 32 bit intval   (linux-gcc-ix86, freebsd-gcc, cygwin) 
    33   _2   i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86) 
     33  _2   i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86) 
    3434  _3   PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc) 
    3535  _4   x86_64 double float 64 bit opcode_t   (linux-gcc-x86_64, solaris-cc-64int) 
    36   _5   big-endian 64-bit                     (irix or similar) 
     36  _5   x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int) 
     37  _6   big-endian 64-bit                     (MIPS irix or similar) 
    3738 
    3839=cut 
    3940 
    … …  
    8687 
    8788pbc_output_is( undef, '270544960', "i386 32 bit opcode_t, 32 bit intval" ) 
    8889    or diag "May need to regenerate t/native_pbc/integer_1.pbc; read test file"; 
    89 } 
    9090 
    91 TODO: { 
    92 local $TODO = "devel versions are not guaranteed to succeed" 
    93   if $PConfig{DEVEL}; 
     91# HEADER => [ 
     92#         wordsize  = 4   (interpreter's wordsize/INTVAL = 4/4) 
     93#         byteorder = 0   (interpreter's byteorder       = 0) 
     94#         floattype = 1   (interpreter's NUMVAL_SIZE     = 12) 
     95#         parrot-version 0.9.0, bytecode-version 3.34 
     96#         UUID type = 0, UUID size = 0 
     97#         no endianize, no opcode, no numval transform 
     98#         dirformat = 1 
     99# ] 
    94100pbc_output_is( undef, '270544960', "i386 32 bit opcode_t, 32 bit intval long double" ) 
    95101    or diag "May need to regenerate t/native_pbc/integer_2.pbc; read test file"; 
    96102 
    … …  
    108114pbc_output_is(undef, '270544960', "PPC BE 32 bit opcode_t, 32 bit intval") 
    109115    or diag "May need to regenerate t/native_pbc/integer_3.pbc; read test file"; 
    110116 
     117} 
     118 
     119TODO: { 
     120local $TODO = "devel versions are not guaranteed to succeed" 
     121  if $PConfig{DEVEL}; 
     122 
    111123# any ordinary 64-bit intel unix: 
    112124# HEADER => [ 
    113125#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
    … …  
    122134pbc_output_is(undef, '270544960', "i86_64 LE 64 bit opcode_t, 64 bit intval") 
    123135    or diag "May need to regenerate t/native_pbc/integer_4.pbc; read test file"; 
    124136 
     137# HEADER => [ 
     138#         wordsize  = 8   (interpreter's wordsize/INTVAL = 8/8) 
     139#         byteorder = 0   (interpreter's byteorder       = 0) 
     140#         floattype = 2   (interpreter's NUMVAL_SIZE     = 16) 
     141#         parrot-version 0.9.0, bytecode-version 3.34 
     142#         UUID type = 0, UUID size = 0 
     143#         no endianize, no opcode, no numval transform 
     144#         dirformat = 1 
     145# ] 
     146 
     147pbc_output_is(undef, '270544960', "i86_64 LE 64 bit opcode_t, 64 bit intval, long double") 
     148    or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file"; 
     149 
    125150# Formerly following tests had been set up: 
    126151# pbc_output_is(undef, '270544960', "big-endian 64-bit (irix)"); 
    127 #    or diag "May need to regenerate t/native_pbc/integer_5.pbc; read test file"; 
     152#    or diag "May need to regenerate t/native_pbc/integer_6.pbc; read test file"; 
    128153 
    129154} 
    130155 

  • t/native_pbc/string.t

     
    3030=head1 PLATFORMS 
    3131 
    3232  _1   i386 32 bit opcode_t, 32 bit intval   (linux-gcc-ix86, freebsd-gcc, cygwin) 
    33   _2   i386 32 bit opcode_t, 32 bit intval, long double (linux-gcc-ix86) 
     33  _2   i386 32 bit opcode_t, 32 bit intval, 12 bit long double (linux-gcc-ix86) 
    3434  _3   PPC BE 32 bit opcode_t, 32 bit intval (darwin-ppc) 
    3535  _4   x86_64 double float 64 bit opcode_t   (linux-gcc-x86_64, solaris-cc-64int) 
    36   _5   big-endian 64-bit                     (irix or similar) 
     36  _5   x86_64 16 bit long double 64 bit opcode_t (linux-gcc-x86_64, solaris-cc-64int) 
     37  _6   big-endian 64-bit                     (MIPS irix or similar) 
    3738 
    3839=cut 
    3940 

  • t/op/jitn.t

     
    77use lib qw( . lib ../lib ../../lib ); 
    88use Test::More; 
    99use Parrot::Test tests => 14; 
     10use Parrot::Config; 
    1011 
    1112=head1 NAME 
    1213 
    … …  
    2324 
    2425=cut 
    2526 
     27my $output; 
     28 
    2629pasm_output_is( <<'CODE', <<'OUTPUT', "sub_n_n_n 1,2,3 mapped" ); 
    2730set N0,0 
    2831set N1,1 
    … …  
    320323123 
    321324OUT 
    322325 
    323 pasm_output_is( <<'CODE', <<'OUTPUT', "rounding due to mapped" ); 
     326$output = $PConfig{numvalsize} < 16 ? "zero\n" : "not zero\n"; 
     327pasm_output_is( <<'CODE', $output, "rounding due to mapped" ); 
    324328    set N0, 15 
    325329    mul N0, N0, 0.1 
    326330    sub N0, 1.5 
    … …  
    330334    print "zero\n" 
    331335    end 
    332336CODE 
    333 zero 
    334 OUTPUT 
    335337 
    336338# Local Variables: 
    337339#   mode: cperl 

  • t/op/number.t

     
    77use lib qw( . lib ../lib ../../lib ); 
    88use Test::More; 
    99use Parrot::Test tests => 56; 
     10use Parrot::Config; 
    1011 
    1112=head1 NAME 
    1213 
    … …  
    2223 
    2324=cut 
    2425 
     26my $output; 
     27 
    2528pasm_output_is( <<CODE, <<OUTPUT, "set_n_nc" ); 
    2629        set     N0, 1.0 
    2730        set     N1, 4.0 
    … …  
    107810810.5 
    10791082OUTPUT 
    10801083 
    1081 pasm_output_is( <<'CODE', <<OUTPUT, "sqrt_n_n" ); 
     1084# long double succeeds 
     1085$output = $PConfig{numvalsize} == 8 
     1086  ? '1.4142135623731 
     10871.41421356237309 
     1088' : '1.4142135623731 
     10891.4142135623731 
     1090'; 
     1091pasm_output_is( <<'CODE', $output, "sqrt_n_n" ); 
    10821092        set N1, 2 
    10831093        sqrt N2, N1 
    1084         print N2 
    1085         print "\n" 
     1094        say N2 
    10861095        sqrt N2, 2.0 
    1087         print N2 
    1088         print "\n" 
     1096        say N2 
    10891097        end 
    10901098CODE 
    1091 1.4142135623731 
    1092 1.41421356237309 
    1093 OUTPUT 
    10941099 
    10951100pasm_error_output_like( <<'CODE', <<OUTPUT, "div_n_n by zero" ); 
    10961101        set N0, 0