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