git.zerfleddert.de Git - micropolis/blob - src/tclx/src/tclxutil.c

   1 /*
   2  * tclXutil.c
   3  *
   4  * Utility functions for Extended Tcl.
   5  *-----------------------------------------------------------------------------
   6  * Copyright 1992 Karl Lehenbauer and Mark Diekhans.
   7  *
   8  * Permission to use, copy, modify, and distribute this software and its
   9  * documentation for any purpose and without fee is hereby granted, provided
  10  * that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11  * Mark Diekhans make no representations about the suitability of this
  12  * software for any purpose.  It is provided "as is" without express or
  13  * implied warranty.
  14  *-----------------------------------------------------------------------------
  15  * $Id: tclXutil.c,v 2.0 1992/10/16 04:51:21 markd Rel $
  16  *-----------------------------------------------------------------------------
  17  */
  18
  19 #include "tclxint.h"
  20
  21 #ifndef _tolower
  22 #  define _tolower tolower
  23 #  define _toupper toupper
  24 #endif
  25
  26 /*
  27  * Used to return argument messages by most commands.
  28  */
  29 char *tclXWrongArgs = "wrong # args: ";
  30
  31 extern double pow ();
  32
  33 \f
  34 /*
  35  *-----------------------------------------------------------------------------
  36  *
  37  * Tcl_StrToLong --
  38  *      Convert an Ascii string to an long number of the specified base.
  39  *
  40  * Parameters:
  41  *   o string (I) - String containing a number.
  42  *   o base (I) - The base to use for the number 8, 10 or 16 or zero to decide
  43  *     based on the leading characters of the number.  Zero to let the number
  44  *     determine the base.
  45  *   o longPtr (O) - Place to return the converted number.  Will be
  46  *     unchanged if there is an error.
  47  *
  48  * Returns:
  49  *      Returns 1 if the string was a valid number, 0 invalid.
  50  *-----------------------------------------------------------------------------
  51  */
  52 int
  53 Tcl_StrToLong (string, base, longPtr)
  54     CONST char *string;
  55     int         base;
  56     long       *longPtr;
  57 {
  58     char *end;
  59     long  num;
  60
  61     num = strtol(string, &end, base);
  62     while ((*end != '\0') && isspace(*end)) {
  63         end++;
  64     }
  65     if ((end == string) || (*end != 0))
  66         return FALSE;
  67     *longPtr = num;
  68     return TRUE;
  69
  70 } /* Tcl_StrToLong */
  71 \f
  72 /*
  73  *-----------------------------------------------------------------------------
  74  *
  75  * Tcl_StrToInt --
  76  *      Convert an Ascii string to an number of the specified base.
  77  *
  78  * Parameters:
  79  *   o string (I) - String containing a number.
  80  *   o base (I) - The base to use for the number 8, 10 or 16 or zero to decide
  81  *     based on the leading characters of the number.  Zero to let the number
  82  *     determine the base.
  83  *   o intPtr (O) - Place to return the converted number.  Will be
  84  *     unchanged if there is an error.
  85  *
  86  * Returns:
  87  *      Returns 1 if the string was a valid number, 0 invalid.
  88  *-----------------------------------------------------------------------------
  89  */
  90 int
  91 Tcl_StrToInt (string, base, intPtr)
  92     CONST char *string;
  93     int         base;
  94     int        *intPtr;
  95 {
  96     char *end;
  97     int   num;
  98
  99     num = strtol(string, &end, base);
 100     while ((*end != '\0') && isspace(*end)) {
 101         end++;
 102     }
 103     if ((end == string) || (*end != 0))
 104         return FALSE;
 105     *intPtr = num;
 106     return TRUE;
 107
 108 } /* Tcl_StrToInt */
 109 \f
 110 /*
 111  *-----------------------------------------------------------------------------
 112  *
 113  * Tcl_StrToUnsigned --
 114  *      Convert an Ascii string to an unsigned int of the specified base.
 115  *
 116  * Parameters:
 117  *   o string (I) - String containing a number.
 118  *   o base (I) - The base to use for the number 8, 10 or 16 or zero to decide
 119  *     based on the leading characters of the number.  Zero to let the number
 120  *     determine the base.
 121  *   o unsignedPtr (O) - Place to return the converted number.  Will be
 122  *     unchanged if there is an error.
 123  *
 124  * Returns:
 125  *      Returns 1 if the string was a valid number, 0 invalid.
 126  *-----------------------------------------------------------------------------
 127  */
 128 int
 129 Tcl_StrToUnsigned (string, base, unsignedPtr)
 130     CONST char *string;
 131     int         base;
 132     unsigned   *unsignedPtr;
 133 {
 134     char          *end;
 135     unsigned long  num;
 136
 137     num = strtoul (string, &end, base);
 138     while ((*end != '\0') && isspace(*end)) {
 139         end++;
 140     }
 141     if ((end == string) || (*end != 0))
 142         return FALSE;
 143     *unsignedPtr = num;
 144     return TRUE;
 145
 146 } /* Tcl_StrToUnsigned */
 147 \f
 148 /*
 149  *-----------------------------------------------------------------------------
 150  *
 151  * Tcl_StrToDouble --
 152  *   Convert a string to a double percision floating point number.
 153  *
 154  * Parameters:
 155  *   string (I) - Buffer containing double value to convert.
 156  *   doublePtr (O) - The convert floating point number.
 157  * Returns:
 158  *   TRUE if the number is ok, FALSE if it is illegal.
 159  *-----------------------------------------------------------------------------
 160  */
 161 int
 162 Tcl_StrToDouble (string, doublePtr)
 163     CONST char *string;
 164     double     *doublePtr;
 165 {
 166     char   *end;
 167     double  num;
 168
 169     num = strtod (string, &end);
 170     while ((*end != '\0') && isspace(*end)) {
 171         end++;
 172     }
 173     if ((end == string) || (*end != 0))
 174         return FALSE;
 175
 176     *doublePtr = num;
 177     return TRUE;
 178
 179 } /* Tcl_StrToDouble */
 180 \f
 181 /*
 182  *-----------------------------------------------------------------------------
 183  *
 184  * Tcl_DownShift --
 185  *     Utility procedure to down-shift a string.  It is written in such
 186  *     a way as that the target string maybe the same as the source string.
 187  *
 188  * Parameters:
 189  *   o targetStr (I) - String to store the down-shifted string in.  Must
 190  *     have enough space allocated to store the string.  If NULL is specified,
 191  *     then the string will be dynamicly allocated and returned as the
 192  *     result of the function. May also be the same as the source string to
 193  *     shift in place.
 194  *   o sourceStr (I) - The string to down-shift.
 195  *
 196  * Returns:
 197  *   A pointer to the down-shifted string
 198  *-----------------------------------------------------------------------------
 199  */
 200 char *
 201 Tcl_DownShift (targetStr, sourceStr)
 202     char       *targetStr;
 203     CONST char *sourceStr;
 204 {
 205     register char theChar;
 206
 207     if (targetStr == NULL)
 208         targetStr = ckalloc (strlen ((char *) sourceStr) + 1);
 209
 210     for (; (theChar = *sourceStr) != '\0'; sourceStr++) {
 211         if (isupper (theChar))
 212             theChar = _tolower (theChar);
 213         *targetStr++ = theChar;
 214     }
 215     *targetStr = '\0';
 216     return targetStr;
 217 }
 218 \f
 219 /*
 220  *-----------------------------------------------------------------------------
 221  *
 222  * Tcl_UpShift --
 223  *     Utility procedure to up-shift a string.
 224  *
 225  * Parameters:
 226  *   o targetStr (I) - String to store the up-shifted string in.  Must
 227  *     have enough space allocated to store the string.  If NULL is specified,
 228  *     then the string will be dynamicly allocated and returned as the
 229  *     result of the function. May also be the same as the source string to
 230  *     shift in place.
 231  *   o sourceStr (I) - The string to up-shift.
 232  *
 233  * Returns:
 234  *   A pointer to the up-shifted string
 235  *-----------------------------------------------------------------------------
 236  */
 237 char *
 238 Tcl_UpShift (targetStr, sourceStr)
 239     char       *targetStr;
 240     CONST char *sourceStr;
 241 {
 242     register char theChar;
 243
 244     if (targetStr == NULL)
 245         targetStr = ckalloc (strlen ((char *) sourceStr) + 1);
 246
 247     for (; (theChar = *sourceStr) != '\0'; sourceStr++) {
 248         if (islower (theChar))
 249             theChar = _toupper (theChar);
 250         *targetStr++ = theChar;
 251     }
 252     *targetStr = '\0';
 253     return targetStr;
 254 }
 255 \f
 256 /*
 257  *-----------------------------------------------------------------------------
 258  *
 259  * Tcl_ExpandDynBuf --
 260  *
 261  *    Expand a dynamic buffer so that it will have room to hold the
 262  *    specified additional space.  If `appendSize' is zero, the buffer
 263  *    size will just be doubled.
 264  *
 265  *-----------------------------------------------------------------------------
 266  */
 267 void
 268 Tcl_ExpandDynBuf (dynBufPtr, appendSize)
 269     dynamicBuf_t *dynBufPtr;
 270     int           appendSize;
 271 {
 272     int   newSize, minSize;
 273     char *oldBufPtr;
 274
 275     newSize = dynBufPtr->size * 2;
 276     minSize = dynBufPtr->len + 1 + appendSize;
 277     if (newSize < minSize)
 278         newSize = minSize;
 279
 280     oldBufPtr = dynBufPtr->ptr;
 281     dynBufPtr->ptr = ckalloc (newSize);
 282     memcpy (dynBufPtr->ptr, oldBufPtr, dynBufPtr->len + 1);
 283     if (oldBufPtr != dynBufPtr->buf)
 284         ckfree ((char *) oldBufPtr);
 285     dynBufPtr->size = newSize;
 286 }
 287 \f
 288 /*
 289  *-----------------------------------------------------------------------------
 290  *
 291  * Tcl_DynBufInit --
 292  *
 293  *    Initializes a dynamic buffer.
 294  *
 295  *-----------------------------------------------------------------------------
 296  */
 297 void
 298 Tcl_DynBufInit (dynBufPtr)
 299     dynamicBuf_t *dynBufPtr;
 300 {
 301     dynBufPtr->buf [0] = '\0';
 302     dynBufPtr->ptr = dynBufPtr->buf;
 303     dynBufPtr->size = INIT_DYN_BUFFER_SIZE;
 304     dynBufPtr->len = 0;
 305 }
 306 \f
 307 /*
 308  *-----------------------------------------------------------------------------
 309  *
 310  * Tcl_DynBufFree --
 311  *
 312  *    Clean up a dynamic buffer, release space if it was dynamicly
 313  * allocated.
 314  *
 315  *-----------------------------------------------------------------------------
 316  */
 317 void
 318 Tcl_DynBufFree (dynBufPtr)
 319     dynamicBuf_t *dynBufPtr;
 320 {
 321     if (dynBufPtr->ptr != dynBufPtr->buf)
 322         ckfree (dynBufPtr->ptr);
 323 }
 324 \f
 325 /*
 326  *-----------------------------------------------------------------------------
 327  *
 328  * Tcl_DynBufReturn --
 329  *
 330  *    Return the contents of the dynamic buffer as an interpreter result.
 331  * Don't call DynBufFree after calling this procedure.  The dynamic buffer
 332  * must be re-initialized to reuse it.
 333  *
 334  *-----------------------------------------------------------------------------
 335  */
 336 void
 337 Tcl_DynBufReturn (interp, dynBufPtr)
 338     Tcl_Interp    *interp;
 339     dynamicBuf_t *dynBufPtr;
 340 {
 341     if (dynBufPtr->ptr != dynBufPtr->buf)
 342         Tcl_SetResult (interp, dynBufPtr->ptr, TCL_DYNAMIC);
 343     else
 344         Tcl_SetResult (interp, dynBufPtr->ptr, TCL_VOLATILE);
 345 }
 346 \f
 347 /*
 348  *-----------------------------------------------------------------------------
 349  *
 350  * Tcl_DynBufAppend --
 351  *
 352  *    Append the specified string to the dynamic buffer, expanding if
 353  *    necessary. Assumes the string in the buffer is zero terminated.
 354  *
 355  *-----------------------------------------------------------------------------
 356  */
 357 void
 358 Tcl_DynBufAppend (dynBufPtr, newStr)
 359     dynamicBuf_t *dynBufPtr;
 360     char         *newStr;
 361 {
 362     int newLen, currentUsed;
 363
 364     newLen = strlen (newStr);
 365     if ((dynBufPtr->len + newLen + 1) > dynBufPtr->size)
 366         Tcl_ExpandDynBuf (dynBufPtr, newLen);
 367     strcpy (dynBufPtr->ptr + dynBufPtr->len, newStr);
 368     dynBufPtr->len += newLen;
 369 }
 370 \f
 371 /*
 372  *-----------------------------------------------------------------------------
 373  *
 374  * Tcl_DynamicFgets --
 375  *
 376  *    Reads a line from a file into a dynamic buffer.  The buffer will be
 377  * expanded, if necessary and reads are done until EOL or EOF is reached.
 378  * Any data already in the buffer will be overwritten. if append is not
 379  * specified.  Even if an error or EOF is encountered, the buffer should
 380  * be cleaned up, as storage may have still been allocated.
 381  *
 382  * Results:
 383  *    If data was transfered, returns 1, if EOF was encountered without
 384  * transfering any data, returns 0.  If an error occured, returns, -1.
 385  *
 386  *-----------------------------------------------------------------------------
 387  */
 388 int
 389 Tcl_DynamicFgets (dynBufPtr, filePtr, append)
 390     dynamicBuf_t *dynBufPtr;
 391     FILE         *filePtr;
 392     int           append;
 393 {
 394     int   readVal;
 395
 396     if (!append)
 397         dynBufPtr->len = 0;
 398
 399     while (TRUE) {
 400         if (dynBufPtr->len + 1 == dynBufPtr->size)
 401             Tcl_ExpandDynBuf (dynBufPtr, 0);
 402
 403         readVal = getc (filePtr);
 404         if (readVal == '\n')      /* Is it a new-line? */
 405             break;
 406         if (readVal == EOF) {     /* Is it an EOF or an error? */
 407             if (feof (filePtr)) {
 408                 break;
 409             }
 410             return -1;   /* Error */
 411         }
 412         dynBufPtr->ptr [dynBufPtr->len++] = readVal;
 413     }
 414     dynBufPtr->ptr [dynBufPtr->len] = '\0';
 415     return (readVal == EOF) ? 0 : 1;
 416 }
 417 \f
 418 /*
 419  *-----------------------------------------------------------------------------
 420  *
 421  * Tcl_GetLong --
 422  *
 423  *      Given a string, produce the corresponding long value.
 424  *
 425  * Results:
 426  *      The return value is normally TCL_OK;  in this case *intPtr
 427  *      will be set to the integer value equivalent to string.  If
 428  *      string is improperly formed then TCL_ERROR is returned and
 429  *      an error message will be left in interp->result.
 430  *
 431  * Side effects:
 432  *      None.
 433  *
 434  *-----------------------------------------------------------------------------
 435  */
 436 int
 437 Tcl_GetLong(interp, string, longPtr)
 438     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
 439     CONST char *string;         /* String containing a (possibly signed)
 440                                  * integer in a form acceptable to strtol. */
 441     long       *longPtr;        /* Place to store converted result. */
 442 {
 443     char *end;
 444     long  i;
 445
 446     i = strtol(string, &end, 0);
 447     while ((*end != '\0') && isspace(*end)) {
 448         end++;
 449     }
 450     if ((end == string) || (*end != 0)) {
 451         Tcl_AppendResult (interp, "expected integer but got \"", string,
 452                           "\"", (char *) NULL);
 453         return TCL_ERROR;
 454     }
 455     *longPtr = i;
 456     return TCL_OK;
 457 }
 458 \f
 459 /*
 460  *-----------------------------------------------------------------------------
 461  *
 462  * Tcl_GetUnsigned --
 463  *
 464  *      Given a string, produce the corresponding unsigned integer value.
 465  *
 466  * Results:
 467  *      The return value is normally TCL_OK;  in this case *intPtr
 468  *      will be set to the integer value equivalent to string.  If
 469  *      string is improperly formed then TCL_ERROR is returned and
 470  *      an error message will be left in interp->result.
 471  *
 472  * Side effects:
 473  *      None.
 474  *
 475  *-----------------------------------------------------------------------------
 476  */
 477 int
 478 Tcl_GetUnsigned(interp, string, unsignedPtr)
 479     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
 480     CONST char *string;         /* String containing a (possibly signed)
 481                                  * integer in a form acceptable to strtoul. */
 482     unsigned   *unsignedPtr;    /* Place to store converted result. */
 483 {
 484     char          *end;
 485     unsigned long  i;
 486
 487     /*
 488      * Since some strtoul functions don't detect negative numbers, check
 489      * in advance.
 490      */
 491     while (isspace(*string))
 492         string++;
 493     if (string [0] == '-')
 494         goto badUnsigned;
 495
 496     i = strtoul(string, &end, 0);
 497     while ((*end != '\0') && isspace(*end))
 498         end++;
 499
 500     if ((end == string) || (*end != '\0'))
 501         goto badUnsigned;
 502
 503     *unsignedPtr = i;
 504     return TCL_OK;
 505
 506   badUnsigned:
 507     Tcl_AppendResult (interp, "expected unsigned integer but got \"",
 508                       string, "\"", (char *) NULL);
 509     return TCL_ERROR;
 510 }
 511 \f
 512 /*
 513  *-----------------------------------------------------------------------------
 514  *
 515  * Tcl_ConvertFileHandle --
 516  *
 517  * Convert a file handle to its file number. The file handle maybe one
 518  * of "stdin", "stdout" or "stderr" or "fileNNN", were NNN is the file
 519  * number.  If the handle is invalid, -1 is returned and a error message
 520  * will be returned in interp->result.  This is used when the file may
 521  * not be currently open.
 522  *
 523  *-----------------------------------------------------------------------------
 524  */
 525 int
 526 Tcl_ConvertFileHandle (interp, handle)
 527     Tcl_Interp *interp;
 528     char       *handle;
 529 {
 530     int fileId = -1;
 531
 532     if (handle [0] == 's') {
 533         if (STREQU (handle, "stdin"))
 534             fileId = 0;
 535         else if (STREQU (handle, "stdout"))
 536             fileId = 1;
 537         else if (STREQU (handle, "stderr"))
 538             fileId = 2;
 539     } else {
 540        if (STRNEQU (handle, "file", 4))
 541            Tcl_StrToInt (&handle [4], 10, &fileId);
 542     }
 543     if (fileId < 0)
 544         Tcl_AppendResult (interp, "invalid file handle: ", handle,
 545                           (char *) NULL);
 546     return fileId;
 547 }
 548 \f
 549 /*
 550  *-----------------------------------------------------------------------------
 551  *
 552  * Tcl_SetupFileEntry --
 553  *
 554  * Set up an entry in the Tcl file table for a file number, including the stdio
 555  * FILE structure.
 556  *
 557  * Parameters:
 558  *   o interp (I) - Current interpreter.
 559  *   o fileNum (I) - File number to set up the entry for.
 560  *   o readable (I) - TRUE if read access to the file.
 561  *   o writable (I) - TRUE if  write access to the file.
 562  * Returns:
 563  *   TCL_OK or TCL_ERROR;
 564  *-----------------------------------------------------------------------------
 565  */
 566 int
 567 Tcl_SetupFileEntry (interp, fileNum, readable, writable)
 568     Tcl_Interp *interp;
 569     int         fileNum;
 570     int         readable;
 571     int         writable;
 572 {
 573     Interp   *iPtr = (Interp *) interp;
 574     char     *mode;
 575     FILE     *fileCBPtr;
 576     OpenFile *filePtr;
 577
 578     /*
 579      * Set up a stdio FILE control block for the new file.
 580      */
 581     if (readable && writable) {
 582         mode = "r+";
 583     } else if (writable) {
 584         mode = "w";
 585     } else {
 586         mode = "r";
 587     }
 588     fileCBPtr = fdopen (fileNum, mode);
 589     if (fileCBPtr == NULL) {
 590         iPtr->result = Tcl_UnixError (interp);
 591         return TCL_ERROR;
 592     }
 593
 594     /*
 595      * Put the file in the Tcl table.
 596      */
 597     TclMakeFileTable (iPtr, fileNum);
 598     if (iPtr->filePtrArray [fileno (fileCBPtr)] != NULL)
 599         panic ("file already open");
 600     filePtr = (OpenFile *) ckalloc (sizeof (OpenFile));
 601     iPtr->filePtrArray [fileno (fileCBPtr)] = filePtr;
 602
 603     filePtr->f        = fileCBPtr;
 604     filePtr->f2       = NULL;
 605     filePtr->readable = readable;
 606     filePtr->writable = writable;
 607     filePtr->numPids  = 0;
 608     filePtr->pidPtr   = NULL;
 609     filePtr->errorId  = -1;
 610
 611     return TCL_OK;
 612 }
 613 \f
 614 /*
 615  *-----------------------------------------------------------------------------
 616  *
 617  * Tcl_System --
 618  *     does the equivalent of the Unix "system" library call, but
 619  *     uses waitpid to wait on the correct process, rather than
 620  *     waiting on all processes and throwing the exit statii away
 621  *     for the processes it isn't interested in, plus does it with
 622  *     a Tcl flavor
 623  *
 624  * Results:
 625  *  Standard TCL results, may return the UNIX system error message.
 626  *
 627  *-----------------------------------------------------------------------------
 628  */
 629 int
 630 Tcl_System (interp, command)
 631     Tcl_Interp *interp;
 632     char       *command;
 633 {
 634     int processID, waitStatus, processStatus;
 635
 636     if ((processID = Tcl_Fork()) < 0) {
 637         interp->result = Tcl_UnixError (interp);
 638         return -1;
 639     }
 640     if (processID == 0) {
 641         if (execl ("/bin/sh", "sh", "-c", command, (char *) NULL) < 0) {
 642             interp->result = Tcl_UnixError (interp);
 643             return -1;
 644         }
 645         exit(256);
 646     }
 647
 648     /*
 649      * Parent process.
 650      */
 651 #ifndef TCL_HAVE_WAITPID
 652     if (Tcl_WaitPids(1, &processID, &processStatus) == -1) {
 653         interp->result = Tcl_UnixError (interp);
 654         return -1;
 655     }
 656 #else
 657     if (waitpid (processID, &processStatus, 0) == -1) {
 658         interp->result = Tcl_UnixError (interp);
 659         return -1;
 660     }
 661 #endif
 662     return (WEXITSTATUS(processStatus));
 663
 664 }
 665 \f
 666 /*
 667  *--------------------------------------------------------------
 668  *
 669  * Tcl_ReturnDouble --
 670  *
 671  *      Format a double to the maximum precision supported on
 672  *      this machine.  If the number formats to an even integer,
 673  *      a ".0" is append to assure that the value continues to
 674  *      represent a floating point number.
 675  *
 676  * Results:
 677  *      A standard Tcl result.  If the result is TCL_OK, then the
 678  *      interpreter's result is set to the string value of the
 679  *      double.  If the result is TCL_OK, then interp->result
 680  *      contains an error message (If the number had the value of
 681  *      "not a number" or "infinite").
 682  *
 683  * Side effects:
 684  *      None.
 685  *
 686  *--------------------------------------------------------------
 687  */
 688
 689 int
 690 Tcl_ReturnDouble(interp, number)
 691     Tcl_Interp *interp;                 /* ->result gets converted number */
 692     double number;                      /* Number to convert */
 693 {
 694     static int precision = 0;
 695     register char *scanPtr;
 696
 697     /*
 698      * On the first call, determine the number of decimal digits that represent
 699      * the precision of a double.
 700      */
 701     if (precision == 0) {
 702 #ifdef IS_LINUX
 703         precision = 8;
 704 #else
 705         sprintf (interp->result, "%.0f", pow (2.0, (double) DSIGNIF));
 706         precision = strlen (interp->result);
 707 #endif
 708     }
 709
 710     sprintf (interp->result, "%.*g", precision, number);
 711
 712     /*
 713      * Scan the number for "." or "e" to assure that the number has not been
 714      * converted to an integer.  Also check for NaN on infinite
 715      */
 716
 717     scanPtr = interp->result;
 718     if (scanPtr [0] == '-')
 719         scanPtr++;
 720     for (; isdigit (*scanPtr); scanPtr++)
 721         continue;
 722
 723     switch (*scanPtr) {
 724       case '.':
 725       case 'e':
 726         return TCL_OK;
 727       case 'n':
 728       case 'N':
 729         interp->result = "Floating point error, result is not a number";
 730         return TCL_ERROR;
 731       case 'i':
 732       case 'I':
 733         interp->result = "Floating point error, result is infinite";
 734         return TCL_ERROR;
 735       case '\0':
 736         scanPtr [0] = '.';
 737         scanPtr [1] = '0';
 738         scanPtr [2] = '\0';
 739         return TCL_OK;
 740     }
 741
 742     /*
 743      * If we made it here, this sprintf returned something we did not expect.
 744      */
 745     Tcl_AppendResult (interp, ": unexpected floating point conversion result",
 746                       (char *) NULL);
 747     return TCL_ERROR;
 748 }
 749