Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | [kennykb-numerics-branch] * generic/tclScan.c: Extended scan to accept the %lld, %llo, %llx, and %lli formats. Numeric scanning is now done via TclParseNumber calls. * generic/tclInt.h: Extended TclParseNumber to accept new flag * generic/tclStrToD.c: values TCL_PARSE_INTEGER_ONLY, TCL_PARSE_OCTAL_ONLY, and TCL_PARSE_HEXIDECIMAL_ONLY, to give caller more control over the parsing rules. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | kennykb-numerics-branch |
| Files: | files | file ages | folders |
| SHA1: |
fc4c109c84c44373f3b711ed98861401 |
| User & Date: | dgp 2005-09-01 16:09:56 |
Context
|
2005-09-01
| ||
| 16:27 |
* generic/tclObj.c: TclParseNumber calls meant to parse an integer value now pas...check-in: 6e311ccfa4 user: dgp tags: kennykb-numerics-branch | |
| 16:09 |
[kennykb-numerics-branch] * generic/tclScan.c: Extended scan to accept the %ll...check-in: fc4c109c84 user: dgp tags: kennykb-numerics-branch | |
|
2005-08-30
| ||
| 19:20 |
[kennykb-numerics-branch] * generic/tclObj.c: Extended bignum support to includ...check-in: 4ef199b1b3 user: dgp tags: kennykb-numerics-branch | |
Changes
Changes to ChangeLog.
1 +2005-09-01 Don Porter <[email protected]> 2 + 3 + [kennykb-numerics-branch] 4 + 5 + * generic/tclScan.c: Extended [scan] to accept the %lld, 6 + %llo, %llx, and %lli formats. Numeric scanning is now done 7 + via TclParseNumber calls. 8 + 9 + * generic/tclInt.h: Extended TclParseNumber to accept new flag 10 + * generic/tclStrToD.c: values TCL_PARSE_INTEGER_ONLY, 11 + TCL_PARSE_OCTAL_ONLY, and TCL_PARSE_HEXIDECIMAL_ONLY, to give caller 12 + more control over the parsing rules. 13 + 1 14 2005-08-30 Don Porter <[email protected]> 2 15 3 16 [kennykb-numerics-branch] 4 17 5 18 * generic/tclObj.c: Extended bignum support to include bignums 6 19 so large they will not pack into a Tcl_Obj. When they outgrow Tcl's 7 20 string rep length limits, a panic will result.
Changes to generic/tclInt.h.
8 8 * Copyright (c) 1994-1998 Sun Microsystems, Inc. 9 9 * Copyright (c) 1998-19/99 by Scriptics Corporation. 10 10 * Copyright (c) 2001, 2002 by Kevin B. Kenny. All rights reserved. 11 11 * 12 12 * See the file "license.terms" for information on usage and redistribution of 13 13 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 14 * 15 - * RCS: @(#) $Id: tclInt.h,v 1.202.2.35 2005/08/29 18:38:45 dgp Exp $ 15 + * RCS: @(#) $Id: tclInt.h,v 1.202.2.36 2005/09/01 16:09:56 dgp Exp $ 16 16 */ 17 17 18 18 #ifndef _TCLINT 19 19 #define _TCLINT 20 20 21 21 /* 22 22 * Some numerics configuration options ................................................................................ 1887 1887 *---------------------------------------------------------------------- 1888 1888 * Flags for TclParseNumber 1889 1889 *---------------------------------------------------------------------- 1890 1890 */ 1891 1891 1892 1892 #define TCL_PARSE_DECIMAL_ONLY 1 1893 1893 /* Leading zero doesn't denote octal or hex */ 1894 +#define TCL_PARSE_OCTAL_ONLY 2 /* Parse octal even without prefix */ 1895 +#define TCL_PARSE_HEXADECIMAL_ONLY 4 1896 + /* Parse hexadecimal even without prefix */ 1897 +#define TCL_PARSE_INTEGER_ONLY 8 1898 + /* Disable floating point parsing */ 1894 1899 1895 1900 /* 1896 1901 *---------------------------------------------------------------- 1897 1902 * Variables shared among Tcl modules but not used by the outside world. 1898 1903 *---------------------------------------------------------------- 1899 1904 */ 1900 1905
Changes to generic/tclScan.c.
4 4 * This file contains the implementation of the "scan" command. 5 5 * 6 6 * Copyright (c) 1998 by Scriptics Corporation. 7 7 * 8 8 * See the file "license.terms" for information on usage and redistribution of 9 9 * this file, and for a DISCLAIMER OF ALL WARRANTIES. 10 10 * 11 - * RCS: @(#) $Id: tclScan.c,v 1.16.2.3 2005/08/23 18:28:51 kennykb Exp $ 11 + * RCS: @(#) $Id: tclScan.c,v 1.16.2.4 2005/09/01 16:09:57 dgp Exp $ 12 12 */ 13 13 14 14 #include "tclInt.h" 15 15 16 16 /* 17 17 * Flag values used by Tcl_ScanObjCmd. 18 18 */ 19 19 20 20 #define SCAN_NOSKIP 0x1 /* Don't skip blanks. */ 21 21 #define SCAN_SUPPRESS 0x2 /* Suppress assignment. */ 22 22 #define SCAN_UNSIGNED 0x4 /* Read an unsigned value. */ 23 23 #define SCAN_WIDTH 0x8 /* A width value was supplied. */ 24 24 25 +#if 0 25 26 #define SCAN_SIGNOK 0x10 /* A +/- character is allowed. */ 26 27 #define SCAN_NODIGITS 0x20 /* No digits have been scanned. */ 27 28 #define SCAN_NOZERO 0x40 /* No zero digits have been scanned. */ 28 29 #define SCAN_XOK 0x80 /* An 'x' is allowed. */ 29 30 #define SCAN_PTOK 0x100 /* Decimal point is allowed. */ 30 31 #define SCAN_EXPOK 0x200 /* An exponent is allowed. */ 32 +#endif 31 33 32 34 #define SCAN_LONGER 0x400 /* Asked for a wide value. */ 35 +#define SCAN_BIG 0x800 /* Asked for a bignum value. */ 33 36 34 37 /* 35 38 * The following structure contains the information associated with a 36 39 * character set. 37 40 */ 38 41 39 42 typedef struct CharSet { ................................................................................ 362 365 363 366 /* 364 367 * Handle any size specifier. 365 368 */ 366 369 367 370 switch (ch) { 368 371 case 'l': 372 + if (*format == 'l') { 373 + flags |= SCAN_BIG; 374 + format += 1; 375 + format += Tcl_UtfToUniChar(format, &ch); 376 + break; 377 + } 369 378 case 'L': 370 379 flags |= SCAN_LONGER; 371 380 case 'h': 372 381 format += Tcl_UtfToUniChar(format, &ch); 373 382 } 374 383 375 384 if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) { ................................................................................ 389 398 goto error; 390 399 } 391 400 /* 392 401 * Fall through! 393 402 */ 394 403 case 'n': 395 404 case 's': 396 - if (flags & SCAN_LONGER) { 397 - invalidLonger: 405 + if (flags & (SCAN_LONGER|SCAN_BIG)) { 406 + invalidFieldSize: 398 407 buf[Tcl_UniCharToUtf(ch, buf)] = '\0'; 399 408 Tcl_AppendResult(interp, 400 - "'l' modifier may not be specified in %", buf, 409 + "field size modifier may not be specified in %", buf, 401 410 " conversion", NULL); 402 411 goto error; 403 412 } 404 413 /* 405 414 * Fall through! 406 415 */ 407 416 case 'd': 408 417 case 'e': 409 418 case 'f': 410 419 case 'g': 411 420 case 'i': 412 421 case 'o': 413 - case 'u': 414 422 case 'x': 423 + break; 424 + case 'u': 425 + if (flags & SCAN_BIG) { 426 + Tcl_SetResult(interp, 427 + "unsigned bignum scans are invalid", TCL_STATIC); 428 + goto error; 429 + } 415 430 break; 416 431 /* 417 432 * Bracket terms need special checking 418 433 */ 419 434 case '[': 420 - if (flags & SCAN_LONGER) { 421 - goto invalidLonger; 435 + if (flags & (SCAN_LONGER|SCAN_BIG)) { 436 + goto invalidFieldSize; 422 437 } 423 438 if (*format == '\0') { 424 439 goto badSet; 425 440 } 426 441 format += Tcl_UtfToUniChar(format, &ch); 427 442 if (ch == '^') { 428 443 if (*format == '\0') { ................................................................................ 570 585 int objc; /* Number of arguments. */ 571 586 Tcl_Obj *CONST objv[]; /* Argument objects. */ 572 587 { 573 588 char *format; 574 589 int numVars, nconversions, totalVars = -1; 575 590 int objIndex, offset, i, result, code; 576 591 long value; 577 - char *string, *end, *baseString; 592 + CONST char *string, *end, *baseString; 578 593 char op = 0; 579 - int base = 0; 580 594 int underflow = 0; 581 595 size_t width; 582 - long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL; 583 -#ifndef TCL_WIDE_INT_IS_LONG 584 - Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL; 585 596 Tcl_WideInt wideValue; 586 -#endif 587 597 Tcl_UniChar ch, sch; 588 598 Tcl_Obj **objs = NULL, *objPtr = NULL; 589 599 int flags; 590 600 char buf[513]; /* Temporary buffer to hold scanned number 591 601 * strings before they are passed to 592 602 * strtoul. */ 603 +#if 0 604 + int base = 0; 605 + long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL; 606 +#ifndef TCL_WIDE_INT_IS_LONG 607 + Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL; 608 +#endif 609 +#endif 593 610 594 611 if (objc < 3) { 595 612 Tcl_WrongNumArgs(interp, 1, objv, 596 613 "string format ?varName varName ...?"); 597 614 return TCL_ERROR; 598 615 } 599 616 ................................................................................ 627 644 * reach the end of input, the end of the format string, or there is a 628 645 * mismatch. 629 646 */ 630 647 631 648 objIndex = 0; 632 649 nconversions = 0; 633 650 while (*format != '\0') { 651 + int parseFlag = 0; 634 652 format += Tcl_UtfToUniChar(format, &ch); 635 653 636 654 flags = 0; 637 655 638 656 /* 639 657 * If we see whitespace in the format, skip whitespace in the string. 640 658 */ ................................................................................ 674 692 * ('%n$'). 675 693 */ 676 694 677 695 if (ch == '*') { 678 696 flags |= SCAN_SUPPRESS; 679 697 format += Tcl_UtfToUniChar(format, &ch); 680 698 } else if ((ch < 0x80) && isdigit(UCHAR(ch))) { /* INTL: "C" locale. */ 681 - value = strtoul(format-1, &end, 10); /* INTL: "C" locale. */ 682 - if (*end == '$') { 683 - format = end+1; 699 + char *formatEnd; 700 + value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */ 701 + if (*formatEnd == '$') { 702 + format = formatEnd+1; 684 703 format += Tcl_UtfToUniChar(format, &ch); 685 704 objIndex = (int) value - 1; 686 705 } 687 706 } 688 707 689 708 /* 690 709 * Parse any width specifier. ................................................................................ 699 718 700 719 /* 701 720 * Handle any size specifier. 702 721 */ 703 722 704 723 switch (ch) { 705 724 case 'l': 725 + if (*format == 'l') { 726 + flags |= SCAN_BIG; 727 + format += 1; 728 + format += Tcl_UtfToUniChar(format, &ch); 729 + break; 730 + } 706 731 case 'L': 707 732 flags |= SCAN_LONGER; 708 733 /* 709 734 * Fall through so we skip to the next character. 710 735 */ 711 736 case 'h': 712 737 format += Tcl_UtfToUniChar(format, &ch); ................................................................................ 724 749 objs[objIndex++] = objPtr; 725 750 } 726 751 nconversions++; 727 752 continue; 728 753 729 754 case 'd': 730 755 op = 'i'; 756 + parseFlag = TCL_PARSE_DECIMAL_ONLY; 757 +#if 0 731 758 base = 10; 732 759 fn = (long (*) _ANSI_ARGS_((char*,void*,int)))strtol; 733 760 #ifndef TCL_WIDE_INT_IS_LONG 734 761 lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll; 762 +#endif 735 763 #endif 736 764 break; 737 765 case 'i': 738 766 op = 'i'; 767 +#if 0 739 768 base = 0; 740 769 fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtol; 741 770 #ifndef TCL_WIDE_INT_IS_LONG 742 771 lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll; 772 +#endif 743 773 #endif 744 774 break; 745 775 case 'o': 746 776 op = 'i'; 777 + parseFlag = TCL_PARSE_OCTAL_ONLY; 778 +#if 0 747 779 base = 8; 748 780 fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; 749 781 #ifndef TCL_WIDE_INT_IS_LONG 750 782 lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; 783 +#endif 751 784 #endif 752 785 break; 753 786 case 'x': 754 787 op = 'i'; 788 + parseFlag = TCL_PARSE_HEXADECIMAL_ONLY; 789 +#if 0 755 790 base = 16; 756 791 fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; 757 792 #ifndef TCL_WIDE_INT_IS_LONG 758 793 lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; 794 +#endif 759 795 #endif 760 796 break; 761 797 case 'u': 762 798 op = 'i'; 763 - base = 10; 764 799 flags |= SCAN_UNSIGNED; 800 +#if 0 801 + base = 10; 765 802 fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul; 766 803 #ifndef TCL_WIDE_INT_IS_LONG 767 804 lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull; 805 +#endif 768 806 #endif 769 807 break; 770 808 771 809 case 'f': 772 810 case 'e': 773 811 case 'g': 774 812 op = 'f'; ................................................................................ 899 937 break; 900 938 901 939 case 'i': 902 940 /* 903 941 * Scan an unsigned or signed integer. 904 942 */ 905 943 944 +#if 0 906 945 if ((width == 0) || (width > sizeof(buf) - 1)) { 907 946 width = sizeof(buf) - 1; 908 947 } 909 948 flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO; 910 949 for (end = buf; width > 0; width--) { 911 950 switch (*string) { 912 951 /* ................................................................................ 1045 1084 } 1046 1085 #endif 1047 1086 Tcl_IncrRefCount(objPtr); 1048 1087 objs[objIndex++] = objPtr; 1049 1088 } 1050 1089 1051 1090 break; 1091 +#else 1092 + objPtr = Tcl_NewLongObj(0); 1093 + Tcl_IncrRefCount(objPtr); 1094 + if (width == 0) { 1095 + width = -1; 1096 + } 1097 + if (TclParseNumber(NULL, objPtr, NULL, string, width, &end, 1098 + TCL_PARSE_INTEGER_ONLY | parseFlag) != TCL_OK) { 1099 + Tcl_DecrRefCount(objPtr); 1100 + /* TODO: set underflow? test scan-4.44 */ 1101 + goto done; 1102 + } 1103 + string = end; 1104 + if (flags & SCAN_SUPPRESS) { 1105 + Tcl_DecrRefCount(objPtr); 1106 + break; 1107 + } 1108 + if (flags & SCAN_LONGER) { 1109 + if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */ 1110 + if (Tcl_GetString(objPtr)[0] == '-') { 1111 + wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */ 1112 + } 1113 + } 1114 + if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { 1115 + sprintf(buf, "%" TCL_LL_MODIFIER "u", 1116 + (Tcl_WideUInt)wideValue); 1117 + Tcl_SetStringObj(objPtr, buf, -1); 1118 + } else { 1119 + Tcl_SetWideIntObj(objPtr, wideValue); 1120 + } 1121 + } else if (!(flags & SCAN_BIG)) { 1122 + if (Tcl_GetLongFromObj(NULL, objPtr, &value) != TCL_OK) { 1123 + if (Tcl_GetString(objPtr)[0] == '-') { 1124 + value = LONG_MIN; 1125 + } else { 1126 + value = LONG_MAX; 1127 + } 1128 + } 1129 + if ((flags & SCAN_UNSIGNED) && (value < 0)) { 1130 + sprintf(buf, "%lu", value); /* INTL: ISO digit */ 1131 + Tcl_SetStringObj(objPtr, buf, -1); 1132 + } else { 1133 + Tcl_SetLongObj(objPtr, value); 1134 + } 1135 + } 1136 + objs[objIndex++] = objPtr; 1137 + break; 1138 +#endif 1052 1139 1053 1140 case 'f': 1054 1141 /* 1055 1142 * Scan a floating point number 1056 1143 */ 1057 1144 1058 - flags &= ~SCAN_LONGER; 1059 - objPtr = Tcl_NewObj(); 1145 + objPtr = Tcl_NewDoubleObj(0.0); 1060 1146 Tcl_IncrRefCount(objPtr); 1061 1147 if (width == 0) { 1062 1148 width = -1; 1063 1149 } 1064 - if (TclParseNumber(NULL, objPtr, "", string, width, &end, 1150 + if (TclParseNumber(NULL, objPtr, NULL, string, width, &end, 1065 1151 TCL_PARSE_DECIMAL_ONLY) != TCL_OK) { 1152 + /* TODO: set underflow? test scan-4.55 */ 1066 1153 Tcl_DecrRefCount(objPtr); 1067 1154 goto done; 1068 1155 } else if (flags & SCAN_SUPPRESS) { 1069 1156 Tcl_DecrRefCount(objPtr); 1070 1157 string = end; 1071 1158 } else { 1072 1159 double dvalue; 1073 1160 if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) { 1161 +#ifdef ACCEPT_NAN 1162 + if (objPtr->typePtr == &tclDoubleType) { 1163 + dValue = objPtr->internalRep.doubleValue; 1164 + } else 1165 +#endif 1166 + { 1074 1167 Tcl_DecrRefCount(objPtr); 1075 1168 goto done; 1169 + } 1076 1170 } 1077 1171 Tcl_SetDoubleObj(objPtr, dvalue); 1078 1172 objs[objIndex++] = objPtr; 1079 1173 string = end; 1080 1174 } 1081 1175 } 1082 1176 nconversions++;
Changes to generic/tclStrToD.c.
10 10 * interconversion among 'double' and 'mp_int' types. 11 11 * 12 12 * Copyright (c) 2005 by Kevin B. Kenny. All rights reserved. 13 13 * 14 14 * See the file "license.terms" for information on usage and redistribution 15 15 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 16 16 * 17 - * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.34 2005/08/24 21:49:23 dgp Exp $ 17 + * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.35 2005/09/01 16:09:57 dgp Exp $ 18 18 * 19 19 *---------------------------------------------------------------------- 20 20 */ 21 21 22 22 #include <tclInt.h> 23 23 #include <stdio.h> 24 24 #include <stdlib.h> ................................................................................ 334 334 if (c == '0') { 335 335 if (flags & TCL_PARSE_DECIMAL_ONLY) { 336 336 state = DECIMAL; 337 337 } else { 338 338 state = ZERO; 339 339 } 340 340 break; 341 + } else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) { 342 + goto zerox; 343 + } else if (flags & TCL_PARSE_OCTAL_ONLY) { 344 + goto zeroo; 341 345 } else if (isdigit(UCHAR(c))) { 342 346 significandWide = c - '0'; 343 347 numSigDigs = 1; 344 348 state = DECIMAL; 345 349 break; 350 + } else if (flags & TCL_PARSE_INTEGER_ONLY) { 351 + goto endgame; 346 352 } else if (c == '.') { 347 353 state = LEADING_RADIX_POINT; 348 354 break; 349 355 } else if (c == 'I' || c == 'i') { 350 356 state = sI; 351 357 break; 352 358 #ifdef IEEE_FLOATING_POINT ................................................................................ 379 385 } 380 386 if (c == 'o' || c == 'O') { 381 387 explicitOctal = 1; 382 388 state = ZERO_O; 383 389 break; 384 390 } 385 391 #endif 392 + if (flags & TCL_PARSE_HEXADECIMAL_ONLY) { 393 + goto zerox; 394 + } 386 395 #ifdef KILL_OCTAL 387 396 goto decimal; 388 397 #endif 389 398 /* FALLTHROUGH */ 390 399 391 400 case OCTAL: 392 401 /* ................................................................................ 398 407 acceptState = state; 399 408 acceptPoint = p; 400 409 acceptLen = len; 401 410 #ifdef TIP_114_FORMATS 402 411 /* FALLTHROUGH */ 403 412 case ZERO_O: 404 413 #endif 414 + zeroo: 405 415 if (c == '0') { 406 416 ++numTrailZeros; 407 417 state = OCTAL; 408 418 break; 409 419 } else if (c >= '1' && c <= '7') { 410 420 if (objPtr != NULL) { 411 421 shift = 3 * (numTrailZeros + 1); ................................................................................ 455 465 case BAD_OCTAL: 456 466 #ifdef TIP_114_FORMATS 457 467 if (explicitOctal) { 458 468 /* No forgiveness for bad digits in explicitly octal numbers */ 459 469 goto endgame; 460 470 } 461 471 #endif 472 + if (flags & TCL_PARSE_INTEGER_ONLY) { 473 + /* No seeking floating point when parsing only integer */ 474 + goto endgame; 475 + } 462 476 #ifndef KILL_OCTAL 463 477 /* 464 478 * Scanned a number with a leading zero that contains an 465 479 * 8, 9, radix point or E. This is an invalid octal number, 466 480 * but might still be floating point. 467 481 */ 468 482 if (c == '0') { ................................................................................ 503 517 */ 504 518 case HEXADECIMAL: 505 519 acceptState = state; 506 520 acceptPoint = p; 507 521 acceptLen = len; 508 522 /* FALLTHROUGH */ 509 523 case ZERO_X: 524 + zerox: 510 525 if (c == '0') { 511 526 ++numTrailZeros; 512 527 state = HEXADECIMAL; 513 528 break; 514 529 } else if (isdigit(UCHAR(c))) { 515 530 d = (c-'0'); 516 531 } else if (c >= 'A' && c <= 'F') { ................................................................................ 618 633 &significandBig, 619 634 significandOverflow); 620 635 } 621 636 numSigDigs += ( numTrailZeros + 1 ); 622 637 numTrailZeros = 0; 623 638 state = DECIMAL; 624 639 break; 640 + } else if (flags & TCL_PARSE_INTEGER_ONLY) { 641 + goto endgame; 625 642 } else if (c == '.') { 626 643 state = FRACTION; 627 644 break; 628 645 } else if (c == 'E' || c == 'e') { 629 646 state = EXPONENT_START; 630 647 break; 631 648 }