libchill/format.c

   1 /* Implement Input/Output runtime actions for CHILL.
   2    Copyright (C) 1992,1993 Free Software Foundation, Inc.
   3    Author: Wilfried Moser, et al
   4
   5 This file is part of GNU CC.
   6
   7 GNU CC is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation; either version 2, or (at your option)
  10 any later version.
  11
  12 GNU CC is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with GNU CC; see the file COPYING.  If not, write to
  19 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20
  21 /* As a special exception, if you link this library with other files,
  22    some of which are compiled with GCC, to produce an executable,
  23    this library does not by itself cause the resulting executable
  24    to be covered by the GNU General Public License.
  25    This exception does not however invalidate any other reasons why
  26    the executable file might be covered by the GNU General Public License.  */
  27
  28 #include <limits.h>
  29 #include <string.h>
  30 #include <ctype.h>
  31 #include <setjmp.h>
  32 #include <float.h>
  33 #include <math.h>
  34 #include <stdlib.h>
  35 #if _TEXTIO_DEBUG_
  36 #include <stdio.h>
  37 #endif
  38
  39 #include "bitstring.h"
  40 #include "auxtypes.h"
  41 #include "iomodes.h"
  42 #include "format.h"
  43 #include "fileio.h"
  44 #include "ioerror.h"
  45
  46 #define CH_BYTE_MIN   0xffffff80L
  47 #define CH_BYTE_MAX   0x0000007fL
  48 #define CH_UBYTE_MAX  0x000000ffUL
  49 #define CH_INT_MIN    0xffff8000L
  50 #define CH_INT_MAX    0x00007fffL
  51 #define CH_UINT_MAX   0x0000ffffUL
  52 #define CH_LONG_MIN   0x80000000L
  53 #define CH_LONG_MAX   0x7fffffffL
  54 #define CH_ULONG_MAX  0xffffffffUL
  55
  56 #ifndef M_LN2
  57 #define M_LN2   0.69314718055994530942
  58 #endif
  59 #ifndef M_LN10
  60 #define M_LN10          2.30258509299404568402
  61 #endif
  62
  63 #define DMANTDIGS  (1 + (int)(DBL_MANT_DIG * M_LN2 / M_LN10))
  64 #define FMANTDIGS  (1 + (int)(FLT_MANT_DIG * M_LN2 / M_LN10))
  65
  66 /* float register length */
  67 #define MAXPREC 40
  68
  69 #define LET 0x0001
  70 #define BIN 0x0002
  71 #define DEC 0x0004
  72 #define OCT 0x0008
  73 #define HEX 0x0010
  74 #define USC 0x0020
  75 #define BIL 0x0040
  76 #define SPC 0x0080
  77 #define SCS 0x0100
  78 #define IOC 0x0200
  79 #define EDC 0x0400
  80 #define CVC 0x0800
  81
  82 #define isDEC(c)  ( chartab[(c)] & DEC )
  83 #define isCVC(c)  ( chartab[(c)] & CVC )
  84 #define isEDC(c)  ( chartab[(c)] & EDC )
  85 #define isIOC(c)  ( chartab[(c)] & IOC )
  86 #define isUSC(c)
  87 #define isXXX(c,XXX)  ( chartab[(c)] & XXX )
  88
  89 /*
  90  *  local definitions
  91  */
  92
  93 static
  94 short int chartab[256] = {
  95   0, 0, 0, 0, 0, 0, 0, 0,
  96   0, SPC, SPC, SPC, SPC, SPC, 0, 0,
  97
  98   0, 0, 0, 0, 0, 0, 0, 0,
  99   0, 0, 0, 0, 0, 0, 0, 0,
 100
 101   SPC, IOC, 0, 0, 0, 0, 0, 0,
 102   SCS, SCS, SCS, SCS+IOC, SCS, SCS+IOC, SCS, SCS+IOC,
 103   BIN+OCT+DEC+HEX, BIN+OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX,
 104      OCT+DEC+HEX, OCT+DEC+HEX, OCT+DEC+HEX,
 105   DEC+HEX, DEC+HEX, SCS, SCS, SCS+EDC, SCS+IOC, SCS+EDC, IOC,
 106
 107   0, LET+HEX+BIL, LET+HEX+BIL+CVC, LET+HEX+BIL+CVC, LET+HEX+BIL, LET+HEX,
 108      LET+HEX+CVC, LET,
 109   LET+BIL+CVC, LET, LET, LET, LET, LET, LET, LET+CVC,
 110
 111   LET, LET, LET, LET, LET+EDC, LET, LET, LET,
 112   LET+EDC, LET, LET, SCS, 0, SCS, 0, USC,
 113
 114   0, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET+HEX, LET,
 115   LET, LET, LET, LET, LET, LET, LET, LET,
 116
 117   LET, LET, LET, LET, LET, LET, LET, LET,
 118   LET, LET, LET, 0, 0, 0, 0, 0
 119 };
 120
 121 typedef enum {
 122   FormatText, FirstPercent, RepFact, ConvClause, EditClause, ClauseEnd,
 123   AfterWidth, FractWidth, FractWidthCont, ExpoWidth, ExpoWidthCont,
 124   ClauseWidth, CatchPadding, LastPercent
 125 } fcsstate_t;
 126
 127 #define CONVERSIONCODES "CHOBF"
 128 typedef enum {
 129   DefaultConv, HexConv, OctalConv, BinaryConv, ScientConv
 130 } convcode_t;
 131
 132 static
 133 short int base[4] = { 10, 16, 8, 2 };
 134
 135 static
 136 short int dset[4] = { DEC, HEX, OCT, BIN };
 137
 138 #define EDITCODES "X<>T"
 139 typedef enum {
 140   SpaceSkip, SkipLeft, SkipRight, Tabulation
 141 } editcode_t;
 142
 143 #define IOCODES "/+-?!="
 144 typedef enum {
 145   NextRecord, NextPage, CurrentLine, Prompt, Emit, EndPage
 146 } iocode_t;
 147
 148 typedef enum {
 149   ConvAct, EditAct, IOAct
 150 } acttype_t;
 151
 152 typedef enum {
 153   NormalEnd, EndAtParen, TextFailEnd
 154 } formatexit_t;
 155
 156 static
 157 double ep_1[10] = {
 158   1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9 };
 159 static
 160 double ep_10[10] = {
 161   1e0, 1e10, 1e20, 1e30, 1e40, 1e50, 1e60, 1e70, 1e80, 1e90 };
 162 static
 163 double ep_100 = 1e100;
 164
 165 /* float register */
 166 static
 167 unsigned char floatdig[MAXPREC];
 168
 169 /*
 170  *  global io variables
 171  */
 172
 173 static Text_Mode*      textptr = NULL;
 174 static VarString*      textrecptr;
 175
 176 static int             actual_index;
 177 static int             maximum_index;
 178 static int             iolist_index;
 179
 180 static __tmp_IO_list*  iolistptr;
 181 static int             iolistlen;
 182 static char*           iostrptr;
 183 static int             iostrlen;
 184
 185
 186 static convcode_t     convcode;
 187 static editcode_t     editcode;
 188 static iocode_t       iocode;
 189 static unsigned long  repetition;
 190 static Boolean        leftadjust;
 191 static Boolean        overflowev;
 192 static Boolean        dynamicwid;
 193 static Boolean        paddingdef;
 194 static char           paddingchar;
 195 static Boolean        fractiondef;
 196 static unsigned long  fractionwidth;
 197 static Boolean        exponentdef;
 198 static unsigned long  exponentwidth;
 199 static unsigned long  clausewidth;
 200 static signed long    textindex;
 201
 202 static
 203 __tmp_IO_enum_table_type bool_tab[] =
 204    { { 0, "FALSE" },
 205      { 1, "TRUE"  },
 206      { 0 , NULL   }  };
 207
 208 /*
 209  * case insensitive compare: s1 is zero delimited, s2 has n chars
 210  */
 211 static
 212 int casncmp( const char* s1, const char* s2, int n )
 213 {
 214   int res = 0;
 215   while( n-- )
 216   {
 217     if( (res = toupper(*s1++) - toupper(*s2++)) )
 218       return res;
 219   }
 220   return *s1;
 221 }
 222
 223 /*
 224  * skip spaces with blank equal to tab
 225  */
 226 static
 227 int skip_space( int limit )
 228 {
 229   int skipped = 0;
 230   while( actual_index < limit &&
 231          (iostrptr[actual_index] == ' ' || iostrptr[actual_index] == '\t' ) )
 232   {
 233     actual_index++;
 234     skipped++;
 235   }
 236   return skipped;
 237 }
 238
 239 /*
 240  * skip leading pad characters
 241  */
 242 static
 243 int skip_pad( int limit )
 244 {
 245   int skipped = 0;
 246   while( actual_index < limit && iostrptr[actual_index] == paddingchar )
 247   {
 248     actual_index++;
 249     skipped++;
 250   }
 251 #if _TEXTIO_DEBUG_
 252   printf( "skipping '%c' until %d: %d\n", paddingchar, limit, skipped );
 253 #endif
 254   return skipped;
 255 }
 256
 257 /*
 258  * backup trailing pad characters
 259  */
 260 static
 261 int piks_pad( int start, int limit )
 262 {
 263   int skipped = 0;
 264   while( start >/***=*/ limit && iostrptr[--start] == paddingchar )
 265   {
 266     skipped++;
 267   }
 268 #if _TEXTIO_DEBUG_
 269   printf( "piksing '%c' from %d until %d: %d\n",
 270           paddingchar, start, limit, skipped );
 271 #endif
 272   return skipped;
 273 }
 274
 275 /*
 276  * parse an integer
 277  */
 278 static
 279 int parse_int( int limit, int SET, int base,
 280                unsigned long* valptr, int* signptr )
 281 {
 282   int           parsed = actual_index;
 283   Boolean       digits = False;
 284   unsigned long value  = 0;
 285   char          curr;
 286   int           dig;
 287
 288   if( actual_index >= limit )
 289     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_INT );
 290   *signptr = +1;
 291   if( iostrptr[actual_index] == '+' )
 292     actual_index++;
 293   else
 294     if( iostrptr[actual_index] == '-' )
 295     {  *signptr = -1;
 296        actual_index++;
 297     }
 298
 299   for( ; actual_index < limit; actual_index++ )
 300   {
 301     curr = iostrptr[actual_index];
 302     if( curr == '_' ) continue;
 303     if( isXXX(curr,SET) )
 304     {
 305       digits = True;
 306       dig = curr <= '9' ? curr - '0' : toupper(curr) - 'A' + 10;
 307       if( value > (ULONG_MAX - dig)/base )
 308         IOEXCEPTION( TEXTFAIL, INT_VAL_OVERFLOW );
 309       value = value*base + dig;
 310       continue;
 311     }
 312     break;
 313   }
 314   if( !digits )
 315     IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_INT );
 316
 317   *valptr = value;
 318 #if _TEXTIO_DEBUG_
 319   printf( "parsing for int until %d, base %d: %u\n", limit, base, value );
 320 #endif
 321   return actual_index - parsed;
 322 }
 323
 324 static
 325 double
 326 make_float( int dexp, int sign )
 327 {
 328   double value = atof( floatdig );
 329 #if _TEXTIO_DEBUG_
 330   printf( " value = %25.20e, dexp = %d\n", value, dexp );
 331 #endif
 332   while( dexp >= 100 )
 333     value *= ep_100, dexp -= 100;
 334   if( dexp >= 10 )
 335     value *= ep_10[dexp/10], dexp %= 10;
 336   if( dexp > 0 )
 337     value *= ep_1[dexp];
 338
 339   while( dexp <= -100 )
 340     value /= ep_100, dexp += 100;
 341   if( dexp <= -10 )
 342     value /= ep_10[-dexp/10], dexp %= 10;
 343   if( dexp < 0 )
 344     value /= ep_1[-dexp];
 345
 346   return  sign ? -value : value;
 347 }
 348
 349 /* %C -> fixed point   [+|-]<digit>+[.<digit>*]  */
 350 static
 351 int parse_fixedpoint( int limit, double* valptr )
 352 {
 353   int           parsed = actual_index;
 354   Boolean       digits = False;
 355   int           sdig = 0;
 356   double        value;
 357   char          curr;
 358   int           sign = False;
 359   int           expo = 0;
 360
 361   if( actual_index >= limit )
 362     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_FLOAT );
 363   if( iostrptr[actual_index] == '+' )
 364     actual_index++;
 365   else
 366     if( iostrptr[actual_index] == '-' )
 367     {
 368        sign = True;
 369        actual_index++;
 370     }
 371
 372   floatdig[0] = '.';
 373   for( ; actual_index < limit; actual_index++ )
 374   {
 375     curr = iostrptr[actual_index];
 376     if( ! isDEC(curr) )
 377       break;
 378     digits = True;
 379     if( sdig < MAXPREC - 1 )
 380     {
 381       if( sdig || curr != '0' )
 382       {
 383         floatdig[++sdig] = curr;
 384         expo++;
 385       }
 386     }
 387     else
 388       if( sdig )
 389         expo++;
 390   }
 391   if( digits && curr == '.' )
 392   {
 393     actual_index++;
 394     for( ; actual_index < limit; actual_index++ )
 395     {
 396       curr = iostrptr[actual_index];
 397       if( !isDEC(curr) )
 398         break;
 399       if( sdig < MAXPREC - 1 )
 400       {
 401         if( sdig || curr != '0' )
 402           floatdig[++sdig] = curr;
 403         else
 404           expo--;
 405       }
 406     }
 407   }
 408   floatdig[++sdig] = '\0';
 409
 410   if( !digits )
 411     IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_FLOAT );
 412
 413   *valptr = make_float( expo, sign);
 414   return actual_index - parsed;
 415 }
 416
 417
 418 typedef enum {
 419   s_sign, s_dig, s_period, s_fraca, s_fracb, s_expo, s_exposign,
 420   s_expoa, s_expob }
 421 scient_t;
 422
 423 /* %C -> scientific   [+|-]<digit>[.<digit>*]E[=|-]<digit>+  */
 424 static
 425 int parse_scientific( int limit, double* valptr, double dmin, double dmax )
 426 {
 427   int           parsed = actual_index;
 428   int           sdig = 0;
 429   char          curr;
 430   double        value;
 431   int           sign = False;
 432   int           expo = 0;
 433   int           expo_sign = +1;
 434
 435   scient_t      state = s_sign;
 436
 437   if( actual_index >= limit )
 438     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_FLOAT );
 439
 440   floatdig[0] = '.';
 441   for( ; actual_index < limit; actual_index++ )
 442   {
 443     curr = iostrptr[actual_index];
 444     switch( state )
 445     {
 446     case s_sign:
 447       if( iostrptr[actual_index] == '+' )
 448       {
 449         state = s_dig;
 450         break;
 451       }
 452       if( iostrptr[actual_index] == '-' )
 453       {
 454         sign = True;
 455         state = s_dig;
 456         break;
 457       }
 458       /* fall through - no break */
 459     case s_dig:
 460       if( isDEC(curr) && curr > '0' )
 461       {
 462         floatdig[++sdig] = curr;
 463         state = s_period;
 464         break;
 465       }
 466       IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_FLOAT );
 467     case s_period:
 468       if( curr == '.' )
 469       {
 470         state = s_fraca;
 471         break;
 472       }
 473       if( curr == 'E' )
 474       {
 475         state = s_exposign;
 476         break;
 477       }
 478       IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
 479     case s_fraca:
 480       if( isDEC(curr) )
 481       {
 482         floatdig[++sdig] = curr;
 483         state = s_fracb;
 484         break;
 485       }
 486       IOEXCEPTION( TEXTFAIL, NO_DIGITS_FOR_FLOAT );
 487     case s_fracb:
 488       if( isDEC(curr) )
 489       {
 490         if( sdig < MAXPREC - 1 )
 491           floatdig[++sdig] = curr;
 492         break;
 493       }
 494       if( curr == 'E' )
 495       {
 496         state = s_exposign;
 497         break;
 498       }
 499       IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
 500     case s_exposign:
 501       if( iostrptr[actual_index] == '+' )
 502       {
 503         state = s_expoa;
 504         break;
 505       }
 506       if( iostrptr[actual_index] == '-' )
 507       {
 508         expo_sign = -1;
 509         state = s_expoa;
 510         break;
 511       }
 512     case s_expoa:
 513       if( isDEC(curr) )
 514       {
 515         expo = curr - '0';
 516         state = s_expob;
 517         break;
 518       }
 519       IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
 520     case s_expob:
 521       expo = expo*10 + (curr - '0');
 522       if( expo > 1000 )
 523         IOEXCEPTION( TEXTFAIL, REAL_OVERFLOW );
 524     }
 525   }
 526   if( state != s_expob )
 527     IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
 528
 529   expo *= expo_sign;
 530   expo++;
 531
 532   floatdig[++sdig] = '\0';
 533
 534   *valptr = make_float( expo, sign );
 535   return actual_index - parsed;
 536 }
 537
 538
 539 static
 540 int parse_set( int limit, __tmp_IO_enum_table_type* tabptr,
 541                unsigned long* valptr )
 542 {
 543   int    parsed = actual_index;
 544   char   curr;
 545   __tmp_IO_enum_table_type* etptr;
 546
 547   if( actual_index >= limit )
 548     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_SET );
 549
 550   curr = iostrptr[actual_index];
 551   if( isXXX(curr,LET+USC) )
 552     actual_index++;
 553   else
 554     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_SET );
 555
 556   for( ; actual_index < limit; actual_index++ )
 557   {
 558     if( ! isXXX(iostrptr[actual_index],LET+DEC+USC) )
 559       break;
 560   }
 561
 562   if( tabptr )
 563      while( tabptr->name )
 564      {
 565        if( !casncmp( tabptr->name, &iostrptr[parsed], actual_index-parsed ) )
 566        {
 567          *valptr = tabptr->value;
 568 #if _TEXTIO_DEBUG_
 569          printf( "parsing set value until %d: %u\n", limit, tabptr->value );
 570 #endif
 571          return actual_index - parsed;
 572        }
 573        tabptr++;
 574      }
 575   IOEXCEPTION( TEXTFAIL, SET_CONVERSION_ERROR );
 576 }
 577
 578 static
 579 int parse_bit( int limit, char* bitptr )
 580 {
 581   int parsed = actual_index;
 582   int i = 0;
 583   char curr;
 584
 585   if( actual_index >= limit )
 586     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_BOOLS );
 587
 588   for( ; actual_index < limit; actual_index++ )
 589   {
 590     curr = iostrptr[actual_index] - '0';
 591     if( curr == 0 || curr == 1 )
 592       /* __setbitinset( i++, bitptr, limit, curr ); */
 593       __setbitpowerset (bitptr, limit, 0, i++, curr, __FILE__, __LINE__);
 594     else
 595       break;
 596   }
 597   return actual_index - parsed;
 598 }
 599
 600 static
 601 char* myultoa( unsigned long ul, char* buf, int base )
 602 {
 603   char*         res = buf;
 604   unsigned long h = ul/base;
 605   unsigned long q = 1;
 606
 607   while( h >= q ) q *= base;
 608   while( q > 0 )
 609   {
 610     *buf++ = "0123456789ABCDEF"[ul/q];
 611     ul %= q;
 612     q /= base;
 613   }
 614   *buf++ = '\0';
 615   return res;
 616 }
 617
 618 /*
 619  *  convert a bit string from src, bit offset up to len
 620  */
 621 static
 622 char* bitput( char* dst, char* src, int offset, int len )
 623 {
 624   char* res = dst;
 625   int i;
 626   for( i = offset; i < len; i++ )
 627   {
 628     *dst++ = __inpowerset( i, src, len, 0 ) ? '1' : '0';
 629   }
 630   return res;
 631 }
 632
 633 /*
 634  * dround: round decimal register *digptr starting at digit mdigs,
 635  *         on carry advance begin of digit sequence and bump exponent
 636  */
 637 static
 638 char*
 639 dround( char* digptr, int mdigs, int* deptr )
 640 {
 641   int carry;
 642 #if _TEXTIO_DEBUG_
 643   printf( "Rounding from %d\n", mdigs );
 644 #endif
 645   if( digptr[mdigs] >= 5 )
 646   {
 647     carry = 1;
 648     while( carry )
 649     {
 650       digptr[--mdigs]++;
 651       if( digptr[mdigs] >= 10 )
 652         digptr[mdigs] = 0;
 653       else
 654         carry = 0;
 655     }
 656   }
 657   if( mdigs < 0 )
 658   {
 659     digptr[--mdigs] = 1;
 660     (*deptr)++;
 661     return digptr - 1;
 662   }
 663   else
 664     return digptr;
 665 }
 666
 667 /*
 668  * mydtoa: convert val with a precision of mantdigs to a decimal fraction
 669  *         first digit is at **fstdiptr, decimal exponent is at *deptr
 670  */
 671 static
 672 char*
 673 mydtoa( double val, int mantdigs, int* deptr, int* sgnptr )
 674 {
 675   double m;
 676   int be;
 677   int de = -1;
 678   int fstdig = 0;
 679   int idig;
 680   char* digptr = floatdig+2;
 681
 682   floatdig[0] = floatdig[1] = 0;
 683
 684   if( val < 0 )
 685     *sgnptr = -1, val = fabs( val );
 686   else
 687     *sgnptr = +1;
 688
 689   /* split the value */
 690   m = frexp( val, &be ) * 10.0;
 691
 692   /* 5.0 <= m < 10.0 */
 693   while( be > 0 )
 694   {
 695     de++; be--; m /= 5.0;
 696     if( m < 1.0 )
 697       m *= 10.0, de--;
 698   }
 699   while( be < 0 )
 700   {
 701     de--; be++; m *= 5.0;
 702     if( m >= 10.0 )
 703       m /= 10.0, de++;
 704   }
 705
 706   for( idig = 0; idig < mantdigs; idig++ )
 707   {
 708     digptr[idig] = (int)m;
 709     m = (m - digptr[idig])*10.0;
 710   }
 711   digptr[idig] = (int)m;
 712
 713   *deptr = de;
 714   return dround( digptr, mantdigs, deptr );
 715 }
 716
 717 #define PUT(c) \
 718   { if( ifst <= ++iprt && iprt <= ilst ) *dst++ = c; }
 719
 720 static
 721 char*
 722 fixput( char* dst, char* src,
 723         int ifst, int ilst,
 724         int sign, int fst, int lst,
 725         int nid, int nfd )
 726 {
 727   char* dstsav = dst;
 728   int idig;
 729   int iprt = 0;
 730
 731   if( sign < 0 )
 732     PUT( '-' );
 733   for( idig = nid; idig >= -nfd; idig-- )
 734   {
 735     if (idig == -1)
 736       PUT( '.' );
 737     PUT( idig > fst || lst >= idig ? '0': '0' + *src++ );
 738   }
 739   return dstsav;
 740 }
 741
 742 static
 743 char*
 744 sciput( char* dst, char* src, char* expbeg,
 745         int ifst, int ilst,
 746         int sign, int de, int expwid )
 747 {
 748   char* dstsav = dst;
 749   int iprt = 0;
 750   int nfd = fractionwidth;
 751   int explen = strlen( expbeg );
 752
 753   if( sign < 0 )
 754     PUT( '-' );
 755   PUT( '0' + *src++ );
 756   PUT( '.' );
 757
 758   while( nfd-- )
 759     PUT( '0' + *src++ );
 760   PUT( 'E' );
 761   PUT( de >= 0 ? '+' : '-' );
 762   while( expwid > explen )
 763   {
 764     PUT( '0' );
 765     expwid--;
 766   }
 767   while( explen-- )
 768     PUT( *expbeg++ );
 769   return dstsav;
 770 }
 771
 772 /*
 773  *  handle dynamic field width
 774  */
 775 static
 776 get_field_width( void )
 777 {
 778   unsigned long  width;
 779   unsigned long  ulongval;
 780            long  longval;
 781   __tmp_IO_list  io;
 782
 783
 784   if( ++iolist_index > iolistlen )
 785     IOEXCEPTION( TEXTFAIL, IOLIST_EXHAUSTED );
 786
 787   io = *iolistptr++;
 788
 789   /* must be integer, >= 0 */
 790   switch( io.__descr )
 791   {
 792   case __IO_ByteVal:
 793     longval = io.__t.__valbyte;
 794     goto signed_fieldwidth;
 795   case __IO_UByteVal:
 796     width = io.__t.__valubyte;
 797     goto unsigned_fieldwidth;
 798   case __IO_IntVal:
 799     longval = io.__t.__valint;
 800     goto signed_fieldwidth;
 801   case __IO_UIntVal:
 802     width = io.__t.__valuint;
 803     goto unsigned_fieldwidth;
 804   case __IO_LongVal:
 805     longval = io.__t.__vallong;
 806     goto signed_fieldwidth;
 807   case __IO_ULongVal:
 808     width = io.__t.__valulong;
 809     goto unsigned_fieldwidth;
 810   case __IO_ByteLoc:
 811     longval = *(signed char*)io.__t.__locint;
 812     goto signed_fieldwidth;
 813   case __IO_UByteLoc:
 814     width = *(unsigned char*)io.__t.__locint;
 815     goto unsigned_fieldwidth;
 816   case __IO_IntLoc:
 817     longval = *(signed short*)io.__t.__locint;
 818     goto signed_fieldwidth;
 819   case __IO_UIntLoc:
 820     width = *(unsigned short*)io.__t.__locint;
 821     goto unsigned_fieldwidth;
 822   case __IO_LongLoc:
 823     longval = *(signed long*) io.__t.__locint;
 824     goto signed_fieldwidth;
 825   case __IO_ULongLoc:
 826     width = *(unsigned long*)io.__t.__locint;
 827     goto unsigned_fieldwidth;
 828   default:
 829     IOEXCEPTION( TEXTFAIL, NON_INT_FIELD_WIDTH );
 830   }
 831
 832 signed_fieldwidth: ;
 833   if( longval < 0 )
 834     IOEXCEPTION( TEXTFAIL, NEGATIVE_FIELD_WIDTH );
 835   width = longval;
 836
 837 unsigned_fieldwidth: ;
 838   return width;
 839 }
 840
 841
 842 static
 843 void inpconv( void )
 844 {
 845   __tmp_IO_list  io;
 846   int            width;
 847   int            limit;
 848   int            skiplim;
 849   int            skipped;
 850   int            bypass;
 851   int            parsed;
 852   Boolean        fixedchars;
 853   int            fixedlen;
 854   unsigned char  curr;
 855   double         dval;
 856   float          fval;
 857
 858   __tmp_IO_long  lval;
 859   int            sign;
 860   unsigned long  umin;
 861   unsigned long  umax;
 862     signed long  smin;
 863     signed long  smax;
 864   int            ilen;
 865   short unsigned slen;
 866   __tmp_IO_enum_table_type* settabptr;
 867
 868   while( repetition-- )
 869   {
 870     if( ++iolist_index > iolistlen )
 871       IOEXCEPTION( TEXTFAIL, IOLIST_EXHAUSTED );
 872
 873     io = *iolistptr++;
 874
 875     if( dynamicwid )
 876       width = get_field_width();
 877     else
 878       width = clausewidth;
 879
 880     bypass = skipped = 0;
 881     if( width )
 882     {
 883       if( actual_index + width > iostrlen )
 884         IOEXCEPTION( TEXTFAIL, NOT_ENOUGH_CHARS );
 885
 886       switch(io.__descr)
 887       {
 888       case __IO_CharLoc:
 889       case __IO_CharRangeLoc:
 890         fixedchars = True;
 891         fixedlen = 1;
 892         break;
 893       case __IO_CharStrLoc:
 894         fixedchars = True;
 895         fixedlen = io.__t.__loccharstring.string_length;
 896         break;
 897       default:
 898         fixedchars = False;
 899         break;
 900       }
 901
 902       if( leftadjust )
 903       {
 904         skiplim = fixedchars ? actual_index + fixedlen
 905                              : actual_index;
 906         bypass = skipped = piks_pad( actual_index + width, skiplim );
 907       }
 908       else
 909       {
 910         skiplim = fixedchars ? actual_index + width - fixedlen
 911                              : actual_index + width;
 912         skipped = skip_pad( skiplim );
 913       }
 914       width -= skipped;
 915       limit = actual_index + width;
 916     }
 917     else
 918     { /* free format */
 919       if( paddingdef || !( io.__descr == __IO_CharLoc ||
 920                            io.__descr == __IO_CharRangeLoc ||
 921                            io.__descr == __IO_CharStrLoc ||
 922                            io.__descr == __IO_CharVaryingLoc ) )
 923         if( paddingchar == ' ' || paddingchar == '\t' )
 924           skip_space( iostrlen );
 925         else
 926           skip_pad( iostrlen );
 927       limit = iostrlen;
 928     }
 929
 930     switch( io.__descr )
 931     {
 932     case __IO_ByteLoc:
 933       ilen = 1;
 934       smin = CH_BYTE_MIN;
 935       smax = CH_BYTE_MAX;
 936       goto parse_signed_int;
 937     case __IO_UByteLoc:
 938       ilen = 1;
 939       umin = 0;
 940       umax = CH_UBYTE_MAX;
 941       goto parse_unsigned_int;
 942     case __IO_IntLoc:
 943       ilen = 2;
 944       smin = CH_INT_MIN;
 945       smax = CH_INT_MAX;
 946       goto parse_signed_int;
 947     case __IO_UIntLoc:
 948       ilen = 2;
 949       umin = 0;
 950       umax = CH_UINT_MAX;
 951       goto parse_unsigned_int;
 952     case __IO_LongLoc:
 953       ilen = 4;
 954       smin = CH_LONG_MIN;
 955       smax = CH_LONG_MAX;
 956       goto parse_signed_int;
 957     case __IO_ULongLoc:
 958       ilen = 4;
 959       umin = 0;
 960       umax = CH_ULONG_MAX;
 961       goto parse_unsigned_int;
 962
 963     case __IO_ByteRangeLoc:
 964       ilen = 1;
 965       smin = io.__t.__locintrange.lower.slong;
 966       smax = io.__t.__locintrange.upper.slong;
 967       goto parse_signed_int;
 968     case __IO_UByteRangeLoc:
 969       ilen = 1;
 970       umin = io.__t.__locintrange.lower.ulong;
 971       umax = io.__t.__locintrange.upper.ulong;
 972       goto parse_unsigned_int;
 973     case __IO_IntRangeLoc:
 974       ilen = 2;
 975       smin = io.__t.__locintrange.lower.slong;
 976       smax = io.__t.__locintrange.upper.slong;
 977       goto parse_signed_int;
 978     case __IO_UIntRangeLoc:
 979       ilen = 2;
 980       umin = io.__t.__locintrange.lower.ulong;
 981       umax = io.__t.__locintrange.upper.ulong;
 982       goto parse_unsigned_int;
 983     case __IO_LongRangeLoc:
 984       ilen = 4;
 985       smin = io.__t.__locintrange.lower.slong;
 986       smax = io.__t.__locintrange.upper.slong;
 987       goto parse_signed_int;
 988     case __IO_ULongRangeLoc:
 989       ilen = 4;
 990       umin = io.__t.__locintrange.lower.ulong;
 991       umax = io.__t.__locintrange.upper.ulong;
 992       goto parse_unsigned_int;
 993
 994     case __IO_BoolLoc:
 995       ilen = 1;
 996       umin = 0;
 997       umax = 1;
 998       settabptr = bool_tab;
 999       goto parse_set;
1000     case __IO_BoolRangeLoc:
1001       ilen = 1;
1002       umin = io.__t.__locboolrange.lower;
1003       umax = io.__t.__locboolrange.upper;
1004       settabptr = bool_tab;
1005       goto parse_set;
1006
1007     case __IO_SetLoc:
1008       ilen = io.__t.__locsetrange.length;
1009       settabptr = io.__t.__locsetrange.name_table;
1010       umin = 0;
1011       umax = CH_ULONG_MAX;
1012       goto parse_set;
1013     case __IO_SetRangeLoc:
1014       ilen = io.__t.__locsetrange.length;
1015       settabptr = io.__t.__locsetrange.name_table;
1016       umin = io.__t.__locsetrange.lower;
1017       umax = io.__t.__locsetrange.upper;
1018       goto parse_set;
1019
1020     case __IO_CharLoc:
1021       umin = 0;
1022       umax = 0xff;
1023       goto parse_char;
1024     case __IO_CharRangeLoc:
1025       umin = io.__t.__loccharrange.lower;
1026       umax = io.__t.__loccharrange.upper;
1027       goto parse_char;
1028
1029     case __IO_CharVaryingLoc:
1030       if( convcode != DefaultConv )
1031         IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1032       slen = io.__t.__loccharstring.string_length;
1033       if( (parsed = limit - actual_index) < slen )
1034         slen = parsed;
1035       else
1036         parsed = slen;
1037       memcpy( io.__t.__loccharstring.string + 2,
1038               &iostrptr[actual_index], parsed );
1039       MOV2(io.__t.__loccharstring.string,&slen);
1040       actual_index += parsed;
1041       goto check_field_complete;
1042
1043
1044     case __IO_CharStrLoc:
1045       if( convcode != DefaultConv )
1046         IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1047       if( actual_index + io.__t.__loccharstring.string_length > limit )
1048         IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_CHARS );
1049       memcpy( io.__t.__loccharstring.string,
1050               &iostrptr[actual_index],
1051               parsed = io.__t.__loccharstring.string_length );
1052       actual_index += parsed;
1053       goto check_field_complete;
1054
1055     case __IO_BitStrLoc:
1056       if( convcode != DefaultConv )
1057         IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1058       parsed = parse_bit( limit, io.__t.__loccharstring.string );
1059       if( parsed < io.__t.__loccharstring.string_length )
1060         IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_BOOLS );
1061       goto check_field_complete;
1062
1063     case __IO_LongRealLoc:
1064     case __IO_RealLoc:
1065       switch( convcode )
1066       {
1067       case ScientConv:
1068         parse_scientific( limit, &dval, DBL_MIN, DBL_MAX );
1069         break;
1070       case DefaultConv:
1071         parse_fixedpoint( limit, &dval );
1072         break;
1073       default:
1074         IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1075       }
1076       if( io.__descr == __IO_LongRealLoc )
1077         memcpy( io.__t.__loclongreal, &dval, sizeof(double) );
1078       else
1079       {
1080         fval = (float)dval;
1081         MOV4(io.__t.__locreal,&fval);
1082       }
1083       goto check_field_complete;
1084     default:
1085       IOEXCEPTION( TEXTFAIL, INVALID_IO_LIST );
1086     }
1087
1088
1089 parse_signed_int: ;
1090     if( convcode == ScientConv )
1091       IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1092     parsed = parse_int( limit, dset[convcode], base[convcode],
1093                         &lval.ulong, &sign );
1094     if( sign < 0 )
1095     {
1096       if( lval.ulong > (unsigned long)CH_LONG_MIN )
1097         IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
1098       lval.slong = -lval.ulong;
1099     }
1100     else
1101     {
1102       /* not needed: lval.slong = lval.ulong; */
1103       /* Hack: sign extension for bin/oct/dec if no sign present */
1104       if( convcode != DefaultConv && lval.ulong & (1 << (ilen*8-1)) )
1105       {
1106         if( ilen < 4 )
1107           lval.ulong |= 0xFFFFFFFF << ilen*8;
1108       }
1109       else
1110         if( lval.ulong > (unsigned long)CH_LONG_MAX )
1111           IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
1112     }
1113     if( lval.slong < smin || smax < lval.slong )
1114       IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
1115     goto store_int;
1116
1117 parse_unsigned_int: ;
1118     if( convcode == ScientConv )
1119       IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1120     parsed = parse_int( limit, dset[convcode], base[convcode],
1121                         &lval.ulong, &sign );
1122     if( sign < 0 ||  lval.ulong < umin || umax < lval.ulong )
1123       IOEXCEPTION( TEXTFAIL, INTEGER_RANGE_ERROR );
1124     goto store_int;
1125
1126 parse_set: ;
1127     if( convcode != DefaultConv )
1128       IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1129     parsed = parse_set( limit, settabptr, &lval.ulong );
1130     if( lval.ulong < umin || umax < lval.ulong )
1131       IOEXCEPTION( TEXTFAIL, SET_RANGE_ERROR );
1132     goto store_int;
1133
1134 store_int: ;
1135     switch( ilen )
1136     {
1137     case 1:
1138       *(unsigned char*)io.__t.__locint = lval.ulong;
1139       break;
1140     case 2:
1141       slen = lval.ulong;
1142       MOV2(io.__t.__locint,&slen);
1143       break;
1144     case 4:
1145       MOV4(io.__t.__locint,&lval.ulong);
1146       break;
1147     default:
1148       IOEXCEPTION( TEXTFAIL, INTERNAL_ERROR );
1149     }
1150     goto check_field_complete;
1151
1152 parse_char: ;
1153     if( convcode != DefaultConv )
1154       IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1155     if( actual_index >= limit )
1156       IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_CHARS );
1157     curr = iostrptr[actual_index++];
1158     parsed = 1;
1159     if( curr < umin || umax < curr )
1160       IOEXCEPTION( TEXTFAIL, CHAR_RANGE_ERROR );
1161     *io.__t.__locchar = curr;
1162     goto check_field_complete;
1163
1164 check_field_complete: ;
1165     actual_index += bypass;
1166     if( width > parsed )
1167       IOEXCEPTION( TEXTFAIL, INVALID_CHAR );
1168   }
1169 }
1170
1171 static
1172 void inpedit( void )
1173 {
1174   int           nchars;
1175
1176   if( dynamicwid )
1177     clausewidth = get_field_width();
1178
1179   switch( editcode )
1180   {
1181   case SpaceSkip:
1182     nchars = repetition*clausewidth;
1183     if( actual_index + nchars > iostrlen )
1184       IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_EDIT );
1185     for( ; nchars ; nchars-- )
1186       if( iostrptr[actual_index++] != ' ' )
1187         IOEXCEPTION( TEXTFAIL, NO_SPACE_TO_SKIP );
1188     break;
1189
1190   case SkipLeft:
1191     nchars = repetition*clausewidth;
1192     if( (actual_index -= nchars) < 0 )
1193       IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_EDIT );
1194     break;
1195
1196   case SkipRight:
1197     nchars = repetition*clausewidth;
1198     if( (actual_index += nchars) > iostrlen )
1199       IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_EDIT );
1200     break;
1201
1202   case Tabulation:
1203     if( (actual_index = clausewidth) > iostrlen )
1204       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1205     break;
1206   }
1207 }
1208
1209 static
1210 void outconv( void )
1211 {
1212   unsigned long             width;
1213   char                      itembuf[33];
1214   unsigned long             ulongval;
1215            long             longval;
1216   __tmp_IO_list             io;
1217   __tmp_IO_enum_table_type* etptr;
1218   char*                     itembeg;
1219   unsigned long             itemlen;
1220   double                    doubleval;
1221   int                       de;
1222   int                       sign;
1223   int                       mantdigs;
1224   int                       nid;
1225   int                       nfd;
1226   char*                     expbeg;
1227   int                       explen;
1228   unsigned int              expwid;
1229
1230   while( repetition-- )
1231   {
1232     if( ++iolist_index > iolistlen )
1233       IOEXCEPTION( TEXTFAIL, IOLIST_EXHAUSTED );
1234
1235     io = *iolistptr++;
1236     width =  dynamicwid ? get_field_width() : clausewidth;
1237
1238     switch( convcode )
1239     {
1240     case DefaultConv:
1241       switch( io.__descr )
1242       {
1243       case __IO_ByteVal:
1244         longval = io.__t.__valbyte;
1245         goto signed_conversion;
1246       case __IO_UByteVal:
1247         ulongval = io.__t.__valubyte;
1248         goto unsigned_conversion;
1249       case __IO_IntVal:
1250         longval = io.__t.__valint;
1251         goto signed_conversion;
1252       case __IO_UIntVal:
1253         ulongval = io.__t.__valuint;
1254         goto unsigned_conversion;
1255       case __IO_LongVal:
1256         longval = io.__t.__vallong;
1257         goto signed_conversion;
1258       case __IO_ULongVal:
1259         ulongval = io.__t.__valulong;
1260         goto unsigned_conversion;
1261
1262       case __IO_BoolVal:
1263         switch( io.__t.__valbool )
1264         {
1265         case 0:
1266           itembeg = "FALSE";
1267           itemlen = 5;
1268           goto move_item;
1269         case 1:
1270           itembeg = "TRUE";
1271           itemlen = 4;
1272           goto move_item;
1273         default:
1274           IOEXCEPTION( TEXTFAIL, BOOL_CONVERSION_ERROR );
1275         }
1276
1277       case __IO_CharVal:
1278         itembeg = &io.__t.__valchar;
1279         itemlen = 1;
1280         goto move_item;
1281
1282       case __IO_SetVal:
1283         /* locate name string using set mode name table */
1284         itembeg = 0;
1285
1286         if( (etptr = io.__t.__valset.name_table) )
1287           while( etptr->name )
1288           {
1289             if( etptr->value == io.__t.__valset.value )
1290             {
1291               itembeg = etptr->name;
1292               itemlen = strlen( itembeg );
1293               goto move_item;
1294             }
1295             etptr++;
1296           }
1297        IOEXCEPTION( TEXTFAIL, SET_CONVERSION_ERROR );
1298
1299       case __IO_CharVaryingLoc:
1300         {
1301           unsigned short l;
1302           itembeg = (char*)io.__t.__loccharstring.string;
1303           MOV2(&l,itembeg);
1304           itembeg += 2;
1305           itemlen = l;
1306           goto move_item;
1307         }
1308
1309       case __IO_CharStrLoc:
1310         itembeg = io.__t.__loccharstring.string;
1311         itemlen = io.__t.__loccharstring.string_length;
1312         goto move_item;
1313
1314       case __IO_BitStrLoc:
1315         itemlen = io.__t.__loccharstring.string_length;
1316         itembeg = io.__t.__loccharstring.string;
1317
1318         if( !width )
1319           width = itemlen;
1320
1321         /* check remaining space */
1322         if( actual_index + width > iostrlen )
1323           IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1324
1325         if( itemlen == width )
1326           bitput( iostrptr + actual_index, itembeg, 0, itemlen );
1327         else
1328           if( itemlen < width )
1329             if( leftadjust )
1330               memset( bitput( iostrptr + actual_index, itembeg, 0, itemlen )
1331                       + itemlen,
1332                       paddingchar, width - itemlen );
1333             else
1334               bitput( memset( iostrptr + actual_index,
1335                               paddingchar, width - itemlen )
1336                       + width - itemlen,
1337                       itembeg, itemlen - width, itemlen );
1338           else
1339             if( overflowev )
1340               memset( iostrptr + actual_index, '*', width );
1341             else
1342               if( leftadjust )
1343                 bitput( iostrptr + actual_index, itembeg, 0, width );
1344               else
1345                 bitput( iostrptr + actual_index, itembeg,
1346                         itemlen - width, itemlen );
1347         goto adjust_index;
1348
1349       case __IO_RealVal:
1350         doubleval = io.__t.__valreal;
1351         mantdigs = FMANTDIGS;
1352         goto fixed_point_conversion;
1353       case __IO_LongRealVal:
1354         doubleval = io.__t.__vallongreal;
1355         mantdigs = DBL_DIG;
1356         goto fixed_point_conversion;
1357         break;
1358
1359       default:
1360         IOEXCEPTION( TEXTFAIL, INVALID_IO_LIST );
1361       }
1362
1363     case HexConv:
1364     case OctalConv:
1365     case BinaryConv:
1366       switch( io.__descr )
1367       {
1368       case __IO_ByteVal:
1369       case __IO_UByteVal:
1370         ulongval = io.__t.__valubyte;
1371         break;
1372       case __IO_IntVal:
1373       case __IO_UIntVal:
1374         ulongval = io.__t.__valuint;
1375         break;
1376       case __IO_LongVal:
1377       case __IO_ULongVal:
1378         ulongval = io.__t.__valulong;
1379         break;
1380       default:
1381         IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1382       }
1383       itembeg = myultoa( ulongval, itembuf, base[convcode] );
1384       itemlen = strlen( itembeg );
1385       goto move_item;
1386
1387     case ScientConv:
1388       switch( io.__descr )
1389       {
1390       case __IO_RealVal:
1391         doubleval = io.__t.__valreal;
1392         mantdigs = FMANTDIGS;
1393         if( !fractiondef )
1394           fractionwidth = FMANTDIGS - 1;
1395         goto scientific_conversion;
1396       case __IO_LongRealVal:
1397         doubleval = io.__t.__vallongreal;
1398         mantdigs = DBL_DIG;
1399         if( !fractiondef )
1400           fractionwidth = DBL_DIG - 1;
1401         goto scientific_conversion;
1402         break;
1403       default:
1404         IOEXCEPTION( TEXTFAIL, CONVCODE_MODE_MISFIT );
1405       }
1406     }
1407
1408 fixed_point_conversion: ;
1409     itembeg = mydtoa( doubleval, mantdigs, &de, &sign );
1410     if( fractiondef && de >= -fractionwidth - 1
1411         && -fractionwidth > de - mantdigs )
1412       itembeg = dround( itembeg, de + fractionwidth + 1, &de );
1413
1414     nid = de >= 0 ? de : 0;
1415     nfd = fractiondef ? fractionwidth
1416                       : ( de + 1 - mantdigs > 0 ? 0 : mantdigs - de - 1 );
1417     itemlen = ( sign < 0 ? 1 : 0 ) + 2 + nid + nfd;
1418 #if _TEXTIO_DEBUG_
1419 printf( "fixed item length %d\n", itemlen );
1420 #endif
1421     if( !width )
1422       width = itemlen;
1423 #if _TEXTIO_DEBUG_
1424 printf( "fixed item width %d\n", width );
1425 #endif
1426     /* check remaining space */
1427     if( actual_index + width > iostrlen )
1428       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1429
1430     if( itemlen == width )
1431       fixput( iostrptr + actual_index, itembeg,
1432               1, itemlen, sign, de, de - mantdigs, nid, nfd );
1433     else
1434       if( itemlen < width )
1435         if( leftadjust )
1436           memset( fixput( iostrptr + actual_index, itembeg,
1437                           1, itemlen, sign, de, de - mantdigs, nid, nfd )
1438                   + itemlen,
1439                   paddingchar, width - itemlen );
1440         else
1441           fixput( memset( iostrptr + actual_index,
1442                           paddingchar, width - itemlen )
1443                   + width - itemlen,
1444                   itembeg, 1, itemlen, sign, de, de - mantdigs, nid, nfd );
1445       else
1446         if( overflowev )
1447           memset( iostrptr + actual_index, '*', width );
1448         else
1449           if( leftadjust )
1450             fixput( iostrptr + actual_index, itembeg,
1451                     1, width, sign, de, de - mantdigs, nid, nfd );
1452           else
1453             fixput( iostrptr + actual_index, itembeg,
1454                     itemlen - width + 1, itemlen,
1455                     sign, de, de - mantdigs, nid, nfd );
1456     goto adjust_index;
1457
1458 scientific_conversion: ;
1459     itembeg = mydtoa( doubleval, mantdigs, &de, &sign );
1460
1461     if( fractiondef && fractionwidth < mantdigs )
1462       itembeg = dround( itembeg, fractionwidth + 1, &de );
1463
1464     expbeg = myultoa( abs(de), itembuf, 10 );
1465     explen = strlen( expbeg );
1466
1467     expwid = explen > exponentwidth ? explen : exponentwidth;
1468     itemlen = ( sign < 0 ? 1 : 0 ) + 2 + fractionwidth + 2 + expwid;
1469 #if _TEXTIO_DEBUG_
1470 printf( "floating item length %d, fraction %d, exponent %d\n",
1471         itemlen, fractionwidth, expwid );
1472 #endif
1473     if( width == 0 )
1474       width = itemlen;
1475 #if _TEXTIO_DEBUG_
1476 printf( "floating item width %d\n", width );
1477 #endif
1478     /* check remaining space */
1479     if( actual_index + width > iostrlen )
1480       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1481
1482     if( itemlen == width )
1483       sciput( iostrptr + actual_index, itembeg, expbeg,
1484               1, itemlen, sign, de, expwid );
1485     else
1486       if( itemlen < width )
1487         if( leftadjust )
1488           memset( sciput( iostrptr + actual_index, itembeg, expbeg,
1489                           1, itemlen, sign, de, expwid )
1490                   + itemlen,
1491                   paddingchar, width - itemlen );
1492         else
1493           sciput( memset( iostrptr + actual_index,
1494                           paddingchar, width - itemlen )
1495                   + width - itemlen,
1496                   itembeg, expbeg, 1, itemlen, sign, de, expwid );
1497       else
1498         if( overflowev )
1499           memset( iostrptr + actual_index, '*', width );
1500         else
1501           if( leftadjust )
1502             sciput( iostrptr + actual_index, itembeg, expbeg,
1503                     1, width, sign, de, expwid );
1504           else
1505             sciput( iostrptr + actual_index, itembeg, expbeg,
1506                     itemlen - width + 1, itemlen,
1507                     sign, de, expwid );
1508     goto adjust_index;
1509
1510 signed_conversion: ;
1511     if( longval >= 0 )
1512       itembeg = myultoa( longval, itembuf, 10 );
1513     else
1514     {
1515       itembuf[0] = '-';
1516       myultoa( -longval, itembuf+1, 10 );
1517       itembeg = itembuf;
1518     }
1519     itemlen = strlen( itembeg );
1520     goto move_item;
1521
1522 unsigned_conversion: ;
1523     itembeg = myultoa( ulongval, itembuf, 10 );
1524     itemlen = strlen( itembeg );
1525     goto move_item;
1526
1527 move_item: ;
1528     if( !width )
1529       width = itemlen;
1530
1531     /* check remaining space */
1532     if( actual_index + width > iostrlen )
1533       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1534
1535     /* move item, filling or truncating or overflow-evidencing */
1536     if( itemlen == width )
1537       memcpy( iostrptr + actual_index, itembeg, itemlen );
1538     else
1539       if( itemlen < width )
1540         if( leftadjust )
1541           memset( memcpy( iostrptr + actual_index, itembeg, itemlen )
1542                   + itemlen,
1543                   paddingchar, width - itemlen );
1544         else
1545           memcpy( memset( iostrptr + actual_index,
1546                           paddingchar, width - itemlen )
1547                   + width - itemlen,
1548                   itembeg, itemlen );
1549       else
1550         if( overflowev )
1551           memset( iostrptr + actual_index, '*', width );
1552         else
1553           if( leftadjust )
1554             memcpy( iostrptr + actual_index, itembeg, width );
1555           else
1556             memcpy( iostrptr + actual_index,
1557                     itembeg + itemlen - width, width );
1558
1559   /*
1560    *  adjust.
1561    */
1562 adjust_index: ;
1563   actual_index += width;
1564   if( actual_index > maximum_index )
1565     maximum_index = actual_index;
1566   }
1567 }
1568
1569 static
1570 void outedit( void )
1571 {
1572   int nchars;
1573
1574   if( dynamicwid )
1575     clausewidth = get_field_width();
1576   switch( editcode )
1577   {
1578   case SpaceSkip:
1579     nchars = repetition*clausewidth;
1580     if( actual_index + nchars > iostrlen )
1581       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1582     memset( iostrptr + actual_index, ' ', nchars );
1583     actual_index += nchars;
1584     if( actual_index > maximum_index )
1585       maximum_index = actual_index;
1586     break;
1587
1588   case SkipLeft:
1589     nchars = repetition*clausewidth;
1590     if(  actual_index - nchars < 0 )
1591       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1592     actual_index -= nchars;
1593     break;
1594
1595   case SkipRight:
1596     nchars = repetition*clausewidth;
1597     if( actual_index + nchars > iostrlen )
1598       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1599     actual_index += nchars;
1600     if( actual_index > maximum_index )
1601     {
1602       memset( iostrptr + maximum_index, ' ', actual_index - maximum_index );
1603       maximum_index = actual_index;
1604     }
1605     break;
1606
1607   case Tabulation:
1608     if( clausewidth >= iostrlen )
1609       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1610     actual_index = clausewidth;
1611     if( actual_index > maximum_index )
1612     {
1613       memset( iostrptr + maximum_index, ' ', actual_index - maximum_index );
1614       maximum_index = actual_index;
1615     }
1616     break;
1617   }
1618 }
1619
1620
1621 static
1622 void inpioctrl( void )
1623 {
1624   unsigned short hlen;
1625   if( !textptr )
1626     IOEXCEPTION( TEXTFAIL, IO_CONTROL_NOT_VALID );
1627   if( iocode != EndPage )
1628   {
1629     jmp_buf ioerror;
1630     unsigned long info;
1631
1632     if (textptr->access_sub->association)
1633       {
1634         if( (info = setjmp( ioerror )) )
1635           IOEXCEPTION( info>>16, info & 0xffff );
1636         while( repetition-- )
1637           {
1638             __readrecord( textptr->access_sub, textindex,
1639                          (char*)textptr->text_record,
1640                          __FILE__, __LINE__ );
1641             actual_index = 0;
1642             MOV2(&hlen,&textptr->text_record->len);
1643             iostrlen = hlen;
1644           }
1645       }
1646     else
1647       IOEXCEPTION (NOTCONNECTED, IS_NOT_CONNECTED);
1648   }
1649 }
1650
1651 /* specify pre/post in the order "/+-?!" */
1652 static
1653 char* pre_char =  "\0\f\0\r\0"; /* Z.200: "\n\f\0\n\0" */
1654 static
1655 char* post_char = "\n\n\r\0\0"; /* Z.200: "\r\r\r\0\0" */
1656
1657 static
1658 void outioctrl( void )
1659 {
1660   Association_Mode* assoc;
1661   unsigned short hlen;
1662   if( !textptr )
1663     IOEXCEPTION( TEXTFAIL, IO_CONTROL_NOT_VALID );
1664   if( (assoc = textptr->access_sub->association) )
1665   {
1666     jmp_buf ioerror;
1667     unsigned long info;
1668     if( (info = setjmp( ioerror )) )
1669       IOEXCEPTION( info>>16, info & 0xffff );
1670
1671     while( repetition-- )
1672     {
1673       if( iocode != EndPage )
1674       {
1675         if( TEST_FLAG( assoc, IO_FIRSTLINE ) )
1676         {
1677           CLR_FLAG( assoc, IO_FIRSTLINE );
1678           assoc->ctl_pre = '\0';
1679         }
1680         else
1681         {
1682           if( TEST_FLAG( assoc, IO_FORCE_PAGE ) )
1683           {
1684             CLR_FLAG( assoc, IO_FORCE_PAGE );
1685             assoc->ctl_pre = '\f';
1686           }
1687           else
1688             assoc->ctl_pre = pre_char[iocode];
1689         }
1690         assoc->ctl_post = post_char[iocode];
1691         hlen = actual_index;
1692         MOV2(&textptr->text_record->len,&hlen);
1693         __writerecord( textptr->access_sub, textindex,
1694                        (char*)textptr->text_record,
1695                        textptr->text_record->len,
1696                        __FILE__, __LINE__ );
1697         hlen = actual_index = 0;
1698         MOV2(&textptr->text_record->len,&hlen);
1699       }
1700       else if( !TEST_FLAG( textptr, IO_FIRSTLINE ) )
1701         SET_FLAG( textptr, IO_FORCE_PAGE );
1702       assoc->ctl_pre = assoc->ctl_post = '\0';
1703     }
1704   }
1705   else
1706     IOEXCEPTION (NOTCONNECTED, IS_NOT_CONNECTED);
1707 }
1708
1709 static
1710 void (**actionptr)( void );
1711 static
1712 void (*readactions[])( void ) = { inpconv, inpedit, inpioctrl };
1713 static
1714 void (*writeactions[])( void ) = { outconv, outedit, outioctrl };
1715
1716
1717 static
1718 void emitstr( char* begtxt, char* endtxt )
1719 {
1720   char c;
1721   int  nchars = endtxt - begtxt;
1722   if( actual_index + nchars > iostrlen )
1723       IOEXCEPTION( TEXTFAIL, TEXT_LOC_OVERFLOW );
1724   memcpy( iostrptr + actual_index, begtxt, nchars );
1725   actual_index += nchars;
1726   if( actual_index > maximum_index )
1727     maximum_index = actual_index;
1728 }
1729
1730 static
1731 void scanstr( char* begtxt, char* endtxt )
1732 {
1733   int  nchars = endtxt - begtxt;
1734   if( actual_index + nchars > iostrlen )
1735     IOEXCEPTION( TEXTFAIL, NO_CHARS_FOR_TEXT );
1736   if( strncmp( iostrptr + actual_index, begtxt, nchars ) )
1737     IOEXCEPTION( TEXTFAIL, FORMAT_TEXT_MISMATCH );
1738   actual_index += nchars;
1739 }
1740
1741 void (*ftextptr) ( char*, char* );
1742
1743 static
1744 formatexit_t scanformcont( char* fcs, int len,
1745                            char** fcsptr, int* lenptr )
1746 {
1747   char          curr;
1748   fcsstate_t    state  = FormatText;
1749   unsigned long buf;
1750   int           dig;
1751   acttype_t     action;
1752   char*         begtxt = fcs;
1753
1754   while( len-- )
1755   {
1756     curr = *fcs++;
1757     switch( state )
1758     {
1759     case FormatText:
1760       if( curr == '%' )
1761       {
1762         ftextptr( begtxt, fcs-1 );
1763         state = FirstPercent;
1764       }
1765       break;
1766
1767 after_first_percent: ;
1768     case FirstPercent:
1769       if( curr == '%' )
1770       {
1771         state = FormatText;
1772         begtxt = fcs - 1;
1773         break;
1774       }
1775       if( curr == ')' )
1776       {
1777         *lenptr = len;
1778         *fcsptr = fcs;
1779         return EndAtParen;
1780       }
1781       if( isDEC(curr) )
1782       {
1783         state = RepFact;
1784         repetition = curr - '0';
1785         break;
1786       }
1787
1788       repetition = 1;
1789
1790 test_for_control_codes: ;
1791       if( isCVC(curr) )
1792       {
1793         state = ConvClause;
1794         action = ConvAct;
1795         convcode = strchr( CONVERSIONCODES, curr ) - CONVERSIONCODES;
1796         leftadjust = False;
1797         overflowev = False;
1798         dynamicwid = False;
1799         paddingdef = False;
1800         paddingchar = ' ';
1801         fractiondef = False;
1802         /* fractionwidth = 0; default depends on mode ! */
1803         exponentdef = False;
1804         exponentwidth = 3;
1805         clausewidth = 0;
1806         break;
1807       }
1808       if( isEDC(curr) )
1809       {
1810         state = EditClause;
1811         action = EditAct;
1812         editcode = strchr( EDITCODES, curr ) - EDITCODES;
1813         dynamicwid = False;
1814         clausewidth = editcode == Tabulation ? 0 : 1;
1815         break;
1816       }
1817       if( isIOC(curr) )
1818       {
1819         state = ClauseEnd;
1820         action = IOAct;
1821         iocode = strchr( IOCODES, curr ) - IOCODES;
1822         break;
1823       }
1824       if( curr == '(' )
1825       {
1826         unsigned long times = repetition;
1827         int  cntlen;
1828         char* cntfcs;
1829         while( times-- )
1830         {
1831           if( scanformcont( fcs, len, &cntfcs, &cntlen ) != EndAtParen )
1832             IOEXCEPTION( TEXTFAIL, UNMATCHED_OPENING_PAREN );
1833         }
1834         fcs = cntfcs;
1835         len = cntlen;
1836         state  = FormatText;
1837         begtxt = fcs;
1838         break;
1839       }
1840       IOEXCEPTION( TEXTFAIL, BAD_FORMAT_SPEC_CHAR );
1841
1842     case RepFact:
1843       if( isDEC(curr) )
1844       {
1845         dig = curr - '0';
1846         if( repetition > (ULONG_MAX - dig)/10 )
1847           IOEXCEPTION( TEXTFAIL, REPFAC_OVERFLOW );
1848         repetition = repetition*10 + dig;
1849         break;
1850       }
1851       goto test_for_control_codes;
1852
1853     case ConvClause:
1854       if( isDEC(curr) )
1855       {
1856         state = ClauseWidth;
1857         clausewidth = curr - '0';
1858         break;
1859       }
1860       if( curr == 'L' )
1861       {
1862         if( leftadjust )
1863           IOEXCEPTION( TEXTFAIL, DUPLICATE_QUALIFIER );
1864         leftadjust = True;
1865         break;
1866       }
1867       if( curr == 'E' )
1868       {
1869         if( overflowev )
1870           IOEXCEPTION( TEXTFAIL, DUPLICATE_QUALIFIER );
1871         overflowev = True;
1872         break;
1873       }
1874       if( curr == 'P' )
1875       {
1876         if( paddingdef )
1877           IOEXCEPTION( TEXTFAIL, DUPLICATE_QUALIFIER );
1878         paddingdef = True;
1879         state = CatchPadding;
1880         break;
1881       }
1882
1883 test_for_variable_width: ;
1884       if( curr == 'V' )
1885       {
1886         dynamicwid = True;
1887         state = AfterWidth;
1888         break;
1889       }
1890       goto test_for_fraction_width;
1891
1892     case ClauseWidth:
1893       if( isDEC(curr) )
1894       {
1895         dig = curr - '0';
1896         if( clausewidth > (ULONG_MAX - dig)/10 )
1897           IOEXCEPTION( TEXTFAIL, CLAUSE_WIDTH_OVERFLOW );
1898         clausewidth = clausewidth*10 + dig;
1899         break;
1900       }
1901       /* fall through */
1902
1903 test_for_fraction_width: ;
1904     case AfterWidth:
1905       if( curr == '.' )
1906       {
1907         if( convcode != DefaultConv && convcode != ScientConv )
1908           IOEXCEPTION( TEXTFAIL, NO_FRACTION );
1909         fractiondef = True;
1910         state = FractWidth;
1911         break;
1912       }
1913       goto test_for_exponent_width;
1914
1915     case FractWidth:
1916       if( isDEC( curr ) )
1917       {
1918         state = FractWidthCont;
1919         fractionwidth = curr - '0';
1920         break;
1921       }
1922       else
1923         IOEXCEPTION( TEXTFAIL, NO_FRACTION_WIDTH );
1924
1925     case FractWidthCont:
1926       if( isDEC( curr ) )
1927       {
1928         dig = curr - '0';
1929         if( fractionwidth > (ULONG_MAX - dig)/10 )
1930           IOEXCEPTION( TEXTFAIL, FRACTION_WIDTH_OVERFLOW );
1931         fractionwidth = fractionwidth*10 + dig;
1932         break;
1933       }
1934
1935 test_for_exponent_width: ;
1936       if( curr == ':' )
1937       {
1938         if( convcode != ScientConv )
1939           IOEXCEPTION( TEXTFAIL, NO_EXPONENT );
1940         exponentdef = True;
1941         state = ExpoWidth;
1942         break;
1943       }
1944       goto test_for_final_percent;
1945
1946     case ExpoWidth:
1947       if( isDEC( curr ) )
1948       {
1949         state = ExpoWidthCont;
1950         exponentwidth = curr - '0';
1951         break;
1952       }
1953       else
1954         IOEXCEPTION( TEXTFAIL, NO_EXPONENT_WIDTH );
1955
1956     case ExpoWidthCont:
1957       if( isDEC( curr ) )
1958       {
1959         dig = curr - '0';
1960         if( exponentwidth > (ULONG_MAX - dig)/10 )
1961           IOEXCEPTION( TEXTFAIL, EXPONENT_WIDTH_OVERFLOW );
1962         exponentwidth = exponentwidth*10 + dig;
1963         break;
1964       }
1965       /* fall through  */
1966
1967 test_for_final_percent: ;
1968     case ClauseEnd:
1969       if( curr == '%' )
1970       {
1971         state = LastPercent;
1972         break;
1973       }
1974
1975   do_the_action: ;
1976       actionptr[action]();
1977       state = FormatText;
1978       begtxt = fcs - 1;
1979       break;
1980
1981     case CatchPadding:
1982       paddingchar = curr;
1983       state = ConvClause;
1984       break;
1985
1986     case EditClause:
1987       if( isDEC(curr) )
1988       {
1989         state = ClauseWidth;
1990         clausewidth = curr - '0';
1991         break;
1992       }
1993       goto test_for_variable_width;
1994
1995     case LastPercent:
1996       actionptr[action]();
1997       if( curr == '.' )
1998       {
1999         state = FormatText;
2000         begtxt = fcs;
2001         break;
2002       }
2003       goto after_first_percent;
2004
2005     default:
2006       IOEXCEPTION( TEXTFAIL, INTERNAL_ERROR );
2007     }
2008   }
2009   switch( state )
2010   {
2011   case FormatText:
2012     ftextptr( begtxt, fcs );
2013     break;
2014   case FirstPercent:
2015   case LastPercent:
2016   case RepFact:
2017   case FractWidth:
2018   case ExpoWidth:
2019     IOEXCEPTION( TEXTFAIL, BAD_FORMAT_SPEC_CHAR );
2020   case CatchPadding:
2021     IOEXCEPTION( TEXTFAIL, NO_PAD_CHAR );
2022   default:
2023     actionptr[action]();
2024   }
2025
2026   *lenptr = len;
2027   *fcsptr = fcs;
2028   return NormalEnd;
2029 }
2030
2031 static
2032 void
2033 __read_format (char*           fmtptr,
2034                int             fmtlen,
2035                __tmp_IO_list*  ioptr,
2036                int             iolen,
2037                void*           inpptr,
2038                int             inplen )
2039 {
2040   formatexit_t res;
2041   unsigned short l;
2042
2043   iostrptr = (char*)inpptr;
2044   iostrlen = inplen;
2045
2046   /* initialisation */
2047   iolist_index = 0;
2048   iolistptr    = ioptr;
2049   iolistlen    = iolen;
2050
2051   actionptr = readactions;
2052   ftextptr = scanstr;
2053
2054   if( (res = scanformcont( fmtptr, fmtlen, &fmtptr, &fmtlen )) == EndAtParen )
2055     IOEXCEPTION( TEXTFAIL, UNMATCHED_CLOSING_PAREN );
2056
2057   if( iolist_index != iolen )
2058     IOEXCEPTION( TEXTFAIL, EXCESS_IOLIST_ELEMENTS );
2059
2060   return;
2061 }
2062
2063 void
2064 __readtext_f( Text_Mode*      the_text_loc,
2065               signed long     the_index,
2066               char*           fmtptr,
2067               int             fmtlen,
2068               __tmp_IO_list*  ioptr,
2069               int             iolen,
2070               char*           file,
2071               int             line )
2072 {
2073   unsigned long info;
2074
2075   if( (info = setjmp( __io_exception )) )
2076     CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
2077
2078   textptr       = the_text_loc;
2079   textrecptr    = textptr->text_record;
2080   actual_index  = textptr->actual_index;
2081   textindex     = the_index;
2082
2083   __read_format ( fmtptr, fmtlen, ioptr, iolen,
2084                   (char*)textrecptr + 2, textptr->text_record->len );
2085   textptr->actual_index = actual_index;
2086 }
2087
2088 void
2089 __readtext_s( void*           string_ptr,
2090               int             string_len,
2091               char*           fmtptr,
2092               int             fmtlen,
2093               __tmp_IO_list*  ioptr,
2094               int             iolen,
2095               char*           file,
2096               int             line )
2097 {
2098   int info;
2099
2100   if( (info = setjmp( __io_exception )) )
2101     CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
2102
2103   textptr      = NULL;
2104   actual_index = 0;
2105
2106   __read_format ( fmtptr, fmtlen,  ioptr, iolen, string_ptr, string_len );
2107 }
2108
2109 static
2110 void
2111 __write_format (char*           fmtptr,
2112                 int             fmtlen,
2113                 __tmp_IO_list*  ioptr,
2114                 int             iolen,
2115                 void*           outptr,
2116                 int             outlen )
2117 {
2118   formatexit_t res;
2119   unsigned short l;
2120
2121   /* initialisation */
2122   maximum_index = actual_index;
2123   iolist_index = 0;
2124
2125   actionptr = writeactions;
2126   ftextptr  = emitstr;
2127   iolistptr = ioptr;
2128   iolistlen = iolen;
2129   iostrptr  = (char *)outptr + 2;
2130   iostrlen  = outlen;
2131
2132   if( (res = scanformcont( fmtptr, fmtlen, &fmtptr, &fmtlen )) == EndAtParen )
2133     IOEXCEPTION( TEXTFAIL, UNMATCHED_CLOSING_PAREN );
2134
2135   if( iolist_index != iolen )
2136     IOEXCEPTION( TEXTFAIL, EXCESS_IOLIST_ELEMENTS );
2137
2138   /* set length of output string */
2139 #if _TEXTIO_DEBUG_
2140   printf( "maximum index = %d\n", maximum_index );
2141 #endif
2142   l = maximum_index;
2143   MOV2(outptr,&l);
2144   return;
2145 }
2146
2147 void
2148 __writetext_f( Text_Mode*      the_text_loc,
2149                signed long     the_index,
2150                char*           fmtptr,
2151                int             fmtlen,
2152                __tmp_IO_list*  ioptr,
2153                int             iolen,
2154                char*           file,
2155                int             line )
2156 {
2157   int info;
2158
2159   if( (info = setjmp( __io_exception )) )
2160     CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
2161
2162   textptr       = the_text_loc;
2163   textrecptr    = the_text_loc->text_record;
2164   textindex     = the_index;
2165   iolistptr     = ioptr;
2166   iolistlen     = iolen;
2167
2168   actual_index = textptr->actual_index;
2169   __write_format ( fmtptr, fmtlen, ioptr, iolen,
2170                    textrecptr, textptr->access_sub->reclength - 2 );
2171   textptr->actual_index = actual_index;
2172 }
2173
2174 void
2175 __writetext_s( void*           string_ptr,
2176                int             string_len,
2177                char*           fmtptr,
2178                int             fmtlen,
2179                __tmp_IO_list*  ioptr,
2180                int             iolen,
2181                char*           file,
2182                int             line )
2183 {
2184   int info;
2185
2186   if( (info = setjmp( __io_exception )) )
2187     CHILLEXCEPTION( file, line, info>>16, info & 0xffff );
2188
2189   textptr      = NULL;
2190   actual_index = 0;
2191
2192   __write_format ( fmtptr, fmtlen, ioptr, iolen, string_ptr, string_len );
2193 }