1 /*
2 * bltUtil.c --
3 *
4 * This module implements utility procedures for the BLT
5 * toolkit.
6 *
7 * Copyright 1991-1998 Lucent Technologies, Inc.
8 *
9 * Permission to use, copy, modify, and distribute this software and
10 * its documentation for any purpose and without fee is hereby
11 * granted, provided that the above copyright notice appear in all
12 * copies and that both that the copyright notice and warranty
13 * disclaimer appear in supporting documentation, and that the names
14 * of Lucent Technologies any of their entities not be used in
15 * advertising or publicity pertaining to distribution of the software
16 * without specific, written prior permission.
17 *
18 * Lucent Technologies disclaims all warranties with regard to this
19 * software, including all implied warranties of merchantability and
20 * fitness. In no event shall Lucent Technologies be liable for any
21 * special, indirect or consequential damages or any damages
22 * whatsoever resulting from loss of use, data or profits, whether in
23 * an action of contract, negligence or other tortuous action, arising
24 * out of or in connection with the use or performance of this
25 * software.
26 */
27
28 #include "bltInt.h"
29 #if defined(__STDC__)
30 #include <stdarg.h>
31 #else
32 #include <varargs.h>
33 #endif
34 #include <bltHash.h>
35
36 /* Limit the length of path name in errors or they are unreadable. */
37 #define GETPATHOP(str) (strlen(str)<10?str:"$path")
38
39 #ifndef HAVE_STRTOLOWER
40 void
strtolower(s)41 strtolower(s)
42 register char *s;
43 {
44 while (*s != '\0') {
45 *s = tolower(UCHAR(*s));
46 s++;
47 }
48 }
49 #endif /* !HAVE_STRTOLOWER */
50
51 #ifndef HAVE_STRCASECMP
52
53 static unsigned char caseTable[] =
54 {
55 (unsigned char)'\000', (unsigned char)'\001',
56 (unsigned char)'\002', (unsigned char)'\003',
57 (unsigned char)'\004', (unsigned char)'\005',
58 (unsigned char)'\006', (unsigned char)'\007',
59 (unsigned char)'\010', (unsigned char)'\011',
60 (unsigned char)'\012', (unsigned char)'\013',
61 (unsigned char)'\014', (unsigned char)'\015',
62 (unsigned char)'\016', (unsigned char)'\017',
63 (unsigned char)'\020', (unsigned char)'\021',
64 (unsigned char)'\022', (unsigned char)'\023',
65 (unsigned char)'\024', (unsigned char)'\025',
66 (unsigned char)'\026', (unsigned char)'\027',
67 (unsigned char)'\030', (unsigned char)'\031',
68 (unsigned char)'\032', (unsigned char)'\033',
69 (unsigned char)'\034', (unsigned char)'\035',
70 (unsigned char)'\036', (unsigned char)'\037',
71 (unsigned char)'\040', (unsigned char)'\041',
72 (unsigned char)'\042', (unsigned char)'\043',
73 (unsigned char)'\044', (unsigned char)'\045',
74 (unsigned char)'\046', (unsigned char)'\047',
75 (unsigned char)'\050', (unsigned char)'\051',
76 (unsigned char)'\052', (unsigned char)'\053',
77 (unsigned char)'\054', (unsigned char)'\055',
78 (unsigned char)'\056', (unsigned char)'\057',
79 (unsigned char)'\060', (unsigned char)'\061',
80 (unsigned char)'\062', (unsigned char)'\063',
81 (unsigned char)'\064', (unsigned char)'\065',
82 (unsigned char)'\066', (unsigned char)'\067',
83 (unsigned char)'\070', (unsigned char)'\071',
84 (unsigned char)'\072', (unsigned char)'\073',
85 (unsigned char)'\074', (unsigned char)'\075',
86 (unsigned char)'\076', (unsigned char)'\077',
87 (unsigned char)'\100', (unsigned char)'\141',
88 (unsigned char)'\142', (unsigned char)'\143',
89 (unsigned char)'\144', (unsigned char)'\145',
90 (unsigned char)'\146', (unsigned char)'\147',
91 (unsigned char)'\150', (unsigned char)'\151',
92 (unsigned char)'\152', (unsigned char)'\153',
93 (unsigned char)'\154', (unsigned char)'\155',
94 (unsigned char)'\156', (unsigned char)'\157',
95 (unsigned char)'\160', (unsigned char)'\161',
96 (unsigned char)'\162', (unsigned char)'\163',
97 (unsigned char)'\164', (unsigned char)'\165',
98 (unsigned char)'\166', (unsigned char)'\167',
99 (unsigned char)'\170', (unsigned char)'\171',
100 (unsigned char)'\172', (unsigned char)'\133',
101 (unsigned char)'\134', (unsigned char)'\135',
102 (unsigned char)'\136', (unsigned char)'\137',
103 (unsigned char)'\140', (unsigned char)'\141',
104 (unsigned char)'\142', (unsigned char)'\143',
105 (unsigned char)'\144', (unsigned char)'\145',
106 (unsigned char)'\146', (unsigned char)'\147',
107 (unsigned char)'\150', (unsigned char)'\151',
108 (unsigned char)'\152', (unsigned char)'\153',
109 (unsigned char)'\154', (unsigned char)'\155',
110 (unsigned char)'\156', (unsigned char)'\157',
111 (unsigned char)'\160', (unsigned char)'\161',
112 (unsigned char)'\162', (unsigned char)'\163',
113 (unsigned char)'\164', (unsigned char)'\165',
114 (unsigned char)'\166', (unsigned char)'\167',
115 (unsigned char)'\170', (unsigned char)'\171',
116 (unsigned char)'\172', (unsigned char)'\173',
117 (unsigned char)'\174', (unsigned char)'\175',
118 (unsigned char)'\176', (unsigned char)'\177',
119 (unsigned char)'\200', (unsigned char)'\201',
120 (unsigned char)'\202', (unsigned char)'\203',
121 (unsigned char)'\204', (unsigned char)'\205',
122 (unsigned char)'\206', (unsigned char)'\207',
123 (unsigned char)'\210', (unsigned char)'\211',
124 (unsigned char)'\212', (unsigned char)'\213',
125 (unsigned char)'\214', (unsigned char)'\215',
126 (unsigned char)'\216', (unsigned char)'\217',
127 (unsigned char)'\220', (unsigned char)'\221',
128 (unsigned char)'\222', (unsigned char)'\223',
129 (unsigned char)'\224', (unsigned char)'\225',
130 (unsigned char)'\226', (unsigned char)'\227',
131 (unsigned char)'\230', (unsigned char)'\231',
132 (unsigned char)'\232', (unsigned char)'\233',
133 (unsigned char)'\234', (unsigned char)'\235',
134 (unsigned char)'\236', (unsigned char)'\237',
135 (unsigned char)'\240', (unsigned char)'\241',
136 (unsigned char)'\242', (unsigned char)'\243',
137 (unsigned char)'\244', (unsigned char)'\245',
138 (unsigned char)'\246', (unsigned char)'\247',
139 (unsigned char)'\250', (unsigned char)'\251',
140 (unsigned char)'\252', (unsigned char)'\253',
141 (unsigned char)'\254', (unsigned char)'\255',
142 (unsigned char)'\256', (unsigned char)'\257',
143 (unsigned char)'\260', (unsigned char)'\261',
144 (unsigned char)'\262', (unsigned char)'\263',
145 (unsigned char)'\264', (unsigned char)'\265',
146 (unsigned char)'\266', (unsigned char)'\267',
147 (unsigned char)'\270', (unsigned char)'\271',
148 (unsigned char)'\272', (unsigned char)'\273',
149 (unsigned char)'\274', (unsigned char)'\275',
150 (unsigned char)'\276', (unsigned char)'\277',
151 (unsigned char)'\300', (unsigned char)'\341',
152 (unsigned char)'\342', (unsigned char)'\343',
153 (unsigned char)'\344', (unsigned char)'\345',
154 (unsigned char)'\346', (unsigned char)'\347',
155 (unsigned char)'\350', (unsigned char)'\351',
156 (unsigned char)'\352', (unsigned char)'\353',
157 (unsigned char)'\354', (unsigned char)'\355',
158 (unsigned char)'\356', (unsigned char)'\357',
159 (unsigned char)'\360', (unsigned char)'\361',
160 (unsigned char)'\362', (unsigned char)'\363',
161 (unsigned char)'\364', (unsigned char)'\365',
162 (unsigned char)'\366', (unsigned char)'\367',
163 (unsigned char)'\370', (unsigned char)'\371',
164 (unsigned char)'\372', (unsigned char)'\333',
165 (unsigned char)'\334', (unsigned char)'\335',
166 (unsigned char)'\336', (unsigned char)'\337',
167 (unsigned char)'\340', (unsigned char)'\341',
168 (unsigned char)'\342', (unsigned char)'\343',
169 (unsigned char)'\344', (unsigned char)'\345',
170 (unsigned char)'\346', (unsigned char)'\347',
171 (unsigned char)'\350', (unsigned char)'\351',
172 (unsigned char)'\352', (unsigned char)'\353',
173 (unsigned char)'\354', (unsigned char)'\355',
174 (unsigned char)'\356', (unsigned char)'\357',
175 (unsigned char)'\360', (unsigned char)'\361',
176 (unsigned char)'\362', (unsigned char)'\363',
177 (unsigned char)'\364', (unsigned char)'\365',
178 (unsigned char)'\366', (unsigned char)'\367',
179 (unsigned char)'\370', (unsigned char)'\371',
180 (unsigned char)'\372', (unsigned char)'\373',
181 (unsigned char)'\374', (unsigned char)'\375',
182 (unsigned char)'\376', (unsigned char)'\377',
183 };
184
185 /*
186 *----------------------------------------------------------------------
187 *
188 * strcasecmp --
189 *
190 * Compare two strings, disregarding case.
191 *
192 * Results:
193 * Returns a signed integer representing the following:
194 *
195 * zero - two strings are equal
196 * negative - first string is less than second
197 * positive - first string is greater than second
198 *
199 *----------------------------------------------------------------------
200 */
201 int
strcasecmp(s1,s2)202 strcasecmp(s1, s2)
203 CONST char *s1;
204 CONST char *s2;
205 {
206 unsigned char *s = (unsigned char *)s1;
207 unsigned char *t = (unsigned char *)s2;
208
209 for ( /* empty */ ; (caseTable[*s] == caseTable[*t]); s++, t++) {
210 if (*s == '\0') {
211 return 0;
212 }
213 }
214 return (caseTable[*s] - caseTable[*t]);
215 }
216
217 /*
218 *----------------------------------------------------------------------
219 *
220 * strncasecmp --
221 *
222 * Compare two strings, disregarding case, up to a given length.
223 *
224 * Results:
225 * Returns a signed integer representing the following:
226 *
227 * zero - two strings are equal
228 * negative - first string is less than second
229 * positive - first string is greater than second
230 *
231 *----------------------------------------------------------------------
232 */
233 int
strncasecmp(s1,s2,length)234 strncasecmp(s1, s2, length)
235 CONST char *s1;
236 CONST char *s2;
237 size_t length;
238 {
239 register unsigned char *s = (unsigned char *)s1;
240 register unsigned char *t = (unsigned char *)s2;
241
242 for ( /* empty */ ; (length > 0); s++, t++, length--) {
243 if (caseTable[*s] != caseTable[*t]) {
244 return (caseTable[*s] - caseTable[*t]);
245 }
246 if (*s == '\0') {
247 return 0;
248 }
249 }
250 return 0;
251 }
252
253 #endif /* !HAVE_STRCASECMP */
254
255
256 #if (TCL_VERSION_NUMBER < _VERSION(8,1,0)) && (TCL_MAJOR_VERSION > 7)
257
258 char *
Tcl_GetString(Tcl_Obj * objPtr)259 Tcl_GetString(Tcl_Obj *objPtr)
260 {
261 unsigned int dummy;
262
263 return Tcl_GetStringFromObj(objPtr, &dummy);
264 }
265
266 int
Tcl_EvalObjv(Tcl_Interp * interp,int objc,Tcl_Obj ** objv,int flags)267 Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj **objv, int flags)
268 {
269 Tcl_DString dString;
270 register int i;
271 int result;
272
273 Tcl_DStringInit(&dString);
274 for (i = 0; i < objc; i++) {
275 Tcl_DStringAppendElement(&dString, Tcl_GetString(objv[i]));
276 }
277 result = Tcl_Eval(interp, Tcl_DStringValue(&dString));
278 Tcl_DStringFree(&dString);
279 return result;
280 }
281
282 int
Tcl_WriteObj(Tcl_Channel channel,Tcl_Obj * objPtr)283 Tcl_WriteObj(Tcl_Channel channel, Tcl_Obj *objPtr)
284 {
285 char *data;
286 int nBytes;
287
288 data = Tcl_GetStringFromObj(objPtr, &nBytes);
289 return Tcl_Write(channel, data, nBytes);
290 }
291
292 char *
Tcl_SetVar2Ex(Tcl_Interp * interp,char * part1,char * part2,Tcl_Obj * objPtr,int flags)293 Tcl_SetVar2Ex(
294 Tcl_Interp *interp,
295 char *part1,
296 char *part2,
297 Tcl_Obj *objPtr,
298 int flags)
299 {
300 return Tcl_SetVar2(interp, part1, part2, Tcl_GetString(objPtr), flags);
301 }
302
303 Tcl_Obj *
Tcl_GetVar2Ex(Tcl_Interp * interp,char * part1,char * part2,int flags)304 Tcl_GetVar2Ex(
305 Tcl_Interp *interp,
306 char *part1,
307 char *part2,
308 int flags)
309 {
310 char *result;
311
312 result = Tcl_GetVar2(interp, part1, part2, flags);
313 if (result == NULL) {
314 return NULL;
315 }
316 return Tcl_NewStringObj(result, -1);
317 }
318
319 #endif
320
321 /*
322 *----------------------------------------------------------------------
323 *
324 * CompareByDictionary
325 *
326 * This function compares two strings as if they were being used in
327 * an index or card catalog. The case of alphabetic characters is
328 * ignored, except to break ties. Thus "B" comes before "b" but
329 * after "a". Also, integers embedded in the strings compare in
330 * numerical order. In other words, "x10y" comes after "x9y", not
331 * before it as it would when using strcmp().
332 *
333 * Results:
334 * A negative result means that the first element comes before the
335 * second, and a positive result means that the second element
336 * should come first. A result of zero means the two elements
337 * are equal and it doesn't matter which comes first.
338 *
339 * Side effects:
340 * None.
341 *
342 *----------------------------------------------------------------------
343 */
344
345 #if HAVE_UTF
346 int
Blt_DictionaryCompare(left,right)347 Blt_DictionaryCompare(left, right)
348 CONST char *left, *right;
349 {
350 Tcl_UniChar uniLeft, uniRight, uniLeftLower, uniRightLower;
351 int diff, zeros;
352 int secondaryDiff = 0;
353
354 for(;;) {
355 if ((isdigit(UCHAR(*right))) && (isdigit(UCHAR(*left)))) {
356 /*
357 * There are decimal numbers embedded in the two
358 * strings. Compare them as numbers, rather than
359 * strings. If one number has more leading zeros than
360 * the other, the number with more leading zeros sorts
361 * later, but only as a secondary choice.
362 */
363
364 zeros = 0;
365 while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
366 right++;
367 zeros--;
368 }
369 while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
370 left++;
371 zeros++;
372 }
373 if (secondaryDiff == 0) {
374 secondaryDiff = zeros;
375 }
376
377 /*
378 * The code below compares the numbers in the two
379 * strings without ever converting them to integers. It
380 * does this by first comparing the lengths of the
381 * numbers and then comparing the digit values.
382 */
383
384 diff = 0;
385 for (;;) {
386 if (diff == 0) {
387 diff = UCHAR(*left) - UCHAR(*right);
388 }
389 right++;
390 left++;
391
392 /* Ignore commas in numbers. */
393 if (*left == ',') {
394 left++;
395 }
396 if (*right == ',') {
397 right++;
398 }
399
400 if (!isdigit(UCHAR(*right))) { /* INTL: digit */
401 if (isdigit(UCHAR(*left))) { /* INTL: digit */
402 return 1;
403 } else {
404 /*
405 * The two numbers have the same length. See
406 * if their values are different.
407 */
408
409 if (diff != 0) {
410 return diff;
411 }
412 break;
413 }
414 } else if (!isdigit(UCHAR(*left))) { /* INTL: digit */
415 return -1;
416 }
417 }
418 continue;
419 }
420
421 /*
422 * Convert character to Unicode for comparison purposes. If either
423 * string is at the terminating null, do a byte-wise comparison and
424 * bail out immediately.
425 */
426 if ((*left != '\0') && (*right != '\0')) {
427 left += Tcl_UtfToUniChar(left, &uniLeft);
428 right += Tcl_UtfToUniChar(right, &uniRight);
429 /*
430 * Convert both chars to lower for the comparison, because
431 * dictionary sorts are case insensitve. Convert to lower, not
432 * upper, so chars between Z and a will sort before A (where most
433 * other interesting punctuations occur)
434 */
435 uniLeftLower = Tcl_UniCharToLower(uniLeft);
436 uniRightLower = Tcl_UniCharToLower(uniRight);
437 } else {
438 diff = UCHAR(*left) - UCHAR(*right);
439 break;
440 }
441
442 diff = uniLeftLower - uniRightLower;
443 if (diff) {
444 return diff;
445 } else if (secondaryDiff == 0) {
446 if (Tcl_UniCharIsUpper(uniLeft) &&
447 Tcl_UniCharIsLower(uniRight)) {
448 secondaryDiff = -1;
449 } else if (Tcl_UniCharIsUpper(uniRight)
450 && Tcl_UniCharIsLower(uniLeft)) {
451 secondaryDiff = 1;
452 }
453 }
454 }
455 if (diff == 0) {
456 diff = secondaryDiff;
457 }
458 return diff;
459 }
460
461 #else
462
463 int
Blt_DictionaryCompare(left,right)464 Blt_DictionaryCompare(left, right)
465 char *left, *right; /* The strings to compare */
466 {
467 int diff, zeros;
468 int secondaryDiff = 0;
469
470 while (1) {
471 if (isdigit(UCHAR(*right)) && isdigit(UCHAR(*left))) {
472 /*
473 * There are decimal numbers embedded in the two
474 * strings. Compare them as numbers, rather than
475 * strings. If one number has more leading zeros than
476 * the other, the number with more leading zeros sorts
477 * later, but only as a secondary choice.
478 */
479
480 zeros = 0;
481 while ((*right == '0') && (isdigit(UCHAR(right[1])))) {
482 right++;
483 zeros--;
484 }
485 while ((*left == '0') && (isdigit(UCHAR(left[1])))) {
486 left++;
487 zeros++;
488 }
489 if (secondaryDiff == 0) {
490 secondaryDiff = zeros;
491 }
492
493 /*
494 * The code below compares the numbers in the two
495 * strings without ever converting them to integers. It
496 * does this by first comparing the lengths of the
497 * numbers and then comparing the digit values.
498 */
499
500 diff = 0;
501 while (1) {
502 if (diff == 0) {
503 diff = UCHAR(*left) - UCHAR(*right);
504 }
505 right++;
506 left++;
507 /* Ignore commas in numbers. */
508 if (*left == ',') {
509 left++;
510 }
511 if (*right == ',') {
512 right++;
513 }
514 if (!isdigit(UCHAR(*right))) {
515 if (isdigit(UCHAR(*left))) {
516 return 1;
517 } else {
518 /*
519 * The two numbers have the same length. See
520 * if their values are different.
521 */
522
523 if (diff != 0) {
524 return diff;
525 }
526 break;
527 }
528 } else if (!isdigit(UCHAR(*left))) {
529 return -1;
530 }
531 }
532 continue;
533 }
534 diff = UCHAR(*left) - UCHAR(*right);
535 if (diff) {
536 if (isupper(UCHAR(*left)) && islower(UCHAR(*right))) {
537 diff = UCHAR(tolower(*left)) - UCHAR(*right);
538 if (diff) {
539 return diff;
540 } else if (secondaryDiff == 0) {
541 secondaryDiff = -1;
542 }
543 } else if (isupper(UCHAR(*right)) && islower(UCHAR(*left))) {
544 diff = UCHAR(*left) - UCHAR(tolower(UCHAR(*right)));
545 if (diff) {
546 return diff;
547 } else if (secondaryDiff == 0) {
548 secondaryDiff = 1;
549 }
550 } else {
551 return diff;
552 }
553 }
554 if (*left == 0) {
555 break;
556 }
557 left++;
558 right++;
559 }
560 if (diff == 0) {
561 diff = secondaryDiff;
562 }
563 return diff;
564 }
565 #endif
566
567 #ifndef NDEBUG
568 void
Blt_Assert(testExpr,fileName,lineNumber)569 Blt_Assert(testExpr, fileName, lineNumber)
570 char *testExpr;
571 char *fileName;
572 int lineNumber;
573 {
574 #ifdef WINDEBUG
575 PurifyPrintf("line %d of %s: Assert \"%s\" failed\n", lineNumber,
576 fileName, testExpr);
577 #endif
578 fprintf(stderr, "line %d of %s: Assert \"%s\" failed\n",
579 lineNumber, fileName, testExpr);
580 fflush(stderr);
581 abort();
582 }
583 #endif
584
585 /*ARGSUSED*/
586 void
TCL_VARARGS_DEF(char *,arg1)587 Blt_Panic TCL_VARARGS_DEF(char *, arg1)
588 {
589 va_list argList;
590 char *format;
591
592 format = TCL_VARARGS_START(char *, arg1, argList);
593 vfprintf(stderr, format, argList);
594 fprintf(stderr, "\n");
595 fflush(stderr);
596 abort();
597 }
598
599 void
600 Blt_DStringAppendElements
TCL_VARARGS_DEF(Tcl_DString *,arg1)601 TCL_VARARGS_DEF(Tcl_DString *, arg1)
602 {
603 va_list argList;
604 Tcl_DString *dsPtr;
605 register char *elem;
606
607 dsPtr = TCL_VARARGS_START(Tcl_DString *, arg1, argList);
608 while ((elem = va_arg(argList, char *)) != NULL) {
609 Tcl_DStringAppendElement(dsPtr, elem);
610 }
611 va_end(argList);
612 }
613
614 static char stringRep[200];
615
616 char *
Blt_Itoa(value)617 Blt_Itoa(value)
618 int value;
619 {
620 sprintf(stringRep, "%d", value);
621 return stringRep;
622 }
623
624 char *
Blt_Utoa(value)625 Blt_Utoa(value)
626 unsigned int value;
627 {
628 sprintf(stringRep, "%u", value);
629 return stringRep;
630 }
631
632 char *
Blt_Dtoa(interp,value)633 Blt_Dtoa(interp, value)
634 Tcl_Interp *interp;
635 double value;
636 {
637 Tcl_PrintDouble(interp, value, stringRep);
638 return stringRep;
639 }
640
641 #if HAVE_UTF
642
643 #undef fopen
644 FILE *
Blt_OpenUtfFile(fileName,mode)645 Blt_OpenUtfFile(fileName, mode)
646 CONST char *fileName, *mode;
647 {
648 Tcl_DString dString;
649 FILE *f;
650
651 fileName = Tcl_UtfToExternalDString(NULL, fileName, -1, &dString);
652 f = fopen(fileName, mode);
653 Tcl_DStringFree(&dString);
654 return f;
655 }
656
657 #endif /* HAVE_UTF */
658
659 /*
660 *--------------------------------------------------------------
661 *
662 * Blt_InitHexTable --
663 *
664 * Table index for the hex values. Initialized once, first time.
665 * Used for translation value or delimiter significance lookup.
666 *
667 * We build the table at run time for several reasons:
668 *
669 * 1. portable to non-ASCII machines.
670 * 2. still reentrant since we set the init flag after setting
671 * table.
672 * 3. easier to extend.
673 * 4. less prone to bugs.
674 *
675 * Results:
676 * None.
677 *
678 *--------------------------------------------------------------
679 */
680 void
Blt_InitHexTable(hexTable)681 Blt_InitHexTable(hexTable)
682 char hexTable[];
683 {
684 hexTable['0'] = 0;
685 hexTable['1'] = 1;
686 hexTable['2'] = 2;
687 hexTable['3'] = 3;
688 hexTable['4'] = 4;
689 hexTable['5'] = 5;
690 hexTable['6'] = 6;
691 hexTable['7'] = 7;
692 hexTable['8'] = 8;
693 hexTable['9'] = 9;
694 hexTable['a'] = hexTable['A'] = 10;
695 hexTable['b'] = hexTable['B'] = 11;
696 hexTable['c'] = hexTable['C'] = 12;
697 hexTable['d'] = hexTable['D'] = 13;
698 hexTable['e'] = hexTable['E'] = 14;
699 hexTable['f'] = hexTable['F'] = 15;
700 }
701
702 /*
703 *--------------------------------------------------------------
704 *
705 * Blt_GetPosition --
706 *
707 * Convert a string representing a numeric position.
708 * A position can be in one of the following forms.
709 *
710 * number - number of the item in the hierarchy, indexed
711 * from zero.
712 * "end" - last position in the hierarchy.
713 *
714 * Results:
715 * A standard Tcl result. If "string" is a valid index, then
716 * *indexPtr is filled with the corresponding numeric index.
717 * If "end" was selected then *indexPtr is set to -1.
718 * Otherwise an error message is left in interp->result.
719 *
720 * Side effects:
721 * None.
722 *
723 *--------------------------------------------------------------
724 */
725 int
Blt_GetPosition(interp,string,indexPtr)726 Blt_GetPosition(interp, string, indexPtr)
727 Tcl_Interp *interp; /* Interpreter to report results back
728 * to. */
729 char *string; /* String representation of the index.
730 * Can be an integer or "end" to refer
731 * to the last index. */
732 int *indexPtr; /* Holds the converted index. */
733 {
734 if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
735 *indexPtr = -1; /* Indicates last position in hierarchy. */
736 } else {
737 int position;
738
739 if (Tcl_GetInt(interp, string, &position) != TCL_OK) {
740 return TCL_ERROR;
741 }
742 if (position < 0) {
743 Tcl_AppendResult(interp, "bad position \"", string, "\"",
744 (char *)NULL);
745 return TCL_ERROR;
746 }
747 *indexPtr = position;
748 }
749 return TCL_OK;
750 }
751 int
Blt_GetPositionSize(interp,string,size,indexPtr)752 Blt_GetPositionSize(interp, string, size, indexPtr)
753 Tcl_Interp *interp; /* Interpreter to report results back
754 * to. */
755 char *string; /* String representation of the index.
756 * Can be an integer or "end" to refer
757 * to the last index. */
758 int size;
759 int *indexPtr; /* Holds the converted index. */
760 {
761 int n;
762 if ((string[0] == 'e') && (strcmp(string, "end") == 0)) {
763 *indexPtr = size; /* Indicates last position in hierarchy. */
764 } else if ((string[0] == 'e') && (strncmp(string, "end-", 4) == 0) &&
765 Tcl_GetInt(NULL, string+4, &n) == TCL_OK && n>=0 && n<=size) {
766 *indexPtr = size-n; /* Indicates last position in hierarchy. */
767 } else {
768 int position;
769
770 if (Tcl_GetInt(interp, string, &position) != TCL_OK) {
771 return TCL_ERROR;
772 }
773 if (position < 0) {
774 Tcl_AppendResult(interp, "bad position \"", string, "\"",
775 (char *)NULL);
776 return TCL_ERROR;
777 }
778 *indexPtr = position;
779 }
780 return TCL_OK;
781 }
782
783 /*
784 * The hash table below is used to keep track of all the Blt_Uids created
785 * so far.
786 */
787 static Blt_HashTable uidTable;
788 static int uidInitialized = 0;
789
790 /*
791 *----------------------------------------------------------------------
792 *
793 * Blt_GetUid --
794 *
795 * Given a string, returns a unique identifier for the string.
796 * A reference count is maintained, so that the identifier
797 * can be freed when it is not needed any more. This can be used
798 * in many places to replace Tcl_GetUid.
799 *
800 * Results:
801 * This procedure returns a Blt_Uid corresponding to the "string"
802 * argument. The Blt_Uid has a string value identical to string
803 * (strcmp will return 0), but it's guaranteed that any other
804 * calls to this procedure with a string equal to "string" will
805 * return exactly the same result (i.e. can compare Blt_Uid
806 * *values* directly, without having to call strcmp on what they
807 * point to).
808 *
809 * Side effects:
810 * New information may be entered into the identifier table.
811 *
812 *----------------------------------------------------------------------
813 */
814 Blt_Uid
Blt_GetUid(string)815 Blt_GetUid(string)
816 char *string; /* String to convert. */
817 {
818 int isNew;
819 Blt_HashEntry *hPtr;
820 int refCount;
821
822 if (!uidInitialized) {
823 Blt_InitHashTable(&uidTable, BLT_STRING_KEYS);
824 uidInitialized = 1;
825 }
826 hPtr = Blt_CreateHashEntry(&uidTable, string, &isNew);
827 if (isNew) {
828 refCount = 0;
829 } else {
830 refCount = (int)Blt_GetHashValue(hPtr);
831 }
832 refCount++;
833 Blt_SetHashValue(hPtr, (ClientData)refCount);
834 return (Blt_Uid)Blt_GetHashKey(&uidTable, hPtr);
835 }
836
837 /*
838 *----------------------------------------------------------------------
839 *
840 * Blt_FreeUid --
841 *
842 * Frees the Blt_Uid if there are no more clients using this
843 * identifier.
844 *
845 * Results:
846 * None.
847 *
848 * Side effects:
849 * The identifier may be deleted from the identifier table.
850 *
851 *----------------------------------------------------------------------
852 */
853 void
Blt_FreeUid(uid)854 Blt_FreeUid(uid)
855 Blt_Uid uid; /* Identifier to release. */
856 {
857 Blt_HashEntry *hPtr;
858
859 if (!uidInitialized) {
860 Blt_InitHashTable(&uidTable, BLT_STRING_KEYS);
861 uidInitialized = 1;
862 }
863 hPtr = Blt_FindHashEntry(&uidTable, uid);
864 if (hPtr) {
865 int refCount;
866
867 refCount = (int)Blt_GetHashValue(hPtr);
868 refCount--;
869 if (refCount == 0) {
870 Blt_DeleteHashEntry(&uidTable, hPtr);
871 } else {
872 Blt_SetHashValue(hPtr, (ClientData)refCount);
873 }
874 } else {
875 fprintf(stderr, "tried to release unknown identifier \"%s\"\n", uid);
876 }
877 }
878
879 /*
880 *----------------------------------------------------------------------
881 *
882 * Blt_FindUid --
883 *
884 * Returns a Blt_Uid associated with a given string, if one exists.
885 *
886 * Results:
887 * A Blt_Uid for the string if one exists. Otherwise NULL.
888 *
889 *----------------------------------------------------------------------
890 */
891 Blt_Uid
Blt_FindUid(string)892 Blt_FindUid(string)
893 char *string; /* String to find. */
894 {
895 Blt_HashEntry *hPtr;
896
897 if (!uidInitialized) {
898 Blt_InitHashTable(&uidTable, BLT_STRING_KEYS);
899 uidInitialized = 1;
900 }
901 hPtr = Blt_FindHashEntry(&uidTable, string);
902 if (hPtr == NULL) {
903 return NULL;
904 }
905 return (Blt_Uid) Blt_GetHashKey(&uidTable, hPtr);
906 }
907
908 /*
909 *----------------------------------------------------------------------
910 *
911 * BinaryOpSearch --
912 *
913 * Performs a binary search on the array of command operation
914 * specifications to find a partial, anchored match for the
915 * given operation string.
916 *
917 * Results:
918 * If the string matches unambiguously the index of the specification
919 * in the array is returned. If the string does not match, even
920 * as an abbreviation, any operation, -1 is returned. If the string
921 * matches, but ambiguously -2 is returned.
922 *
923 *----------------------------------------------------------------------
924 */
925 static int
BinaryOpSearch(specArr,nSpecs,string)926 BinaryOpSearch(specArr, nSpecs, string)
927 Blt_OpSpec specArr[];
928 int nSpecs;
929 char *string; /* Name of minor operation to search for */
930 {
931 Blt_OpSpec *specPtr;
932 char c;
933 register int high, low, median;
934 register int compare, length;
935
936 low = 0;
937 high = nSpecs - 1;
938 c = string[0];
939 length = strlen(string);
940 while (low <= high) {
941 median = (low + high) >> 1;
942 specPtr = specArr + median;
943
944 /* Test the first character */
945 compare = c - specPtr->name[0];
946 if (compare == 0) {
947 /* Now test the entire string */
948 compare = strncmp(string, specPtr->name, length);
949 if (compare == 0) {
950 if (length < specPtr->minChars) {
951 return -2; /* Ambiguous operation name */
952 }
953 }
954 }
955 if (compare < 0) {
956 high = median - 1;
957 } else if (compare > 0) {
958 low = median + 1;
959 } else {
960 return median; /* Op found. */
961 }
962 }
963 return -1; /* Can't find operation */
964 }
965
966
967 /*
968 *----------------------------------------------------------------------
969 *
970 * LinearOpSearch --
971 *
972 * Performs a binary search on the array of command operation
973 * specifications to find a partial, anchored match for the
974 * given operation string.
975 *
976 * Results:
977 * If the string matches unambiguously the index of the specification
978 * in the array is returned. If the string does not match, even
979 * as an abbreviation, any operation, -1 is returned. If the string
980 * matches, but ambiguously -2 is returned.
981 *
982 *----------------------------------------------------------------------
983 */
984 static int
LinearOpSearch(specArr,nSpecs,string)985 LinearOpSearch(specArr, nSpecs, string)
986 Blt_OpSpec specArr[];
987 int nSpecs;
988 char *string; /* Name of minor operation to search for */
989 {
990 Blt_OpSpec *specPtr;
991 char c;
992 int length, nMatches, last;
993 register int i;
994
995 c = string[0];
996 length = strlen(string);
997 nMatches = 0;
998 last = -1;
999 for (specPtr = specArr, i = 0; i < nSpecs; i++, specPtr++) {
1000 if ((c == specPtr->name[0]) &&
1001 (strncmp(string, specPtr->name, length) == 0)) {
1002 last = i;
1003 nMatches++;
1004 if (length == specPtr->minChars) {
1005 break;
1006 }
1007 }
1008 }
1009 if (nMatches > 1) {
1010 return -2; /* Ambiguous operation name */
1011 }
1012 if (nMatches == 0) {
1013 return -1; /* Can't find operation */
1014 }
1015 return last; /* Op found. */
1016 }
1017
1018 /*
1019 *----------------------------------------------------------------------
1020 *
1021 * Blt_GetOp --
1022 *
1023 * Find the command operation given a string name. This is useful
1024 * where a group of command operations have the same argument
1025 * signature.
1026 *
1027 * Results:
1028 * If found, a pointer to the procedure (function pointer) is
1029 * returned. Otherwise NULL is returned and an error message
1030 * containing a list of the possible commands is returned in
1031 * interp->result.
1032 *
1033 *----------------------------------------------------------------------
1034 */
1035 Blt_Op
Blt_GetOp(interp,nSpecs,specArr,operPos,argc,argv,flags)1036 Blt_GetOp(interp, nSpecs, specArr, operPos, argc, argv, flags)
1037 Tcl_Interp *interp; /* Interpreter to report errors to */
1038 int nSpecs; /* Number of specifications in array */
1039 Blt_OpSpec specArr[]; /* Op specification array */
1040 int operPos; /* Index of the operation name argument */
1041 int argc; /* Number of arguments in the argument vector.
1042 * This includes any prefixed arguments */
1043 char *argv[]; /* Argument vector */
1044 int flags; /* */
1045 {
1046 Blt_OpSpec *specPtr;
1047 char *string;
1048 register int i;
1049 register int n;
1050
1051 if (argc <= operPos) { /* No operation argument */
1052 Tcl_AppendResult(interp, "wrong # args: ", (char *)NULL);
1053 usage:
1054 #ifdef USE_OLDGETOP
1055 Tcl_AppendResult(interp, "should be one of...", (char *)NULL);
1056 for (n = 0; n < nSpecs; n++) {
1057 Tcl_AppendResult(interp, "\n ", (char *)NULL);
1058 Tcl_AppendResult(interp, GETPATHOP(argv[0]), " ", (char *)NULL);
1059 for (i = 1; i < operPos; i++) {
1060 Tcl_AppendResult(interp, argv[i], " ", (char *)NULL);
1061 }
1062 specPtr = specArr + n;
1063 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage,
1064 (char *)NULL);
1065 }
1066 #else
1067 Tcl_AppendResult(interp, "must be ", (char *)NULL);
1068 for (n = 0; n < nSpecs; n++) {
1069 specPtr = specArr + n;
1070 if (n==(nSpecs-1)) {
1071 Tcl_AppendResult(interp, ", or ", 0);
1072 } else if (n>0) {
1073 Tcl_AppendResult(interp, ", ", 0);
1074 }
1075 Tcl_AppendResult(interp, specPtr->name, 0);
1076 }
1077 #endif
1078 return NULL;
1079 }
1080 string = argv[operPos];
1081 if (flags & BLT_OP_LINEAR_SEARCH) {
1082 n = LinearOpSearch(specArr, nSpecs, string);
1083 } else {
1084 n = BinaryOpSearch(specArr, nSpecs, string);
1085 }
1086 if (n == -2) {
1087 char c;
1088 int length;
1089
1090 Tcl_AppendResult(interp, "ambiguous", (char *)NULL);
1091 if (operPos > 2) {
1092 Tcl_AppendResult(interp, " ", argv[operPos - 1], (char *)NULL);
1093 }
1094 Tcl_AppendResult(interp, " option \"", string, "\" matches:",
1095 (char *)NULL);
1096
1097 c = string[0];
1098 length = strlen(string);
1099 for (n = 0; n < nSpecs; n++) {
1100 specPtr = specArr + n;
1101 if ((c == specPtr->name[0]) &&
1102 (strncmp(string, specPtr->name, length) == 0)) {
1103 Tcl_AppendResult(interp, " ", specPtr->name, (char *)NULL);
1104 }
1105 }
1106 return NULL;
1107
1108 } else if (n == -1) { /* Can't find operation, display help */
1109 Tcl_AppendResult(interp, "bad", (char *)NULL);
1110 if (operPos > 2) {
1111 Tcl_AppendResult(interp, " ", argv[operPos - 1], (char *)NULL);
1112 }
1113 Tcl_AppendResult(interp, " option \"", string, "\": ",
1114 (char *)NULL);
1115 goto usage;
1116 }
1117 specPtr = specArr + n;
1118 if ((argc < specPtr->minArgs) || ((specPtr->maxArgs > 0) &&
1119 (argc > specPtr->maxArgs))) {
1120 Tcl_AppendResult(interp, "wrong # args: should be \"", (char *)NULL);
1121 for (i = 0; i < operPos; i++) {
1122 Tcl_AppendResult(interp, argv[i], " ", (char *)NULL);
1123 }
1124 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage, "\"",
1125 (char *)NULL);
1126 return NULL;
1127 }
1128 return specPtr->proc;
1129 }
1130
1131 #if (TCL_VERSION_NUMBER >= _VERSION(8,0,0))
1132
1133 /*
1134 *----------------------------------------------------------------------
1135 *
1136 * Blt_GetOpFromObj --
1137 *
1138 * Find the command operation given a string name. This is useful
1139 * where a group of command operations have the same argument
1140 * signature.
1141 *
1142 * Results:
1143 * If found, a pointer to the procedure (function pointer) is
1144 * returned. Otherwise NULL is returned and an error message
1145 * containing a list of the possible commands is returned in
1146 * interp->result.
1147 *
1148 *----------------------------------------------------------------------
1149 */
1150 Blt_Op
Blt_GetOpFromObj(interp,nSpecs,specArr,operPos,objc,objv,flags)1151 Blt_GetOpFromObj(interp, nSpecs, specArr, operPos, objc, objv, flags)
1152 Tcl_Interp *interp; /* Interpreter to report errors to */
1153 int nSpecs; /* Number of specifications in array */
1154 Blt_OpSpec specArr[]; /* Op specification array */
1155 int operPos; /* Position of operation in argument list. */
1156 int objc; /* Number of arguments in the argument vector.
1157 * This includes any prefixed arguments */
1158 Tcl_Obj *CONST objv[]; /* Argument vector */
1159 int flags;
1160 {
1161 Blt_OpSpec *specPtr;
1162 char *string;
1163 register int i;
1164 register int n;
1165
1166 if (objc <= operPos) { /* No operation argument */
1167 Tcl_AppendResult(interp, "wrong # args: ", (char *)NULL);
1168 usage:
1169 #ifdef USE_OLDGETOP
1170 Tcl_AppendResult(interp, "should be one of...", (char *)NULL);
1171 for (n = 0; n < nSpecs; n++) {
1172 Tcl_AppendResult(interp, "\n ", (char *)NULL);
1173 Tcl_AppendResult(interp, GETPATHOP(Tcl_GetString(objv[0])), " ", (char *)NULL);
1174 for (i = 1; i < operPos; i++) {
1175 Tcl_AppendResult(interp, Tcl_GetString(objv[i]), " ",
1176 (char *)NULL);
1177 }
1178 specPtr = specArr + n;
1179 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage,
1180 (char *)NULL);
1181 }
1182 #else
1183 Tcl_AppendResult(interp, "must be ", (char *)NULL);
1184 for (n = 0; n < nSpecs; n++) {
1185 specPtr = specArr + n;
1186 if (n==(nSpecs-1)) {
1187 Tcl_AppendResult(interp, ", or ", 0);
1188 } else if (n>0) {
1189 Tcl_AppendResult(interp, ", ", 0);
1190 }
1191 Tcl_AppendResult(interp, specPtr->name, 0);
1192 }
1193 #endif
1194 return NULL;
1195 }
1196 string = Tcl_GetString(objv[operPos]);
1197 if (flags & BLT_OP_LINEAR_SEARCH) {
1198 n = LinearOpSearch(specArr, nSpecs, string);
1199 } else {
1200 #ifndef NDEBUG
1201 if (0) {
1202 i = 0;
1203 while (++i<nSpecs) {
1204 if (strcmp(specArr[i-1].name, specArr[i].name)>0) {
1205 fprintf(stderr, "ops out of order: %s, %s\n", specArr[i-1].name, specArr[i].name);
1206 }
1207 }
1208 }
1209 #endif
1210 n = BinaryOpSearch(specArr, nSpecs, string);
1211 }
1212 if (n == -2) {
1213 char c;
1214 int length;
1215
1216 Tcl_AppendResult(interp, "ambiguous", (char *)NULL);
1217 if (operPos > 2) {
1218 Tcl_AppendResult(interp, " ", Tcl_GetString(objv[operPos - 1]),
1219 (char *)NULL);
1220 }
1221 Tcl_AppendResult(interp, " option \"", string, "\" matches:",
1222 (char *)NULL);
1223
1224 c = string[0];
1225 length = strlen(string);
1226 for (n = 0; n < nSpecs; n++) {
1227 specPtr = specArr + n;
1228 if ((c == specPtr->name[0]) &&
1229 (strncmp(string, specPtr->name, length) == 0)) {
1230 Tcl_AppendResult(interp, " ", specPtr->name, (char *)NULL);
1231 }
1232 }
1233 return NULL;
1234
1235 } else if (n == -1) { /* Can't find operation, display help */
1236 Tcl_AppendResult(interp, "bad", (char *)NULL);
1237 if (operPos > 2) {
1238 Tcl_AppendResult(interp, " ", Tcl_GetString(objv[operPos - 1]),
1239 (char *)NULL);
1240 }
1241 Tcl_AppendResult(interp, " option \"", string, "\": ", (char *)NULL);
1242 goto usage;
1243 }
1244 specPtr = specArr + n;
1245 if ((objc < specPtr->minArgs) ||
1246 ((specPtr->maxArgs > 0) && (objc > specPtr->maxArgs))) {
1247 Tcl_AppendResult(interp, "wrong # args: should be \"", (char *)NULL);
1248 for (i = 0; i < operPos; i++) {
1249 Tcl_AppendResult(interp, Tcl_GetString(objv[i]), " ",
1250 (char *)NULL);
1251 }
1252 Tcl_AppendResult(interp, specPtr->name, " ", specPtr->usage, "\"",
1253 (char *)NULL);
1254 return NULL;
1255 }
1256 return specPtr->proc;
1257 }
1258 #endif
1259
1260 #include <stdio.h>
1261
1262 /* open a file
1263 * calculate the CRC32 of the entire contents
1264 * return the CRC
1265 * if there is an error rdet the global variable Crcerror
1266 */
1267
1268 /* ---------------------------------------------------------------- */
1269
1270 /* this is the CRC32 lookup table
1271 * thanks Gary S. Brown
1272 * 64 lines of 4 values for a 256 dword table (1024 bytes)
1273 */
1274 static unsigned long crcTab[256] =
1275 { /* CRC polynomial 0xedb88320 */
1276 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL,
1277 0x076dc419UL, 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL,
1278 0x0edb8832UL, 0x79dcb8a4UL, 0xe0d5e91eUL, 0x97d2d988UL,
1279 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, 0x90bf1d91UL,
1280 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL,
1281 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL,
1282 0x136c9856UL, 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL,
1283 0x14015c4fUL, 0x63066cd9UL, 0xfa0f3d63UL, 0x8d080df5UL,
1284 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, 0xa2677172UL,
1285 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL,
1286 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL,
1287 0x32d86ce3UL, 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL,
1288 0x26d930acUL, 0x51de003aUL, 0xc8d75180UL, 0xbfd06116UL,
1289 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, 0xb8bda50fUL,
1290 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL,
1291 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL,
1292 0x76dc4190UL, 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL,
1293 0x71b18589UL, 0x06b6b51fUL, 0x9fbfe4a5UL, 0xe8b8d433UL,
1294 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, 0xe10e9818UL,
1295 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL,
1296 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL,
1297 0x6c0695edUL, 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL,
1298 0x65b0d9c6UL, 0x12b7e950UL, 0x8bbeb8eaUL, 0xfcb9887cUL,
1299 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, 0xfbd44c65UL,
1300 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL,
1301 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL,
1302 0x4369e96aUL, 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL,
1303 0x44042d73UL, 0x33031de5UL, 0xaa0a4c5fUL, 0xdd0d7cc9UL,
1304 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, 0xc90c2086UL,
1305 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL,
1306 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL,
1307 0x59b33d17UL, 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL,
1308 0xedb88320UL, 0x9abfb3b6UL, 0x03b6e20cUL, 0x74b1d29aUL,
1309 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, 0x73dc1683UL,
1310 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL,
1311 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL,
1312 0xf00f9344UL, 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL,
1313 0xf762575dUL, 0x806567cbUL, 0x196c3671UL, 0x6e6b06e7UL,
1314 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, 0x67dd4accUL,
1315 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL,
1316 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL,
1317 0xd1bb67f1UL, 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL,
1318 0xd80d2bdaUL, 0xaf0a1b4cUL, 0x36034af6UL, 0x41047a60UL,
1319 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, 0x4669be79UL,
1320 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL,
1321 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL,
1322 0xc5ba3bbeUL, 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL,
1323 0xc2d7ffa7UL, 0xb5d0cf31UL, 0x2cd99e8bUL, 0x5bdeae1dUL,
1324 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, 0x026d930aUL,
1325 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL,
1326 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL,
1327 0x92d28e9bUL, 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL,
1328 0x86d3d2d4UL, 0xf1d4e242UL, 0x68ddb3f8UL, 0x1fda836eUL,
1329 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, 0x18b74777UL,
1330 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL,
1331 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL,
1332 0xa00ae278UL, 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL,
1333 0xa7672661UL, 0xd06016f7UL, 0x4969474dUL, 0x3e6e77dbUL,
1334 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, 0x37d83bf0UL,
1335 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL,
1336 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL,
1337 0xbad03605UL, 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL,
1338 0xb3667a2eUL, 0xc4614ab8UL, 0x5d681b02UL, 0x2a6f2b94UL,
1339 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, 0x2d02ef8dUL
1340 };
1341
1342 #define CRC32(c, b) (crcTab[((int)(c) ^ (b)) & 0xff] ^ ((c) >> 8))
1343 #define DO1(buf) crc = CRC32(crc, *buf++)
1344 #define DO2(buf) DO1(buf); DO1(buf)
1345 #define DO4(buf) DO2(buf); DO2(buf)
1346 #define DO8(buf) DO4(buf); DO4(buf)
1347
1348 static int
Crc32Cmd(ClientData clientData,Tcl_Interp * interp,int argc,char ** argv)1349 Crc32Cmd(
1350 ClientData clientData,
1351 Tcl_Interp *interp,
1352 int argc, char **argv)
1353 {
1354 register unsigned int crc;
1355 char buf[200];
1356
1357 crc = 0L;
1358 crc = crc ^ 0xffffffffL;
1359 if (argc>1 && strcmp(argv[1], "-data") == 0) {
1360 register char *p;
1361
1362 if (argc != 3) {
1363 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1364 " ?fileName? ?-data dataString?", (char *)NULL);
1365 return TCL_ERROR;
1366 }
1367 for (p = argv[2]; *p != '\0'; p++) {
1368 crc = CRC32(crc, *p);
1369 }
1370 } else {
1371 register int c;
1372 FILE *f;
1373
1374 if (argc != 2) {
1375 Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
1376 " ?fileName? ?-data dataString?", (char *)NULL);
1377 return TCL_ERROR;
1378 }
1379 f = fopen(argv[1], "rb");
1380 if (f == NULL) {
1381 Tcl_AppendResult(interp, "can't open file \"", argv[1], "\": ",
1382 Tcl_PosixError(interp), (char *)NULL);
1383 return TCL_ERROR;
1384 }
1385 while((c = getc(f)) != EOF) {
1386 crc = CRC32(crc, c);
1387 }
1388 fclose(f);
1389 }
1390 crc = crc ^ 0xffffffffL;
1391 sprintf(buf, "%x", crc);
1392 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1393 return TCL_OK;
1394 }
1395
1396 int
Blt_Crc32Init(interp)1397 Blt_Crc32Init(interp)
1398 Tcl_Interp *interp;
1399 {
1400 static Blt_CmdSpec cmdSpec = {"crc32", Crc32Cmd,};
1401
1402 if (Blt_InitCmd(interp, "blt", &cmdSpec) == NULL) {
1403 return TCL_ERROR;
1404 }
1405 return TCL_OK;
1406 }
1407
1408