summaryrefslogtreecommitdiffstats
path: root/src/corelib/concurrent/qfuture.h
blob: 02ae40a97c7ac89135695901e9a7d24e121b81a4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
/****************************************************************************
**
** Copyright (C) 2010 Nokia Corporation and/or its subsidiary(-ies).
** All rights reserved.
** Contact: Nokia Corporation (qt-info@nokia.com)
**
** This file is part of the QtCore module of the Qt Toolkit.
**
** $QT_BEGIN_LICENSE:LGPL$
** No Commercial Usage
** This file contains pre-release code and may not be distributed.
** You may use this file in accordance with the terms and conditions
** contained in the Technology Preview License Agreement accompanying
** this package.
**
** GNU Lesser General Public License Usage
** Alternatively, this file may be used under the terms of the GNU Lesser
** General Public License version 2.1 as published by the Free Software
** Foundation and appearing in the file LICENSE.LGPL included in the
** packaging of this file.  Please review the following information to
** ensure the GNU Lesser General Public License version 2.1 requirements
** will be met: http://www.gnu.org/licenses/old-licenses/lgpl-2.1.html.
**
** In addition, as a special exception, Nokia gives you certain additional
** rights.  These rights are described in the Nokia Qt LGPL Exception
** version 1.1, included in the file LGPL_EXCEPTION.txt in this package.
**
** If you have questions regarding the use of this file, please contact
** Nokia at qt-info@nokia.com.
**
**
**
**
**
**
**
**
** $QT_END_LICENSE$
**
****************************************************************************/

#ifndef QFUTURE_H
#define QFUTURE_H

#include <QtCore/qglobal.h>

#ifndef QT_NO_QFUTURE

#include <QtCore/qfutureinterface.h>
#include <QtCore/qstring.h>
#include <QtCore/qtconcurrentcompilertest.h>

QT_BEGIN_HEADER
QT_BEGIN_NAMESPACE

QT_MODULE(Core)

template <typename T>
class QFutureWatcher;
template <>
class QFutureWatcher<void>;

template <typename T>
class QFuture
{
public:
    QFuture()
        : d(QFutureInterface<T>::canceledResult())
    { }
    explicit QFuture(QFutureInterface<T> *p) // internal
        : d(*p)
    { }
    QFuture(const QFuture &other)
        : d(other.d)
    { }
    ~QFuture()
    { }

    inline QFuture &operator=(const QFuture &other);
    bool operator==(const QFuture &other) const { return (d == other.d); }
    bool operator!=(const QFuture &other) const { return (d != other.d); }

    void cancel() { d.cancel(); }
    bool isCanceled() const { return d.isCanceled(); }

    void setPaused(bool paused) { d.setPaused(paused); }
    bool isPaused() const { return d.isPaused(); }
    void pause() { setPaused(true); }
    void resume() { setPaused(false); }
    void togglePaused() { d.togglePaused(); }

    bool isStarted() const { return d.isStarted(); }
    bool isFinished() const { return d.isFinished(); }
    bool isRunning() const { return d.isRunning(); }

    int resultCount() const { return d.resultCount(); }
    int progressValue() const { return d.progressValue(); }
    int progressMinimum() const { return d.progressMinimum(); }
    int progressMaximum() const { return d.progressMaximum(); }
    QString progressText() const { return d.progressText(); }
    void waitForFinished() { d.waitForFinished(); }

    inline T result() const;
    inline T resultAt(int index) const;
    bool isResultReadyAt(int resultIndex) const { return d.isResultReadyAt(resultIndex); }

    operator T() const { return result(); }
    QList<T> results() const { return d.results(); }

    class const_iterator
    {
    public:
        typedef std::bidirectional_iterator_tag iterator_category;
        typedef qptrdiff difference_type;
        typedef T value_type;
        typedef const T *pointer;
        typedef const T &reference;

        inline const_iterator() {}
        inline const_iterator(QFuture const * const _future, int _index) : future(_future), index(_index) {}
        inline const_iterator(const const_iterator &o) : future(o.future), index(o.index)  {}
        inline const_iterator &operator=(const const_iterator &o)
        { future = o.future; index = o.index; return *this; }
        inline const T &operator*() const { return future->d.resultReference(index); }
        inline const T *operator->() const { return future->d.resultPointer(index); }

        inline bool operator!=(const const_iterator &other) const
        {
            if (index == -1 && other.index == -1) // comparing end != end?
                return false;
            if (other.index == -1)
                return (future->isRunning() || (index < future->resultCount()));
            return (index != other.index);
        }

        inline bool operator==(const const_iterator &o) const { return !operator!=(o); }
        inline const_iterator &operator++() { ++index; return *this; }
        inline const_iterator operator++(int) { const_iterator r = *this; ++index; return r; }
        inline const_iterator &operator--() { --index; return *this; }
        inline const_iterator operator--(int) { const_iterator r = *this; --index; return r; }
        inline const_iterator operator+(int j) const { return const_iterator(future, index + j); }
        inline const_iterator operator-(int j) const { return const_iterator(future, index - j); }
        inline const_iterator &operator+=(int j) { index += j; return *this; }
        inline const_iterator &operator-=(int j) { index -= j; return *this; }
    private:
        QFuture const * future;
        int index;
    };
    friend class const_iterator;
    typedef const_iterator ConstIterator;

    const_iterator begin() const { return  const_iterator(this, 0); }
    const_iterator constBegin() const { return  const_iterator(this, 0); }
    const_iterator end() const { return const_iterator(this, -1); }
    const_iterator constEnd() const { return const_iterator(this, -1); }

private:
    friend class QFutureWatcher<T>;

public: // Warning: the d pointer is not documented and is considered private.
    mutable QFutureInterface<T> d;
};

template <typename T>
inline QFuture<T> &QFuture<T>::operator=(const QFuture<T> &other)
{
    d = other.d;
    return *this;
}

template <typename T>
inline T QFuture<T>::result() const
{
    d.waitForResult(0);
    return d.resultReference(0);
}

template <typename T>
inline T QFuture<T>::resultAt(int index) const
{
    d.waitForResult(index);
    return d.resultReference(index);
}

template <typename T>
inline QFuture<T> QFutureInterface<T>::future()
{
    return QFuture<T>(this);
}

Q_DECLARE_SEQUENTIAL_ITERATOR(Future)

template <>
class QFuture<void>
{
public:
    QFuture()
        : d(QFutureInterface<void>::canceledResult())
    { }
    explicit QFuture(QFutureInterfaceBase *p) // internal
        : d(*p)
    { }
    QFuture(const QFuture &other)
        : d(other.d)
    { }
    ~QFuture()
    { }

    QFuture &operator=(const QFuture &other);
    bool operator==(const QFuture &other) const { return (d == other.d); }
    bool operator!=(const QFuture &other) const { return (d != other.d); }

#if !defined(QT_NO_MEMBER_TEMPLATES) && !defined(Q_CC_XLC)
    template <typename T>
    QFuture(const QFuture<T> &other)
        : d(other.d)
    { }

    template <typename T>
    QFuture<void> &operator=(const QFuture<T> &other)
    {
        d = other.d;
        return *this;
    }
#endif

    void cancel() { d.cancel(); }
    bool isCanceled() const { return d.isCanceled(); }

    void setPaused(bool paused) { d.setPaused(paused); }
    bool isPaused() const { return d.isPaused(); }
    void pause() { setPaused(true); }
    void resume() { setPaused(false); }
    void togglePaused() { d.togglePaused(); }

    bool isStarted() const { return d.isStarted(); }
    bool isFinished() const { return d.isFinished(); }
    bool isRunning() const { return d.isRunning(); }

    int resultCount() const { return d.resultCount(); }
    int progressValue() const { return d.progressValue(); }
    int progressMinimum() const { return d.progressMinimum(); }
    int progressMaximum() const { return d.progressMaximum(); }
    QString progressText() const { return d.progressText(); }
    void waitForFinished() { d.waitForFinished(); }

private:
    friend class QFutureWatcher<void>;

#ifdef QFUTURE_TEST
public:
#endif
    mutable QFutureInterfaceBase d;
};

inline QFuture<void> &QFuture<void>::operator=(const QFuture<void> &other)
{
    d = other.d;
    return *this;
}

inline QFuture<void> QFutureInterface<void>::future()
{
    return QFuture<void>(this);
}

template <typename T>
QFuture<void> qToVoidFuture(const QFuture<T> &future)
{
    return QFuture<void>(future.d);
}

QT_END_NAMESPACE
QT_END_HEADER

#endif // QT_NO_CONCURRENT

#endif // QFUTURE_H
char buffer[32 + TCL_INTEGER_SPACE]; int savedStackDepth = envPtr->currStackDepth; - /* * We parse the variable list argument words and create two arrays: * varcList[i] is number of variables in i-th var list @@ -775,7 +771,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) numLists = (numWords - 2)/2; if (numLists > STATIC_VAR_LIST_SIZE) { varcList = (int *) ckalloc(numLists * sizeof(int)); - varvList = (CONST char ***) ckalloc(numLists * sizeof(char **)); + varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **)); } for (loopIndex = 0; loopIndex < numLists; loopIndex++) { varcList[loopIndex] = 0; @@ -804,32 +800,29 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { code = TCL_OUT_LINE_COMPILE; goto done; - } - varList = tokenPtr[1].start; - savedChar = varList[tokenPtr[1].size]; + } else { + /* Lots of copying going on here. Need a ListObj wizard + * to show a better way. */ - /* - * Note there is a danger that modifying the string could have - * undesirable side effects. In this case, Tcl_SplitList does - * not have any dependencies on shared strings so we should be - * safe. - */ + Tcl_DString varList; - varList[tokenPtr[1].size] = '\0'; - code = Tcl_SplitList(interp, varList, - &varcList[loopIndex], &varvList[loopIndex]); - varList[tokenPtr[1].size] = savedChar; - if (code != TCL_OK) { - goto done; - } - - numVars = varcList[loopIndex]; - for (j = 0; j < numVars; j++) { - CONST char *varName = varvList[loopIndex][j]; - if (!TclIsLocalScalar(varName, (int) strlen(varName))) { - code = TCL_OUT_LINE_COMPILE; + Tcl_DStringInit(&varList); + Tcl_DStringAppend(&varList, tokenPtr[1].start, + tokenPtr[1].size); + code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), + &varcList[loopIndex], &varvList[loopIndex]); + Tcl_DStringFree(&varList); + if (code != TCL_OK) { goto done; } + numVars = varcList[loopIndex]; + for (j = 0; j < numVars; j++) { + CONST char *varName = varvList[loopIndex][j]; + if (!TclIsLocalScalar(varName, (int) strlen(varName))) { + code = TCL_OUT_LINE_COMPILE; + goto done; + } + } } loopIndex++; } @@ -1004,14 +997,14 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) */ envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); envPtr->currStackDepth = savedStackDepth + 1; done: for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - if (varvList[loopIndex] != NULL) { - ckfree((char *) varvList[loopIndex]); - } + if (varvList[loopIndex] != (CONST char **) NULL) { + ckfree((char *) varvList[loopIndex]); + } } if (varcList != varcListStaticSpace) { ckfree((char *) varcList); @@ -1149,13 +1142,12 @@ TclCompileIfCmd(interp, parsePtr, envPtr) int jumpDist, jumpFalseDist; int jumpIndex = 0; /* avoid compiler warning. */ int numWords, wordIdx, numBytes, j, code; - char *word; + CONST char *word; char buffer[100]; int savedStackDepth = envPtr->currStackDepth; /* Saved stack depth at the start of the first * test; the envPtr current depth is restored * to this value at the start of each test. */ - char *condStart, *savedPos, savedChar; int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */ int boolVal; /* value of static condition */ int compileScripts = 1; @@ -1226,31 +1218,20 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * Find out if the condition is a constant. */ - condStart = testTokenPtr[1].start; - savedPos = condStart + testTokenPtr[1].size - 1; - - while (*condStart == ' ') { - condStart++; - } - while (*savedPos == ' ') { - savedPos--; - } - savedPos++; - - savedChar = *savedPos; - *savedPos = '\0'; - - if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) { + Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start, + testTokenPtr[1].size); + Tcl_IncrRefCount(boolObj); + code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); + Tcl_DecrRefCount(boolObj); + if (code == TCL_OK) { /* * A static condition */ - *savedPos = savedChar; realCond = 0; if (!boolVal) { compileScripts = 0; } } else { - *savedPos = savedChar; Tcl_ResetResult(interp); code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (code != TCL_OK) { @@ -1438,7 +1419,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) */ if (compileScripts) { - TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } } @@ -1546,9 +1527,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) if (parsePtr->numWords == 3) { incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - char *word = incrTokenPtr[1].start; + CONST char *word = incrTokenPtr[1].start; int numBytes = incrTokenPtr[1].size; - char savedChar = word[numBytes]; + int validLength = TclParseInteger(word, numBytes); long n; /* @@ -1558,18 +1539,20 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) * should be safe. */ - word[numBytes] = '\0'; - if (TclLooksLikeInt(word, numBytes) - && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) { - if ((-127 <= n) && (n <= 127)) { + if (validLength == numBytes) { + int code; + Tcl_Obj *longObj = Tcl_NewStringObj(word, numBytes); + Tcl_IncrRefCount(longObj); + code = Tcl_GetLongFromObj(NULL, longObj, &n); + Tcl_DecrRefCount(longObj); + if ((code == TCL_OK) && (-127 <= n) && (n <= 127)) { haveImmValue = 1; immValue = n; } } - word[numBytes] = savedChar; if (!haveImmValue) { - TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes, - /*onHeap*/ 0), envPtr); + TclEmitPush( + TclRegisterNewLiteral(envPtr, word, numBytes), envPtr); } } else { code = TclCompileTokens(interp, incrTokenPtr+1, @@ -1716,8 +1699,8 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) if (numWords > 2) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start, - valueTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -1732,7 +1715,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * always creates the variable. */ - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); numValues = 1; #endif } @@ -1826,11 +1809,9 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) for ( i = 1 ; i < numWords ; i++ ) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush( TclRegisterLiteral( envPtr, - varTokenPtr[1].start, - varTokenPtr[1].size, - 0), - envPtr); + TclEmitPush( + TclRegisterNewLiteral( envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -1897,7 +1878,7 @@ TclCompileListCmd(interp, parsePtr, envPtr) * Empty args case */ - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } else { /* * Push the all values onto the stack. @@ -1911,9 +1892,8 @@ TclCompileListCmd(interp, parsePtr, envPtr) + (parsePtr->tokenPtr->numComponents + 1); for (i = 1; i < numWords; i++) { if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - valueTokenPtr[1].start, valueTokenPtr[1].size, - /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -1973,8 +1953,8 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) * We could simply count the number of elements here and push * that value, but that is too rare a case to waste the code space. */ - TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start, - varTokenPtr[1].size, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2085,11 +2065,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr ) /* Push an arg */ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush( TclRegisterLiteral( envPtr, - varTokenPtr[1].start, - varTokenPtr[1].size, - 0), - envPtr); + TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { result = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2219,7 +2196,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing * the parse of the RE or string */ int i, len, code, exactMatch, nocase; - char c, *str; + Tcl_Obj *patternObj; + CONST char *str; /* * We are only interested in compiling simple regexp cases. @@ -2279,7 +2257,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) /* * The semantics of regexp are always match on re == "". */ - TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); return TCL_OK; } @@ -2317,16 +2295,17 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) } else { exactMatch = 0; } - c = str[len]; - str[len] = '\0'; - if (strpbrk(str, "*+?{}()[].\\|^$") != NULL) { - str[len] = c; + + patternObj = Tcl_NewStringObj(str, len); + Tcl_IncrRefCount(patternObj); + code = (strpbrk(Tcl_GetString(patternObj), "*+?{}()[].\\|^$") != NULL); + Tcl_DecrRefCount(patternObj); + if (code) { /* We don't do anything with REs with special chars yet. */ return TCL_OUT_LINE_COMPILE; } - str[len] = c; if (exactMatch) { - TclEmitPush(TclRegisterLiteral(envPtr, str, len, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, str, len), envPtr); } else { /* * This needs to find the substring anywhere in the string, so @@ -2337,7 +2316,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) strncpy(newStr + 1, str, (size_t) len); newStr[len+1] = '*'; newStr[len+2] = '\0'; - TclEmitPush(TclRegisterLiteral(envPtr, newStr, len+2, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len+2), envPtr); ckfree((char *) newStr); } @@ -2346,8 +2325,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) */ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - varTokenPtr[1].start, varTokenPtr[1].size, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2412,7 +2391,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) * Simple case: [return] * Just push the literal string "". */ - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); break; } case 2: { @@ -2429,8 +2408,8 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) * [return "foo"] case: the parse token is a simple word, * so just push it. */ - TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start, - varTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { /* * Parse token is more complex, so compile it; this handles the @@ -2532,8 +2511,8 @@ TclCompileSetCmd(interp, parsePtr, envPtr) if (isAssignment) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start, - valueTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start, + valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -2695,9 +2674,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr) for (i = 0; i < 2; i++) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - varTokenPtr[1].start, varTokenPtr[1].size, - 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2726,9 +2704,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr) for (i = 0; i < 2; i++) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - varTokenPtr[1].start, varTokenPtr[1].size, - 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2757,7 +2734,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) int len = Tcl_NumUtfChars(varTokenPtr[1].start, varTokenPtr[1].size); len = sprintf(buf, "%d", len); - TclEmitPush(TclRegisterLiteral(envPtr, buf, len, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr); return TCL_OK; } else { code = TclCompileTokens(interp, varTokenPtr+1, @@ -2771,7 +2748,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) } case STR_MATCH: { int i, length, exactMatch = 0, nocase = 0; - char c, *str; + CONST char *str; if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { /* Fail at run time, not in compilation */ @@ -2803,18 +2780,19 @@ TclCompileStringCmd(interp, parsePtr, envPtr) * On the first (pattern) arg, check to see if any * glob special characters are in the word '*[]?\\'. * If not, this is the same as 'string equal'. We - * can use strchr here because the glob chars are all + * can use strpbrk here because the glob chars are all * in the ascii-7 range. If -nocase was specified, * we can't do this because INST_STR_EQ has no support * for nocase. */ - c = str[length]; - str[length] = '\0'; - exactMatch = (strpbrk(str, "*[]?\\") == NULL); - str[length] = c; + Tcl_Obj *copy = Tcl_NewStringObj(str, length); + Tcl_IncrRefCount(copy); + exactMatch = (strpbrk(Tcl_GetString(copy), + "*[]?\\") == NULL); + Tcl_DecrRefCount(copy); } - TclEmitPush(TclRegisterLiteral(envPtr, str, length, - 0), envPtr); + TclEmitPush( + TclRegisterNewLiteral(envPtr, str, length), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2862,7 +2840,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) { Tcl_Token *varTokenPtr; int i, numWords; - char *varName, *tail; + CONST char *varName, *tail; if (envPtr->procPtr == NULL) { return TCL_OUT_LINE_COMPILE; @@ -2929,9 +2907,8 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) int savedStackDepth = envPtr->currStackDepth; int loopMayEnd = 1; /* This is set to 0 if it is recognized as * an infinite loop. */ + Tcl_Obj *boolObj; int boolVal; - char *condStart; - char savedChar, *savedPos; if (parsePtr->numWords != 3) { Tcl_ResetResult(interp); @@ -2961,21 +2938,11 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * Find out if the condition is a constant. */ - condStart = testTokenPtr[1].start; - savedPos = condStart + testTokenPtr[1].size - 1; - - while (*condStart == ' ') { - condStart++; - } - while (*savedPos == ' ') { - savedPos--; - } - savedPos++; - - savedChar = *savedPos; - *savedPos = '\0'; - - if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) { + boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size); + Tcl_IncrRefCount(boolObj); + code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); + Tcl_DecrRefCount(boolObj); + if (code == TCL_OK) { if (boolVal) { /* * it is an infinite loop @@ -2988,14 +2955,10 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * Compile no bytecodes. */ - *savedPos = savedChar; goto pushResult; } - } else { - Tcl_ResetResult(interp); } - *savedPos = savedChar; - + /* * Create a ExceptionRange record for the loop body. This is used to * implement break and continue. @@ -3102,7 +3065,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) pushResult: envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); envPtr->exceptDepth--; return TCL_OK; @@ -3145,11 +3108,14 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, { Tcl_Parse elemParse; int gotElemParse = 0; - register char *p; - char *name, *elName; + register CONST char *p; + CONST char *name, *elName; register int i, n; int nameChars, elNameChars, simpleVarName, localIndex; int code = TCL_OK; + Tcl_DString copy; + + Tcl_DStringInit(©); /* * Decide if we can use a frame slot for the var/array name or if we @@ -3273,8 +3239,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } } if (localIndex < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars, - /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr); } /* @@ -3285,13 +3250,11 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, /* * Temporarily replace the '(' and ')' by '"'s. */ - - *(elName-1) = '"'; - *(elName+elNameChars) = '"'; - code = Tcl_ParseCommand(interp, elName-1, elNameChars+2, - /*nested*/ 0, &elemParse); - *(elName-1) = '('; - *(elName+elNameChars) = ')'; + Tcl_DStringAppend(©, "\"", 1); + Tcl_DStringAppend(©, elName, elNameChars); + Tcl_DStringAppend(©, "\"", 1); + code = Tcl_ParseCommand(interp, Tcl_DStringValue(©), + elNameChars+2, /*nested*/ 0, &elemParse); gotElemParse = 1; if ((code != TCL_OK) || (elemParse.numWords > 1)) { char buffer[160]; @@ -3307,8 +3270,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, goto done; } } else { - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, - /*alreadyAlloced*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } } } else { @@ -3327,6 +3289,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, if (gotElemParse) { Tcl_FreeParse(&elemParse); } + Tcl_DStringFree(©); *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; *isScalarPtr = (elName == NULL); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index e51aa15..8d74efa 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompExpr.c,v 1.11 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.12 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -51,9 +51,9 @@ typedef struct ExprInfo { Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Parse *parsePtr; /* Structure filled with information about * the parsed expression. */ - char *expr; /* The expression that was originally passed + CONST char *expr; /* The expression that was originally passed * to TclCompileExpr. */ - char *lastChar; /* Points just after last byte of expr. */ + CONST char *lastChar; /* Points just after last byte of expr. */ int hasOperators; /* Set 1 if the expr has operators; 0 if * expr is only a primary. If 1 after * compiling an expr, a tryCvtToNumeric @@ -156,7 +156,7 @@ static int CompileLandOrLorExpr _ANSI_ARGS_(( ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileMathFuncCall _ANSI_ARGS_(( - Tcl_Token *exprTokenPtr, char *funcName, + Tcl_Token *exprTokenPtr, CONST char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileSubExpr _ANSI_ARGS_(( @@ -203,7 +203,7 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); int TclCompileExpr(interp, script, numBytes, envPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *script; /* The source script to compile. */ + CONST char *script; /* The source script to compile. */ int numBytes; /* Number of bytes in script. If < 0, the * string consists of all bytes up to the * first null character. */ @@ -343,8 +343,8 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr; OperatorDesc *opDescPtr; Tcl_HashEntry *hPtr; - char *operator; - char savedChar; + CONST char *operator; + Tcl_DString opBuf; int objIndex, opIndex, length, code; char buffer[TCL_UTF_MAX]; @@ -375,10 +375,10 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) case TCL_TOKEN_TEXT: if (tokenPtr->size > 0) { - objIndex = TclRegisterLiteral(envPtr, tokenPtr->start, - tokenPtr->size, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, + tokenPtr->size); } else { - objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, "", 0); } TclEmitPush(objIndex, envPtr); tokenPtr += 1; @@ -388,10 +388,9 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer); if (length > 0) { - objIndex = TclRegisterLiteral(envPtr, buffer, length, - /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, buffer, length); } else { - objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, "", 0); } TclEmitPush(objIndex, envPtr); tokenPtr += 1; @@ -424,33 +423,24 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) case TCL_TOKEN_OPERATOR: /* - * Look up the operator. Temporarily overwrite the character - * just after the end of the operator with a 0 byte. If the - * operator isn't found, treat it as a math function. + * Look up the operator. If the operator isn't found, treat it + * as a math function. */ - - /* - * TODO: Note that the string is modified in place. This is unsafe - * and will break if any of the routines called while the string is - * modified have side effects that depend on the original string - * being unmodified (e.g. adding an entry to the literal table). - */ - - operator = tokenPtr->start; - savedChar = operator[tokenPtr->size]; - operator[tokenPtr->size] = 0; + Tcl_DStringInit(&opBuf); + operator = Tcl_DStringAppend(&opBuf, + tokenPtr->start, tokenPtr->size); hPtr = Tcl_FindHashEntry(&opHashTable, operator); if (hPtr == NULL) { code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, envPtr, &endPtr); - operator[tokenPtr->size] = (char) savedChar; + Tcl_DStringFree(&opBuf); if (code != TCL_OK) { goto done; } tokenPtr = endPtr; break; } - operator[tokenPtr->size] = (char) savedChar; + Tcl_DStringFree(&opBuf); opIndex = (int) Tcl_GetHashValue(hPtr); opDescPtr = &(operatorTable[opIndex]); @@ -627,7 +617,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) */ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); - TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup); dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) { @@ -635,7 +625,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) panic("CompileLandOrLorExpr: bad jump distance %d\n", dist); } envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { goto badDist; @@ -836,7 +826,7 @@ static int CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * containing the math function call. */ - char *funcName; /* Name of the math function. */ + CONST char *funcName; /* Name of the math function. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ @@ -870,8 +860,7 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) */ if (mathFuncPtr->builtinFuncIndex < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0), - envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index dc2aa25..75f253e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.39 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.40 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -292,7 +292,8 @@ static void FreeByteCodeInternalRep _ANSI_ARGS_(( static int GetCmdLocEncodingSize _ANSI_ARGS_(( CompileEnv *envPtr)); static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp, - char *script, char *command, int length)); + CONST char *script, CONST char *command, + int length)); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats _ANSI_ARGS_(( ByteCode *codePtr)); @@ -798,7 +799,7 @@ TclFreeCompileEnv(envPtr) int TclCompileScript(interp, script, numBytes, nested, envPtr) Tcl_Interp *interp; /* Used for error and status reporting. */ - char *script; /* The source script to compile. */ + CONST char *script; /* The source script to compile. */ int numBytes; /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ @@ -817,7 +818,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) int startCodeOffset = -1; /* Offset of first byte of current command's * code. Init. to avoid compiler warning. */ unsigned char *entryCodeNext = envPtr->codeNext; - char *p, *next; + CONST char *p, *next; Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; @@ -972,18 +973,16 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) * reduce runtime lookups. */ - objIndex = TclRegisterLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size, - /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); if (cmdPtr != NULL) { TclSetCmdNameObj(interp, envPtr->literalArrayPtr[objIndex].objPtr, cmdPtr); } } else { - objIndex = TclRegisterLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size, - /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); } TclEmitPush(objIndex, envPtr); } else { @@ -1127,7 +1126,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr) Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX]; - char *name, *p; + CONST char *name, *p; int numObjsToConcat, nameBytes, localVarName, localVar; int length, i, code; unsigned char *entryCodeNext = envPtr->codeNext; @@ -1225,8 +1224,8 @@ TclCompileTokens(interp, tokenPtr, count, envPtr) localVarName, /*flags*/ 0, envPtr->procPtr); } if (localVar < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, name, - nameBytes, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), + envPtr); } /* @@ -1406,7 +1405,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr) { Tcl_Token *wordPtr; int range, numBytes, i, code; - char *script; + CONST char *script; range = -1; code = TCL_OK; @@ -1639,15 +1638,15 @@ static void LogCompilationInfo(interp, script, command, length) Tcl_Interp *interp; /* Interpreter in which to log the * information. */ - char *script; /* First character in script containing + CONST char *script; /* First character in script containing * command (must be <= command). */ - char *command; /* First character in command that + CONST char *command; /* First character in command that * generated the error. */ int length; /* Number of bytes in command (-1 means * use all bytes up to first null byte). */ { char buffer[200]; - register char *p; + register CONST char *p; char *ellipsis = ""; Interp *iPtr = (Interp *) interp; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index e6c2740..88fe81d 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.29 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.30 2002/08/05 03:24:40 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -724,7 +724,7 @@ extern AuxDataType tclForeachInfoType; */ EXTERN int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], char *command, int length, + Tcl_Obj *CONST objv[], CONST char *command, int length, int flags)); EXTERN int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp)); @@ -750,13 +750,13 @@ EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr)); EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int numBytes, + CONST char *script, int numBytes, CompileEnv *envPtr)); EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr)); EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int numBytes, int nested, + CONST char *script, int numBytes, int nested, CompileEnv *envPtr)); EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, @@ -836,6 +836,15 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( */ /* + * Form of TclRegisterLiteral with onHeap == 0. + * In that case, it is safe to cast away CONSTness, and it + * is cleanest to do that here, all in one place. + */ + +#define TclRegisterNewLiteral(envPtr, bytes, length) \ + TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0) + +/* * Macro used to update the stack requirements. * It is called by the macros TclEmitOpCode, TclEmitInst1 and * TclEmitInst4. diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 19687a3..a0a8b4b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDecls.h,v 1.91 2002/07/22 16:51:48 vincentdarley Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.92 2002/08/05 03:24:40 dgp Exp $ */ #ifndef _TCLDECLS @@ -31,9 +31,10 @@ EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 1 */ -EXTERN CONST char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * name, CONST char * version, - int exact, ClientData * clientDataPtr)); +EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * name, + CONST char * version, int exact, + ClientData * clientDataPtr)); /* 2 */ EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 3 */ @@ -271,9 +272,9 @@ EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_(( EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 82 */ -EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char * cmd)); +EXTERN int Tcl_CommandComplete _ANSI_ARGS_((CONST char * cmd)); /* 83 */ -EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, +EXTERN CONST84_RETURN char * Tcl_Concat _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 84 */ EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src, @@ -286,7 +287,7 @@ EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_(( EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, - char * CONST * argv)); + CONST84 char * CONST * argv)); /* 87 */ EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, @@ -430,12 +431,12 @@ EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_(( /* 126 */ EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan)); /* 127 */ -EXTERN CONST char * Tcl_ErrnoId _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void)); /* 128 */ -EXTERN CONST char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); +EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); /* 129 */ EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp, - char * string)); + CONST char * string)); /* 130 */ EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); @@ -493,7 +494,7 @@ EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, - char *** argvPtr)); + CONST84 char *** argvPtr)); /* 149 */ EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, @@ -519,7 +520,8 @@ EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_(( /* 155 */ EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ -EXTERN CONST char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan)); +EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_(( + Tcl_Channel chan)); /* 157 */ EXTERN int Tcl_GetChannelOption _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan, @@ -530,12 +532,12 @@ EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan)); EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 160 */ -EXTERN CONST char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Command command)); +EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Command command)); /* 161 */ EXTERN int Tcl_GetErrno _ANSI_ARGS_((void)); /* 162 */ -EXTERN CONST char * Tcl_GetHostName _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void)); /* 163 */ EXTERN int Tcl_GetInterpPath _ANSI_ARGS_(( Tcl_Interp * askInterp, @@ -568,16 +570,18 @@ EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp, /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type)); /* 174 */ -EXTERN CONST char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_(( + Tcl_Interp * interp)); /* 175 */ -EXTERN CONST char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags)); +EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * varName, int flags)); /* 176 */ -EXTERN CONST char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags)); +EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * part1, CONST char * part2, + int flags)); /* 177 */ EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp, - char * command)); + CONST char * command)); /* 178 */ EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); @@ -604,7 +608,7 @@ EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc, Tcl_DString * resultPtr)); /* 187 */ EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, char * addr, int type)); + CONST char * varName, char * addr, int type)); /* Slot 188 is reserved */ /* 189 */ EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle, @@ -664,7 +668,7 @@ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp, /* 203 */ EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string)); /* 204 */ -EXTERN CONST char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp)); /* 205 */ EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); @@ -767,17 +771,17 @@ EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 237 */ -EXTERN CONST char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, CONST char * newValue, +EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * varName, CONST char * newValue, int flags)); /* 238 */ -EXTERN CONST char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, +EXTERN CONST84_RETURN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 239 */ -EXTERN CONST char * Tcl_SignalId _ANSI_ARGS_((int sig)); +EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig)); /* 240 */ -EXTERN CONST char * Tcl_SignalMsg _ANSI_ARGS_((int sig)); +EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig)); /* 241 */ EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp)); /* 242 */ @@ -799,13 +803,13 @@ EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str, EXTERN int Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan)); /* 247 */ EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags, + CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - Tcl_VarTraceProc * proc, + CONST char * part1, CONST char * part2, + int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 249 */ EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_(( @@ -816,49 +820,50 @@ EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, CONST char * str, int len, int atHead)); /* 251 */ EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName)); + CONST char * varName)); /* 252 */ EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan)); /* 253 */ EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags)); + CONST char * varName, int flags)); /* 254 */ EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags)); + CONST char * part1, CONST char * part2, + int flags)); /* 255 */ EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags, + CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - Tcl_VarTraceProc * proc, + CONST char * part1, CONST char * part2, + int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 257 */ EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName)); + CONST char * varName)); /* 258 */ EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * frameName, char * varName, + CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 259 */ EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * frameName, char * part1, + CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 260 */ EXTERN int Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 261 */ EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags, + CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - Tcl_VarTraceProc * procPtr, + CONST char * part1, CONST char * part2, + int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 263 */ EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, @@ -880,23 +885,25 @@ EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_(( Tcl_Obj * objPtr, va_list argList)); /* 269 */ -EXTERN CONST char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr)); +EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_(( + Tcl_HashTable * tablePtr)); /* 270 */ -EXTERN CONST char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, - char * str, char ** termPtr)); +EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * str, CONST84 char ** termPtr)); /* 271 */ -EXTERN CONST char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 272 */ -EXTERN CONST char * Tcl_PkgPresentEx _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * name, CONST char * version, - int exact, ClientData * clientDataPtr)); +EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * name, + CONST char * version, int exact, + ClientData * clientDataPtr)); /* 273 */ EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 274 */ -EXTERN CONST char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 275 */ @@ -946,7 +953,7 @@ EXTERN void Tcl_DiscardResult _ANSI_ARGS_(( Tcl_SavedResult * statePtr)); /* 291 */ EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp, - char * script, int numBytes, int flags)); + CONST char * script, int numBytes, int flags)); /* 292 */ EXTERN int Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); @@ -979,7 +986,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void)); EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 302 */ -EXTERN CONST char * Tcl_GetEncodingName _ANSI_ARGS_(( +EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_(( Tcl_Encoding encoding)); /* 303 */ EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_(( @@ -994,7 +1001,8 @@ EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_(( Tcl_ThreadDataKey * keyPtr, int size)); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags)); + CONST char * part1, CONST char * part2, + int flags)); /* 307 */ EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void)); /* 308 */ @@ -1026,7 +1034,7 @@ EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_(( Tcl_Interp * interp, CONST char * name)); /* 317 */ EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, + CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 318 */ EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId)); @@ -1046,7 +1054,7 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch)); /* 324 */ EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf)); /* 325 */ -EXTERN CONST char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, int index)); /* 326 */ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, @@ -1055,15 +1063,15 @@ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 328 */ -EXTERN CONST char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ -EXTERN CONST char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src, int ch)); /* 330 */ -EXTERN CONST char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src)); +EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src)); /* 331 */ -EXTERN CONST char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 332 */ EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp, @@ -1094,7 +1102,7 @@ EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan, /* 340 */ EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 341 */ -EXTERN CONST char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void)); /* 342 */ EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_(( CONST char * path)); @@ -1144,25 +1152,25 @@ EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, int length)); /* 360 */ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, + CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, - char ** termPtr)); + CONST84 char ** termPtr)); /* 361 */ EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, int nested, - Tcl_Parse * parsePtr)); + CONST char * string, int numBytes, + int nested, Tcl_Parse * parsePtr)); /* 362 */ EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, + CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 363 */ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( - Tcl_Interp * interp, char * string, + Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, - int append, char ** termPtr)); + int append, CONST84 char ** termPtr)); /* 364 */ EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, + CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 365 */ EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp, @@ -1255,7 +1263,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */ EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan)); /* 398 */ -EXTERN CONST char * Tcl_ChannelName _ANSI_ARGS_(( +EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 399 */ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_(( @@ -1568,7 +1576,7 @@ typedef struct TclStubs { struct TclStubHooks *hooks; int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */ - CONST char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */ + CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */ void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */ char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */ void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */ @@ -1665,11 +1673,11 @@ typedef struct TclStubs { void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 79 */ void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc * idleProc, ClientData clientData)); /* 80 */ int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 81 */ - int (*tcl_CommandComplete) _ANSI_ARGS_((char * cmd)); /* 82 */ - char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */ + int (*tcl_CommandComplete) _ANSI_ARGS_((CONST char * cmd)); /* 82 */ + CONST84_RETURN char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */ int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 84 */ int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char * src, int length, char * dst, int flags)); /* 85 */ - int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, char * CONST * argv)); /* 86 */ + int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, CONST84 char * CONST * argv)); /* 86 */ int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */ Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, CONST char * chanName, ClientData instanceData, int mask)); /* 88 */ void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 89 */ @@ -1718,9 +1726,9 @@ typedef struct TclStubs { void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString * dsPtr, int length)); /* 124 */ void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 125 */ int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */ - CONST char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ - CONST char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ - int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 129 */ + CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ + CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ + int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 129 */ int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); /* 130 */ int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */ void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */ @@ -1739,7 +1747,7 @@ typedef struct TclStubs { Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */ int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */ void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 147 */ - int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 148 */ + int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, CONST84 char *** argvPtr)); /* 148 */ int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */ ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */ Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanName, int * modePtr)); /* 151 */ @@ -1747,13 +1755,13 @@ typedef struct TclStubs { int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 153 */ ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */ int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */ - CONST char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ + CONST84_RETURN char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, Tcl_DString * dsPtr)); /* 157 */ Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */ int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */ - CONST char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */ + CONST84_RETURN char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */ int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */ - CONST char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */ + CONST84_RETURN char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */ int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 163 */ Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp * interp)); /* 164 */ CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */ @@ -1773,10 +1781,10 @@ typedef struct TclStubs { int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */ Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveName)); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */ - CONST char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */ - CONST char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 175 */ - CONST char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 176 */ - int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 177 */ + CONST84_RETURN char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */ + CONST84_RETURN char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 175 */ + CONST84_RETURN char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 176 */ + int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command)); /* 177 */ int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 178 */ int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)); /* 179 */ int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 180 */ @@ -1786,7 +1794,7 @@ typedef struct TclStubs { int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp * interp)); /* 184 */ int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */ char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv, Tcl_DString * resultPtr)); /* 186 */ - int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* 187 */ + int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, char * addr, int type)); /* 187 */ void *reserved188; Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */ int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 190 */ @@ -1811,7 +1819,7 @@ typedef struct TclStubs { void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */ void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */ int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */ - CONST char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ + CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */ int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ @@ -1852,44 +1860,44 @@ typedef struct TclStubs { void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */ void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */ void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */ - CONST char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, CONST char * newValue, int flags)); /* 237 */ - CONST char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */ - CONST char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */ - CONST char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */ + CONST84_RETURN char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, CONST char * newValue, int flags)); /* 237 */ + CONST84_RETURN char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */ + CONST84_RETURN char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */ + CONST84_RETURN char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */ void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp)); /* 241 */ int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, CONST84 char *** argvPtr)); /* 242 */ void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, CONST84 char *** argvPtr)); /* 243 */ void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */ int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */ int (*tcl_TellOld) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */ - int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */ - int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ + int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */ + int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_DString * bufferPtr)); /* 249 */ int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, CONST char * str, int len, int atHead)); /* 250 */ - void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 251 */ + void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 251 */ int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 252 */ - int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 253 */ - int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 254 */ - void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */ - void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ - void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 257 */ - int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * varName, CONST char * localName, int flags)); /* 258 */ - int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */ + int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 253 */ + int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 254 */ + void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */ + void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ + void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 257 */ + int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 258 */ + int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */ int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */ - ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */ - ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ + ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */ + ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char * s, int slen)); /* 263 */ void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], CONST char * message)); /* 264 */ int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char * fileName)); /* 265 */ void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char * file, int line)); /* 266 */ void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */ void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */ - CONST char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ - CONST char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 270 */ - CONST char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ - CONST char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ + CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ + CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST84 char ** termPtr)); /* 270 */ + CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ + CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */ - CONST char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */ + CONST84_RETURN char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */ void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */ int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */ Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */ @@ -1906,7 +1914,7 @@ typedef struct TclStubs { void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 288 */ void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 289 */ void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult * statePtr)); /* 290 */ - int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, char * script, int numBytes, int flags)); /* 291 */ + int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, int numBytes, int flags)); /* 291 */ int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */ int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 293 */ void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */ @@ -1917,11 +1925,11 @@ typedef struct TclStubs { void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 301 */ - CONST char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */ + CONST84_RETURN char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */ void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 303 */ int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST VOID * tablePtr, int offset, CONST char * msg, int flags, int * indexPtr)); /* 304 */ VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, int size)); /* 305 */ - Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 306 */ + Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 306 */ ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */ void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 308 */ void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */ @@ -1932,7 +1940,7 @@ typedef struct TclStubs { void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */ void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */ int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 316 */ - Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */ + Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */ void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */ void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 319 */ Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 320 */ @@ -1940,13 +1948,13 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */ int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */ - CONST char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ + CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */ int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */ - CONST char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ - CONST char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ - CONST char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */ - CONST char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */ + CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ + CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ + CONST84_RETURN char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */ + CONST84_RETURN char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */ int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 332 */ char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 333 */ int (*tcl_UtfToLower) _ANSI_ARGS_((char * src)); /* 334 */ @@ -1956,7 +1964,7 @@ typedef struct TclStubs { int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */ int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */ char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */ - CONST char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */ + CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */ void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((CONST char * path)); /* 342 */ void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */ void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */ @@ -1975,11 +1983,11 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */ void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */ void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, CONST char * command, int length)); /* 359 */ - int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 360 */ - int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ - int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ - int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 363 */ - int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ + int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */ + int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ + int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ + int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */ + int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */ int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */ int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */ @@ -2013,7 +2021,7 @@ typedef struct TclStubs { int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */ int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */ - CONST char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */ + CONST84_RETURN char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */ diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 0f71547..6e3b106 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEnv.c,v 1.15 2002/06/06 17:37:55 das Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.16 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -46,8 +46,8 @@ char **environ = NULL; */ static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); static void ReplaceString _ANSI_ARGS_((CONST char *oldStr, char *newStr)); void TclSetEnv _ANSI_ARGS_((CONST char *name, @@ -520,7 +520,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter whose "env" variable is * being modified. */ - char *name1; /* Better be "env". */ + CONST char *name1; /* Better be "env". */ CONST char *name2; /* Name of variable being modified, or NULL * if whole array is being deleted (UTF-8). */ int flags; /* Indicates what's happening. */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 4f0ec61..27365a4 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.22 2002/05/14 09:44:43 vincentdarley Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.23 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -111,8 +111,8 @@ static void BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp)); static void HandleBgErrors _ANSI_ARGS_((ClientData clientData)); static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); /* *---------------------------------------------------------------------- @@ -222,7 +222,7 @@ HandleBgErrors(clientData) ClientData clientData; /* Pointer to ErrAssocData structure. */ { Tcl_Interp *interp; - char *argv[2]; + CONST char *argv[2]; int code; BgError *errPtr; ErrAssocData *assocPtr = (ErrAssocData *) clientData; @@ -1012,7 +1012,7 @@ static char * VwaitVarProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Pointer to integer to set to 1. */ Tcl_Interp *interp; /* Interpreter containing variable. */ - char *name1; /* Name of variable. */ + CONST char *name1; /* Name of variable. */ CONST char *name2; /* Second part of variable name. */ int flags; /* Information about what happened. */ { diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 63d47ad..5a91a50 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tclInt.decls,v 1.53 2002/07/17 18:21:54 msofer Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.54 2002/08/05 03:24:40 dgp Exp $ library tcl @@ -183,7 +183,7 @@ declare 42 generic { char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr) } declare 43 generic { - int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags) + int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) } declare 44 generic { int TclGuessPackageName(CONST char *fileName, Tcl_DString *bufPtr) @@ -216,11 +216,11 @@ declare 51 generic { int TclInterpInit(Tcl_Interp *interp) } declare 52 generic { - int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags) + int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) } declare 53 generic { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) + int argc, CONST84 char **argv) } declare 54 generic { int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, @@ -240,7 +240,7 @@ declare 55 generic { # int TclLooksLikeInt(char *p) # } declare 58 generic { - Var * TclLookupVar(Tcl_Interp *interp, char *part1, CONST char *part2, + Var * TclLookupVar(Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) } @@ -351,7 +351,7 @@ declare 81 generic { # } declare 88 generic { char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, - char *name1, CONST char *name2, int flags) + CONST char *name1, CONST char *name2, int flags) } declare 89 generic { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, @@ -374,7 +374,7 @@ declare 93 generic { } declare 94 generic { int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) + int argc, CONST84 char **argv) } # Replaced by Tcl_FSStat in 8.4: #declare 95 generic { @@ -536,7 +536,7 @@ declare 135 generic { # int TclpChdir(CONST char *dirName) #} declare 138 generic { - CONST char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) + CONST84_RETURN char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) } #declare 139 generic { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, @@ -548,7 +548,7 @@ declare 140 generic { } # This is used by TclX, but should otherwise be considered private declare 141 generic { - CONST char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) + CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 generic { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -614,13 +614,13 @@ declare 156 generic { int status) } declare 157 generic { - Var * TclVarTraceExists (Tcl_Interp *interp, char *varName) + Var * TclVarTraceExists (Tcl_Interp *interp, CONST char *varName) } declare 158 generic { void TclSetStartupScriptFileName(CONST char *filename) } declare 159 generic { - CONST char *TclGetStartupScriptFileName(void) + CONST84_RETURN char *TclGetStartupScriptFileName(void) } #declare 160 generic { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, @@ -676,12 +676,12 @@ declare 169 generic { int TclpUtfNcmp2(CONST char *s1, CONST char *s2, unsigned long n) } declare 170 generic { - int TclCheckInterpTraces (Tcl_Interp *interp, char *command, int numChars, \ + int TclCheckInterpTraces (Tcl_Interp *interp, CONST char *command, int numChars, \ Command *cmdPtr, int result, int traceFlags, int objc, \ Tcl_Obj *CONST objv[]) } declare 171 generic { - int TclCheckExecutionTraces (Tcl_Interp *interp, char *command, int numChars, \ + int TclCheckExecutionTraces (Tcl_Interp *interp, CONST char *command, int numChars, \ Command *cmdPtr, int result, int traceFlags, int objc, \ Tcl_Obj *CONST objv[]) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 9632bdd..9193564 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.109 2002/07/31 14:57:09 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.110 2002/08/05 03:24:41 dgp Exp $ */ #ifndef _TCLINT @@ -1594,10 +1594,8 @@ typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp, *---------------------------------------------------------------- */ -typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char *argv[])); -typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[])); +typedef Tcl_CmdProc *TclCmdProcType; +typedef Tcl_ObjCmdProc *TclObjCmdProcType; /* *---------------------------------------------------------------- @@ -1738,6 +1736,14 @@ EXTERN Tcl_Obj * TclLsetFlat _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *CONST indexArray[], Tcl_Obj* valuePtr )); +EXTERN int TclParseBackslash _ANSI_ARGS_((CONST char *src, + int numBytes, int *readPtr, char *dst)); +EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes, + Tcl_UniChar *resultPtr)); +EXTERN int TclParseInteger _ANSI_ARGS_((CONST char *string, + int numBytes)); +EXTERN int TclParseWhiteSpace _ANSI_ARGS_((CONST char *src, + int numBytes, Tcl_Parse *parsePtr, char *typePtr)); EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename, int mode)); EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, @@ -2007,7 +2013,7 @@ EXTERN int Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData, #ifdef MAC_TCL EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST84 char **argv)); EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData, @@ -2078,13 +2084,13 @@ EXTERN Var * TclObjLookupVar _ANSI_ARGS_((Tcl_Interp *interp, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr)); EXTERN Tcl_Obj *TclPtrGetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, - Var *arrayPtr, char *part1, CONST char *part2, + Var *arrayPtr, CONST char *part1, CONST char *part2, CONST int flags)); EXTERN Tcl_Obj *TclPtrSetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, - Var *arrayPtr, char *part1, CONST char *part2, + Var *arrayPtr, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, CONST int flags)); EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, - Var *arrayPtr, char *part1, CONST char *part2, + Var *arrayPtr, CONST char *part1, CONST char *part2, CONST long i, CONST int flags)); /* diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5d7f063..4309c93 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.44 2002/07/17 18:21:54 msofer Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.45 2002/08/05 03:24:41 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -160,7 +160,7 @@ EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 43 */ EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp, - int argc, char ** argv, int flags)); + int argc, CONST84 char ** argv, int flags)); /* 44 */ EXTERN int TclGuessPackageName _ANSI_ARGS_(( CONST char * fileName, Tcl_DString * bufPtr)); @@ -183,11 +183,11 @@ EXTERN void TclInitCompiledLocals _ANSI_ARGS_(( EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp)); /* 52 */ EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc, - char ** argv, int flags)); + CONST84 char ** argv, int flags)); /* 53 */ EXTERN int TclInvokeObjectCommand _ANSI_ARGS_(( ClientData clientData, Tcl_Interp * interp, - int argc, char ** argv)); + int argc, CONST84 char ** argv)); /* 54 */ EXTERN int TclInvokeStringCommand _ANSI_ARGS_(( ClientData clientData, Tcl_Interp * interp, @@ -198,8 +198,8 @@ EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr)); /* Slot 57 is reserved */ /* 58 */ EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - CONST char * msg, int createPart1, + CONST char * part1, CONST char * part2, + int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* Slot 59 is reserved */ /* 60 */ @@ -255,7 +255,7 @@ EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr, /* Slot 87 is reserved */ /* 88 */ EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp * interp, char * name1, + Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)); /* 89 */ EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp, @@ -272,7 +272,8 @@ EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData)); /* 94 */ EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp * interp, int argc, char ** argv)); + Tcl_Interp * interp, int argc, + CONST84 char ** argv)); /* Slot 95 is reserved */ /* 96 */ EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp, @@ -410,14 +411,14 @@ EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ -EXTERN CONST char * TclGetEnv _ANSI_ARGS_((CONST char * name, +EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* Slot 139 is reserved */ /* 140 */ EXTERN int TclLooksLikeInt _ANSI_ARGS_((CONST char * bytes, int length)); /* 141 */ -EXTERN CONST char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 142 */ EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_(( @@ -458,12 +459,12 @@ EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp, CONST char * msg, int status)); /* 157 */ EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp, - char * varName)); + CONST char * varName)); /* 158 */ EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_(( CONST char * filename)); /* 159 */ -EXTERN CONST char * TclGetStartupScriptFileName _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void)); /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp, @@ -491,13 +492,13 @@ EXTERN int TclpUtfNcmp2 _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 170 */ EXTERN int TclCheckInterpTraces _ANSI_ARGS_(( - Tcl_Interp * interp, char * command, + Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ EXTERN int TclCheckExecutionTraces _ANSI_ARGS_(( - Tcl_Interp * interp, char * command, + Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); @@ -565,7 +566,7 @@ typedef struct TclIntStubs { int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * seekFlagPtr)); /* 40 */ Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */ char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */ - int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 43 */ + int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 43 */ int (*tclGuessPackageName) _ANSI_ARGS_((CONST char * fileName, Tcl_DString * bufPtr)); /* 44 */ int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */ int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */ @@ -574,13 +575,13 @@ typedef struct TclIntStubs { Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */ void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */ int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */ - int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 52 */ - int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 53 */ + int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 52 */ + int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 53 */ int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */ Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */ void *reserved56; void *reserved57; - Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */ + Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */ void *reserved59; int (*tclNeedSpace) _ANSI_ARGS_((CONST char * start, CONST char * end)); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc * procPtr)); /* 61 */ @@ -610,13 +611,13 @@ typedef struct TclIntStubs { void *reserved85; void *reserved86; void *reserved87; - char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, char * name1, CONST char * name2, int flags)); /* 88 */ + char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)); /* 88 */ int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)); /* 89 */ void *reserved90; void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */ int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */ void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */ - int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */ + int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 94 */ void *reserved95; int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */ void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */ @@ -676,10 +677,10 @@ typedef struct TclIntStubs { int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */ void *reserved136; void *reserved137; - CONST char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ + CONST84_RETURN char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ void *reserved139; int (*tclLooksLikeInt) _ANSI_ARGS_((CONST char * bytes, int length)); /* 140 */ - CONST char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ + CONST84_RETURN char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */ int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */ void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */ @@ -695,9 +696,9 @@ typedef struct TclIntStubs { void *reserved154; void *reserved155; void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * msg, int status)); /* 156 */ - Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */ + Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 157 */ void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char * filename)); /* 158 */ - CONST char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */ + CONST84_RETURN char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */ void *reserved160; int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */ void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */ @@ -708,8 +709,8 @@ typedef struct TclIntStubs { void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */ Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */ int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 169 */ - int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */ - int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ + int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */ + int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ } TclIntStubs; #ifdef __cplusplus diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 77becd1..383bae3 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInterp.c,v 1.15 2002/07/31 12:34:23 msofer Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.16 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -835,7 +835,7 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv) Tcl_Interp *targetInterp; /* Interpreter for target command. */ CONST char *targetCmd; /* Name of target command. */ int argc; /* How many additional arguments? */ - char * CONST *argv; /* These are the additional args. */ + CONST char * CONST *argv; /* These are the additional args. */ { Tcl_Obj *slaveObjPtr, *targetObjPtr; Tcl_Obj **objv; @@ -933,7 +933,7 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr, Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */ CONST char **targetNamePtr; /* (Return) name of target command. */ int *argcPtr; /* (Return) count of addnl args. */ - char ***argvPtr; /* (Return) additional arguments. */ + CONST char ***argvPtr; /* (Return) additional arguments. */ { InterpInfo *iiPtr; Tcl_HashEntry *hPtr; @@ -962,7 +962,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr, *argcPtr = objc - 1; } if (argvPtr != NULL) { - *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) * (objc - 1)); + *argvPtr = (CONST char **) + ckalloc((unsigned) sizeof(CONST char *) * (objc - 1)); for (i = 1; i < objc; i++) { *argvPtr[i - 1] = Tcl_GetString(objv[i]); } diff --git a/generic/tclLink.c b/generic/tclLink.c index b81554e..3476766 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclLink.c,v 1.7 2002/03/20 22:47:36 dgp Exp $ + * RCS: @(#) $Id: tclLink.c,v 1.8 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -60,8 +60,8 @@ typedef struct Link { */ static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr)); /* @@ -88,7 +88,7 @@ static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr)); int Tcl_LinkVar(interp, varName, addr, type) Tcl_Interp *interp; /* Interpreter in which varName exists. */ - char *varName; /* Name of a global variable in interp. */ + CONST char *varName; /* Name of a global variable in interp. */ char *addr; /* Address of a C variable to be linked * to varName. */ int type; /* Type of C variable: TCL_LINK_INT, etc. @@ -149,7 +149,7 @@ Tcl_LinkVar(interp, varName, addr, type) void Tcl_UnlinkVar(interp, varName) Tcl_Interp *interp; /* Interpreter containing variable to unlink. */ - char *varName; /* Global variable in interp to unlink. */ + CONST char *varName; /* Global variable in interp to unlink. */ { Link *linkPtr; @@ -187,7 +187,7 @@ Tcl_UnlinkVar(interp, varName) void Tcl_UpdateLinkedVar(interp, varName) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *varName; /* Name of global variable that is linked. */ + CONST char *varName; /* Name of global variable that is linked. */ { Link *linkPtr; int savedFlag; @@ -229,7 +229,7 @@ static char * LinkTraceProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Contains information about the link. */ Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ - char *name1; /* First part of variable name. */ + CONST char *name1; /* First part of variable name. */ CONST char *name2; /* Second part of variable name. */ int flags; /* Miscellaneous additional information. */ { diff --git a/generic/tclObj.c b/generic/tclObj.c index 926fa9f..78581f2 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.34 2002/07/29 15:56:54 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.35 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -1209,7 +1209,7 @@ SetBooleanFromAny(interp, objPtr) * Still might be a string containing the characters representing an * int or double that wasn't handled above. This would be a string * like "27" or "1.0" that is non-zero and not "1". Such a string - * whould result in the boolean value true. We try converting to + * would result in the boolean value true. We try converting to * double. If that succeeds and the resulting double is non-zero, we * have a "true". Note that numbers can't have embedded NULLs. */ diff --git a/generic/tclParse.c b/generic/tclParse.c index b22df23..230edee 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -8,11 +8,12 @@ * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. + * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.21 2002/07/19 10:12:28 dkf Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.22 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -31,32 +32,32 @@ * information about its character argument. The following return * values are defined. * - * TYPE_NORMAL - All characters that don't have special significance - * to the Tcl parser. - * TYPE_SPACE - The character is a whitespace character other - * than newline. - * TYPE_COMMAND_END - Character is newline or semicolon. - * TYPE_SUBS - Character begins a substitution or has other - * special meaning in ParseTokens: backslash, dollar - * sign, open bracket, or null. - * TYPE_QUOTE - Character is a double quote. - * TYPE_CLOSE_PAREN - Character is a right parenthesis. - * TYPE_CLOSE_BRACK - Character is a right square bracket. - * TYPE_BRACE - Character is a curly brace (either left or right). + * TYPE_NORMAL - All characters that don't have special significance + * to the Tcl parser. + * TYPE_SPACE - The character is a whitespace character other + * than newline. + * TYPE_COMMAND_END - Character is newline or semicolon. + * TYPE_SUBS - Character begins a substitution or has other + * special meaning in ParseTokens: backslash, dollar + * sign, or open bracket. + * TYPE_QUOTE - Character is a double quote. + * TYPE_CLOSE_PAREN - Character is a right parenthesis. + * TYPE_CLOSE_BRACK - Character is a right square bracket. + * TYPE_BRACE - Character is a curly brace (either left or right). */ -#define TYPE_NORMAL 0 -#define TYPE_SPACE 0x1 -#define TYPE_COMMAND_END 0x2 -#define TYPE_SUBS 0x4 -#define TYPE_QUOTE 0x8 -#define TYPE_CLOSE_PAREN 0x10 -#define TYPE_CLOSE_BRACK 0x20 -#define TYPE_BRACE 0x40 +#define TYPE_NORMAL 0 +#define TYPE_SPACE 0x1 +#define TYPE_COMMAND_END 0x2 +#define TYPE_SUBS 0x4 +#define TYPE_QUOTE 0x8 +#define TYPE_CLOSE_PAREN 0x10 +#define TYPE_CLOSE_BRACK 0x20 +#define TYPE_BRACE 0x40 -#define CHAR_TYPE(c) (typeTable+128)[(int)(c)] +#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)] -static CONST char typeTable[] = { +static CONST char charTypeTable[] = { /* * Negative character values, from -128 to -1: */ @@ -173,11 +174,13 @@ static CONST char typeTable[] = { * Prototypes for local procedures defined in this file: */ -static int CommandComplete _ANSI_ARGS_((char *script, - int length)); -static int ParseTokens _ANSI_ARGS_((char *src, int mask, +static int CommandComplete _ANSI_ARGS_((CONST char *script, + int numBytes)); +static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes, Tcl_Parse *parsePtr)); - +static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes, + int mask, Tcl_Parse *parsePtr)); + /* *---------------------------------------------------------------------- * @@ -209,14 +212,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* First character of string containing - * one or more Tcl commands. The string - * must be in writable memory and must - * have one additional byte of space at - * string[length] where we can - * temporarily store a 0 sentinel - * character. */ - int numBytes; /* Total number of bytes in string. If < 0, + CONST char *string; /* First character of string containing + * one or more Tcl commands. */ + register int numBytes; /* Total number of bytes in string. If < 0, * the script consists of all bytes up to * the first null character. */ int nested; /* Non-zero means this is a nested command: @@ -229,21 +227,25 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * information in the structure is * ignored. */ { - register char *src; /* Points to current character + register CONST char *src; /* Points to current character * in the command. */ - int type; /* Result returned by CHAR_TYPE(*src). */ + char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ - char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */ int terminators; /* CHAR_TYPE bits that indicate the end * of a command. */ - char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to + CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ - int length, savedChar; - - + int scanned; + + if ((string == NULL) && (numBytes>0)) { + if (interp != NULL) { + Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); + } + return TCL_ERROR; + } if (numBytes < 0) { - numBytes = (string? strlen(string) : 0); + numBytes = strlen(string); } parsePtr->commentStart = NULL; parsePtr->commentSize = 0; @@ -266,66 +268,15 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) } /* - * Temporarily overwrite the character just after the end of the - * string with a 0 byte. This acts as a sentinel and reduces the - * number of places where we have to check for the end of the - * input string. The original value of the byte is restored at - * the end of the parse. - */ - - savedChar = string[numBytes]; - if (savedChar != 0) { - string[numBytes] = 0; - } - - /* * Parse any leading space and comments before the first word of the * command. */ - src = string; - while (1) { - while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) { - src++; - } - if ((*src == '\\') && (src[1] == '\n')) { - /* - * Skip backslash-newline sequence: it should be treated - * just like white space. - */ - - if ((src + 2) == parsePtr->end) { - parsePtr->incomplete = 1; - } - src += 2; - continue; - } - if (*src != '#') { - break; - } - if (parsePtr->commentStart == NULL) { - parsePtr->commentStart = src; - } - while (1) { - if (src == parsePtr->end) { - if (nested) { - parsePtr->incomplete = nested; - } - parsePtr->commentSize = src - parsePtr->commentStart; - break; - } else if (*src == '\\') { - if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) { - parsePtr->incomplete = 1; - } - Tcl_UtfBackslash(src, &length, utfBytes); - src += length; - } else if (*src == '\n') { - src++; - parsePtr->commentSize = src - parsePtr->commentStart; - break; - } else { - src++; - } + scanned = ParseComment(string, numBytes, parsePtr); + src = (string + scanned); numBytes -= scanned; + if (numBytes == 0) { + if (nested) { + parsePtr->incomplete = nested; } } @@ -352,19 +303,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * sequence: it should be treated just like white space. */ - while (1) { - type = CHAR_TYPE(*src); - if (type == TYPE_SPACE) { - src++; - continue; - } else if ((*src == '\\') && (src[1] == '\n')) { - if ((src + 2) == parsePtr->end) { - parsePtr->incomplete = 1; - } - Tcl_UtfBackslash(src, &length, utfBytes); - src += length; - continue; - } + scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); + src += scanned; numBytes -= scanned; + if (numBytes == 0) { break; } if ((type & terminators) != 0) { @@ -372,9 +313,6 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) src++; break; } - if (src == parsePtr->end) { - break; - } tokenPtr->start = src; parsePtr->numTokens++; parsePtr->numWords++; @@ -386,28 +324,28 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) */ if (*src == '"') { - if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src), - parsePtr, 1, &termPtr) != TCL_OK) { + if (Tcl_ParseQuotedString(interp, src, numBytes, + parsePtr, 1, &termPtr) != TCL_OK) { goto error; } - src = termPtr; + src = termPtr; numBytes = parsePtr->end - src; } else if (*src == '{') { - if (Tcl_ParseBraces(interp, src, (parsePtr->end - src), - parsePtr, 1, &termPtr) != TCL_OK) { + if (Tcl_ParseBraces(interp, src, numBytes, + parsePtr, 1, &termPtr) != TCL_OK) { goto error; } - src = termPtr; + src = termPtr; numBytes = parsePtr->end - src; } else { /* * This is an unquoted word. Call ParseTokens and let it do * all of the work. */ - if (ParseTokens(src, TYPE_SPACE|terminators, + if (ParseTokens(src, numBytes, TYPE_SPACE|terminators, parsePtr) != TCL_OK) { goto error; } - src = parsePtr->term; + src = parsePtr->term; numBytes = parsePtr->end - src; } /* @@ -431,32 +369,18 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * command. */ - type = CHAR_TYPE(*src); - if (type == TYPE_SPACE) { - src++; + scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); + if (scanned) { + src += scanned; numBytes -= scanned; continue; - } else { - /* - * Backslash-newline (and any following white space) must be - * treated as if it were a space character. - */ - - if ((*src == '\\') && (src[1] == '\n')) { - if ((src + 2) == parsePtr->end) { - parsePtr->incomplete = 1; - } - Tcl_UtfBackslash(src, &length, utfBytes); - src += length; - continue; - } } - if ((type & terminators) != 0) { - parsePtr->term = src; - src++; + if (numBytes == 0) { break; } - if (src == parsePtr->end) { + if ((type & terminators) != 0) { + parsePtr->term = src; + src++; break; } if (src[-1] == '"') { @@ -476,17 +400,10 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) goto error; } - parsePtr->commandSize = src - parsePtr->commandStart; - if (savedChar != 0) { - string[numBytes] = (char) savedChar; - } return TCL_OK; error: - if (savedChar != 0) { - string[numBytes] = (char) savedChar; - } Tcl_FreeParse(parsePtr); if (parsePtr->commandStart == NULL) { parsePtr->commandStart = string; @@ -494,17 +411,361 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) parsePtr->commandSize = parsePtr->term - parsePtr->commandStart; return TCL_ERROR; } + +/* + *---------------------------------------------------------------------- + * + * TclParseWhiteSpace -- + * + * Scans up to numBytes bytes starting at src, consuming white + * space as defined by Tcl's parsing rules. + * + * Results: + * Returns the number of bytes recognized as white space. Records + * at parsePtr, information about the parse. Records at typePtr + * the character type of the non-whitespace character that terminated + * the scan. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclParseWhiteSpace(src, numBytes, parsePtr, typePtr) + CONST char *src; /* First character to parse. */ + register int numBytes; /* Max number of bytes to scan. */ + Tcl_Parse *parsePtr; /* Information about parse in progress. + * Updated if parsing indicates + * an incomplete command. */ + char *typePtr; /* Points to location to store character + * type of character that ends run + * of whitespace */ +{ + register char type = TYPE_NORMAL; + register CONST char *p = src; + + while (1) { + while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { + numBytes--; p++; + } + if (numBytes && (type & TYPE_SUBS)) { + if (*p != '\\') { + break; + } + if (--numBytes == 0) { + break; + } + if (p[1] != '\n') { + break; + } + p+=2; + if (--numBytes == 0) { + parsePtr->incomplete = 1; + break; + } + continue; + } + break; + } + *typePtr = type; + return (p - src); +} /* *---------------------------------------------------------------------- * + * TclParseHex -- + * + * Scans a hexadecimal number as a Tcl_UniChar value. + * (e.g., for parsing \x and \u escape sequences). + * At most numBytes bytes are scanned. + * + * Results: + * The numeric value is stored in *resultPtr. + * Returns the number of bytes consumed. + * + * Notes: + * Relies on the following properties of the ASCII + * character set, with which UTF-8 is compatible: + * + * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' + * occupy consecutive code points, and '0' < 'A' < 'a'. + * + *---------------------------------------------------------------------- + */ +int +TclParseHex(src, numBytes, resultPtr) + CONST char *src; /* First character to parse. */ + int numBytes; /* Max number of byes to scan */ + Tcl_UniChar *resultPtr; /* Points to storage provided by + * caller where the Tcl_UniChar + * resulting from the conversion is + * to be written. */ +{ + Tcl_UniChar result = 0; + register CONST char *p = src; + + while (numBytes--) { + unsigned char digit = UCHAR(*p); + + if (!isxdigit(digit)) + break; + + ++p; + result <<= 4; + + if (digit >= 'a') { + result |= (10 + digit - 'a'); + } else if (digit >= 'A') { + result |= (10 + digit - 'A'); + } else { + result |= (digit - '0'); + } + } + + *resultPtr = result; + return (p - src); +} + +/* + *---------------------------------------------------------------------- + * + * TclParseBackslash -- + * + * Scans up to numBytes bytes starting at src, consuming a + * backslash sequence as defined by Tcl's parsing rules. + * + * Results: + * Records at readPtr the number of bytes making up the backslash + * sequence. Records at dst the UTF-8 encoded equivalent of + * that backslash sequence. Returns the number of bytes written + * to dst, at most TCL_UTF_MAX. Either readPtr or dst may be + * NULL, if the results are not needed, but the return value is + * the same either way. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclParseBackslash(src, numBytes, readPtr, dst) + CONST char * src; /* Points to the backslash character of a + * a backslash sequence */ + int numBytes; /* Max number of bytes to scan */ + int *readPtr; /* NULL, or points to storage where the + * number of bytes scanned should be written. */ + char *dst; /* NULL, or points to buffer where the UTF-8 + * encoding of the backslash sequence is to be + * written. At most TCL_UTF_MAX bytes will be + * written there. */ +{ + register CONST char *p = src+1; + Tcl_UniChar result; + int count; + char buf[TCL_UTF_MAX]; + + if (numBytes == 0) { + if (readPtr != NULL) { + *readPtr = 0; + } + return 0; + } + + if (dst == NULL) { + dst = buf; + } + + if (numBytes == 1) { + /* Can only scan the backslash. Return it. */ + result = '\\'; + count = 1; + goto done; + } + + count = 2; + switch (*p) { + /* + * Note: in the conversions below, use absolute values (e.g., + * 0xa) rather than symbolic values (e.g. \n) that get converted + * by the compiler. It's possible that compilers on some + * platforms will do the symbolic conversions differently, which + * could result in non-portable Tcl scripts. + */ + + case 'a': + result = 0x7; + break; + case 'b': + result = 0x8; + break; + case 'f': + result = 0xc; + break; + case 'n': + result = 0xa; + break; + case 'r': + result = 0xd; + break; + case 't': + result = 0x9; + break; + case 'v': + result = 0xb; + break; + case 'x': + count += TclParseHex(p+1, numBytes-1, &result); + if (count == 2) { + /* No hexadigits -> This is just "x". */ + result = 'x'; + } else { + /* Keep only the last byte (2 hex digits) */ + result = (unsigned char) result; + } + break; + case 'u': + count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result); + if (count == 2) { + /* No hexadigits -> This is just "u". */ + result = 'u'; + } + break; + case '\n': + count--; + do { + p++; count++; + } while ((count < numBytes) && ((*p == ' ') || (*p == '\t'))); + result = ' '; + break; + case 0: + result = '\\'; + count = 1; + break; + default: + /* + * Check for an octal number \oo?o? + */ + if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ + result = (unsigned char)(*p - '0'); + p++; + if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */ + || (UCHAR(*p) >= '8')) { + break; + } + count = 3; + result = (unsigned char)((result << 3) + (*p - '0')); + p++; + if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */ + || (UCHAR(*p) >= '8')) { + break; + } + count = 4; + result = (unsigned char)((result << 3) + (*p - '0')); + break; + } + /* + * We have to convert here in case the user has put a + * backslash in front of a multi-byte utf-8 character. + * While this means nothing special, we shouldn't break up + * a correct utf-8 character. [Bug #217987] test subst-3.2 + */ + if (Tcl_UtfCharComplete(p, numBytes - 1)) { + count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */ + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, p, (size_t) (numBytes - 1)); + utfBytes[numBytes - 1] = '\0'; + count = Tcl_UtfToUniChar(utfBytes, &result) + 1; + } + break; + } + + done: + if (readPtr != NULL) { + *readPtr = count; + } + return Tcl_UniCharToUtf((int) result, dst); +} + +/* + *---------------------------------------------------------------------- + * + * ParseComment -- + * + * Scans up to numBytes bytes starting at src, consuming a + * Tcl comment as defined by Tcl's parsing rules. + * + * Results: + * Records in parsePtr information about the parse. Returns the + * number of bytes consumed. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseComment(src, numBytes, parsePtr) + CONST char *src; /* First character to parse. */ + register int numBytes; /* Max number of bytes to scan. */ + Tcl_Parse *parsePtr; /* Information about parse in progress. + * Updated if parsing indicates + * an incomplete command. */ +{ + register CONST char *p = src; + while (numBytes) { + char type; + int scanned; + do { + scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type); + p += scanned; numBytes -= scanned; + } while (numBytes && (*p == '\n') && (p++,numBytes--)); + if ((numBytes == 0) || (*p != '#')) { + break; + } + if (parsePtr->commentStart == NULL) { + parsePtr->commentStart = p; + } + while (numBytes) { + if (*p == '\\') { + scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type); + if (scanned) { + p += scanned; numBytes -= scanned; + } else { + /* + * General backslash substitution in comments isn't + * part of the formal spec, but test parse-15.47 + * and history indicate that it has been the de facto + * rule. Don't change it now. + */ + TclParseBackslash(p, numBytes, &scanned, NULL); + p += scanned; numBytes -= scanned; + } + } else { + p++; numBytes--; + if (p[-1] == '\n') { + break; + } + } + } + parsePtr->commentSize = p - parsePtr->commentStart; + } + return (p - src); +} + +/* + *---------------------------------------------------------------------- + * * ParseTokens -- * * This procedure forms the heart of the Tcl parser. It parses one * or more tokens from a string, up to a termination point * specified by the caller. This procedure is used to parse * unquoted command words (those not in quotes or braces), words in - * quotes, and array indices for variables. + * quotes, and array indices for variables. No more than numBytes + * bytes will be scanned. * * Results: * Tokens are added to parsePtr and parsePtr->term is filled in @@ -522,8 +783,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) */ static int -ParseTokens(src, mask, parsePtr) - register char *src; /* First character to parse. */ +ParseTokens(src, numBytes, mask, parsePtr) + register CONST char *src; /* First character to parse. */ + register int numBytes; /* Max number of bytes to scan. */ int mask; /* Specifies when to stop parsing. The * parse stops at the first unquoted * character whose CHAR_TYPE contains @@ -532,8 +794,8 @@ ParseTokens(src, mask, parsePtr) * Updated with additional tokens and * termination information. */ { - int type, originalTokens, varToken; - char utfBytes[TCL_UTF_MAX]; + char type; + int originalTokens, varToken; Tcl_Token *tokenPtr; Tcl_Parse nested; @@ -545,7 +807,7 @@ ParseTokens(src, mask, parsePtr) */ originalTokens = parsePtr->numTokens; - while (1) { + while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) { if (parsePtr->numTokens == parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } @@ -553,22 +815,15 @@ ParseTokens(src, mask, parsePtr) tokenPtr->start = src; tokenPtr->numComponents = 0; - type = CHAR_TYPE(*src); - if (type & mask) { - break; - } - if ((type & TYPE_SUBS) == 0) { /* * This is a simple range of characters. Scan to find the end * of the range. */ - while (1) { - src++; - if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) { - break; - } + while ((++src, --numBytes) + && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) { + /* empty loop */ } tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = src - tokenPtr->start; @@ -580,11 +835,12 @@ ParseTokens(src, mask, parsePtr) */ varToken = parsePtr->numTokens; - if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src, + if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr, 1) != TCL_OK) { return TCL_ERROR; } src += parsePtr->tokenPtr[varToken].size; + numBytes -= parsePtr->tokenPtr[varToken].size; } else if (*src == '[') { /* * Command substitution. Call Tcl_ParseCommand recursively @@ -592,23 +848,24 @@ ParseTokens(src, mask, parsePtr) * throw away the parse information. */ - src++; + src++; numBytes--; while (1) { if (Tcl_ParseCommand(parsePtr->interp, src, - parsePtr->end - src, 1, &nested) != TCL_OK) { + numBytes, 1, &nested) != TCL_OK) { parsePtr->errorType = nested.errorType; parsePtr->term = nested.term; parsePtr->incomplete = nested.incomplete; return TCL_ERROR; } src = nested.commandStart + nested.commandSize; + numBytes = parsePtr->end - src; if (nested.tokenPtr != nested.staticTokens) { ckfree((char *) nested.tokenPtr); } if ((*nested.term == ']') && !nested.incomplete) { break; } - if (src == parsePtr->end) { + if (numBytes == 0) { if (parsePtr->interp != NULL) { Tcl_SetResult(parsePtr->interp, "missing close-bracket", TCL_STATIC); @@ -626,9 +883,18 @@ ParseTokens(src, mask, parsePtr) /* * Backslash substitution. */ + TclParseBackslash(src, numBytes, &tokenPtr->size, NULL); + + if (tokenPtr->size == 1) { + /* Just a backslash, due to end of string */ + tokenPtr->type = TCL_TOKEN_TEXT; + parsePtr->numTokens++; + src++; numBytes--; + continue; + } if (src[1] == '\n') { - if ((src + 2) == parsePtr->end) { + if (numBytes == 2) { parsePtr->incomplete = 1; } @@ -639,28 +905,22 @@ ParseTokens(src, mask, parsePtr) */ if (mask & TYPE_SPACE) { + if (parsePtr->numTokens == originalTokens) { + goto finishToken; + } break; } } + tokenPtr->type = TCL_TOKEN_BS; - Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes); parsePtr->numTokens++; src += tokenPtr->size; + numBytes -= tokenPtr->size; } else if (*src == 0) { - /* - * We encountered a null character. If it is the null - * character at the end of the string, then return. - * Otherwise generate a text token for the single - * character. - */ - - if (src == parsePtr->end) { - break; - } tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; parsePtr->numTokens++; - src++; + src++; numBytes--; } else { panic("ParseTokens encountered unknown character"); } @@ -671,7 +931,14 @@ ParseTokens(src, mask, parsePtr) * for the empty range, so that there is always at least one * token added. */ + if (parsePtr->numTokens == parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; + tokenPtr->start = src; + tokenPtr->numComponents = 0; + finishToken: tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 0; parsePtr->numTokens++; @@ -679,7 +946,7 @@ ParseTokens(src, mask, parsePtr) parsePtr->term = src; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -708,7 +975,7 @@ Tcl_FreeParse(parsePtr) parsePtr->tokenPtr = parsePtr->staticTokens; } } - + /* *---------------------------------------------------------------------- * @@ -746,14 +1013,15 @@ TclExpandTokenArray(parsePtr) parsePtr->tokenPtr = newPtr; parsePtr->tokensAvailable = newCount; } - + /* *---------------------------------------------------------------------- * * Tcl_ParseVarName -- * * Given a string starting with a $ sign, parse off a variable - * name and return information about the parse. + * name and return information about the parse. No more than + * numBytes bytes will be scanned. * * Results: * The return value is TCL_OK if the command was parsed @@ -780,9 +1048,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* String containing variable name. First + CONST char *string; /* String containing variable name. First * character must be "$". */ - int numBytes; /* Total number of bytes in string. If < 0, + register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr; /* Structure to fill in with information @@ -793,16 +1061,17 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) * it. */ { Tcl_Token *tokenPtr; - char *end, *src; + register CONST char *src; unsigned char c; int varIndex, offset; Tcl_UniChar ch; unsigned array; - if (numBytes >= 0) { - end = string + numBytes; - } else { - end = string + strlen(string); + if ((numBytes == 0) || (string == NULL)) { + return TCL_ERROR; + } + if (numBytes < 0) { + numBytes = strlen(string); } if (!append) { @@ -811,7 +1080,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = string; - parsePtr->end = end; + parsePtr->end = (string + numBytes); parsePtr->interp = interp; parsePtr->errorType = TCL_PARSE_SUCCESS; parsePtr->incomplete = 0; @@ -833,8 +1102,8 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) varIndex = parsePtr->numTokens; parsePtr->numTokens++; tokenPtr++; - src++; - if (src >= end) { + src++; numBytes--; + if (numBytes == 0) { goto justADollarSign; } tokenPtr->type = TCL_TOKEN_TEXT; @@ -859,26 +1128,23 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) */ if (*src == '{') { - src++; + src++; numBytes--; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; - while (1) { - if (src == end) { - if (interp != NULL) { - Tcl_SetResult(interp, - "missing close-brace for variable name", + + while (numBytes && (*src != '}')) { + numBytes--; src++; + } + if (numBytes == 0) { + if (interp != NULL) { + Tcl_SetResult(interp, "missing close-brace for variable name", TCL_STATIC); - } - parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; - parsePtr->term = tokenPtr->start-1; - parsePtr->incomplete = 1; - goto error; - } - if (*src == '}') { - break; } - src++; + parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; + parsePtr->term = tokenPtr->start-1; + parsePtr->incomplete = 1; + goto error; } tokenPtr->size = src - tokenPtr->start; tokenPtr[-1].size = src - tokenPtr[-1].start; @@ -888,17 +1154,24 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; - while (src != end) { - offset = Tcl_UtfToUniChar(src, &ch); + while (numBytes) { + if (Tcl_UtfCharComplete(src, numBytes)) { + offset = Tcl_UtfToUniChar(src, &ch); + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, src, (size_t) numBytes); + utfBytes[numBytes] = '\0'; + offset = Tcl_UtfToUniChar(utfBytes, &ch); + } c = UCHAR(ch); if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ - src += offset; + src += offset; numBytes -= offset; continue; } - if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) { - src += 2; - while ((src != end) && (*src == ':')) { - src += 1; + if ((c == ':') && (numBytes != 1) && (src[1] == ':')) { + src += 2; numBytes -= 2; + while (numBytes && (*src == ':')) { + src++; numBytes--; } continue; } @@ -908,9 +1181,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) /* * Support for empty array names here. */ - array = ((src != end) && (*src == '(')); + array = (numBytes && (*src == '(')); tokenPtr->size = src - tokenPtr->start; - if (tokenPtr->size == 0 && !array) { + if ((tokenPtr->size == 0) && !array) { goto justADollarSign; } parsePtr->numTokens++; @@ -921,11 +1194,12 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) * since it could contain any number of substitutions. */ - if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr) + if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr) != TCL_OK) { goto error; } - if ((parsePtr->term == end) || (*parsePtr->term != ')')) { + if ((parsePtr->term == (src + numBytes)) + || (*parsePtr->term != ')')) { if (parsePtr->interp != NULL) { Tcl_SetResult(parsePtr->interp, "missing )", TCL_STATIC); @@ -960,7 +1234,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) Tcl_FreeParse(parsePtr); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -986,9 +1260,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) CONST char * Tcl_ParseVar(interp, string, termPtr) Tcl_Interp *interp; /* Context for looking up variable. */ - register char *string; /* String containing variable name. + register CONST char *string; /* String containing variable name. * First character must be "$". */ - char **termPtr; /* If non-NULL, points to word to fill + CONST char **termPtr; /* If non-NULL, points to word to fill * in with character just after last * one in the variable specifier. */ @@ -1035,7 +1309,7 @@ Tcl_ParseVar(interp, string, termPtr) Tcl_ResetResult(interp); return TclGetString(objPtr); } - + /* *---------------------------------------------------------------------- * @@ -1043,7 +1317,8 @@ Tcl_ParseVar(interp, string, termPtr) * * Given a string in braces such as a Tcl command argument or a string * value in a Tcl expression, this procedure parses the string and - * returns information about the parse. + * returns information about the parse. No more than numBytes bytes + * will be scanned. * * Results: * The return value is TCL_OK if the string was parsed successfully and @@ -1069,9 +1344,9 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* String containing the string in braces. + CONST char *string; /* String containing the string in braces. * The first character must be '{'. */ - int numBytes; /* Total number of bytes in string. If < 0, + register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to * the first null character. */ register Tcl_Parse *parsePtr; @@ -1081,35 +1356,35 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) * information in parsePtr; zero means * ignore existing tokens in parsePtr and * reinitialize it. */ - char **termPtr; /* If non-NULL, points to word in which to + CONST char **termPtr; /* If non-NULL, points to word in which to * store a pointer to the character just * after the terminating '}' if the parse * was successful. */ { - char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */ Tcl_Token *tokenPtr; - register char *src, *end; + register CONST char *src; int startIndex, level, length; - if ((numBytes >= 0) || (string == NULL)) { - end = string + numBytes; - } else { - end = string + strlen(string); + if ((numBytes == 0) || (string == NULL)) { + return TCL_ERROR; } - + if (numBytes < 0) { + numBytes = strlen(string); + } + if (!append) { parsePtr->numWords = 0; parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = string; - parsePtr->end = end; + parsePtr->end = (string + numBytes); parsePtr->interp = interp; parsePtr->errorType = TCL_PARSE_SUCCESS; } - src = string+1; + src = string; startIndex = parsePtr->numTokens; if (parsePtr->numTokens == parsePtr->tokensAvailable) { @@ -1117,59 +1392,17 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) } tokenPtr = &parsePtr->tokenPtr[startIndex]; tokenPtr->type = TCL_TOKEN_TEXT; - tokenPtr->start = src; + tokenPtr->start = src+1; tokenPtr->numComponents = 0; level = 1; while (1) { - while (CHAR_TYPE(*src) == TYPE_NORMAL) { - src++; - } - if (*src == '}') { - level--; - if (level == 0) { + while (++src, --numBytes) { + if (CHAR_TYPE(*src) != TYPE_NORMAL) { break; } - src++; - } else if (*src == '{') { - level++; - src++; - } else if (*src == '\\') { - Tcl_UtfBackslash(src, &length, utfBytes); - if (src[1] == '\n') { - /* - * A backslash-newline sequence must be collapsed, even - * inside braces, so we have to split the word into - * multiple tokens so that the backslash-newline can be - * represented explicitly. - */ - - if ((src + 2) == end) { - parsePtr->incomplete = 1; - } - tokenPtr->size = (src - tokenPtr->start); - if (tokenPtr->size != 0) { - parsePtr->numTokens++; - } - if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; - tokenPtr->type = TCL_TOKEN_BS; - tokenPtr->start = src; - tokenPtr->size = length; - tokenPtr->numComponents = 0; - parsePtr->numTokens++; - - src += length; - tokenPtr++; - tokenPtr->type = TCL_TOKEN_TEXT; - tokenPtr->start = src; - tokenPtr->numComponents = 0; - } else { - src += length; - } - } else if (src == end) { - register int openBrace; /* bool-flag for when scanning back */ + } + if (numBytes == 0) { + register int openBrace = 0; parsePtr->errorType = TCL_PARSE_MISSING_BRACE; parsePtr->term = string; @@ -1177,7 +1410,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) if (interp == NULL) { /* * Skip straight to the exit code since we have no - * interpreter to put error messages in. + * interpreter to put error message in. */ goto error; } @@ -1185,22 +1418,22 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) Tcl_SetResult(interp, "missing close-brace", TCL_STATIC); /* - * Guess if the problem is due to comments by searching - * the source string for a possible open brace within the - * context of a comment. Since we aren't performing a - * full Tcl parse, just look for an open brace preceeded - * by a '#' on the same line. + * Guess if the problem is due to comments by searching + * the source string for a possible open brace within the + * context of a comment. Since we aren't performing a + * full Tcl parse, just look for an open brace preceded + * by a '#' on the same line. */ - openBrace = 0; - for (; src>string ; src--) { + + for (; src > string; src--) { switch (*src) { - case '{': - openBrace = 1; + case '{': + openBrace = 1; break; case '\n': - openBrace = 0; + openBrace = 0; break; - case '#': + case '#' : if (openBrace && (isspace(UCHAR(src[-1])))) { Tcl_AppendResult(interp, ": possible unbalanced brace in comment", @@ -1210,37 +1443,84 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) break; } } - goto error; - } else { - src++; - } - } - /* - * Decide if we need to finish emitting a partially-finished token. - * There are 3 cases: - * {abc \newline xyz} or {xyz} - finish emitting "xyz" token - * {abc \newline} - don't emit token after \newline - * {} - finish emitting zero-sized token - * The last case ensures that there is a token (even if empty) that - * describes the braced string. - */ + error: + Tcl_FreeParse(parsePtr); + return TCL_ERROR; + } + switch (*src) { + case '{': + level++; + break; + case '}': + if (--level == 0) { + + /* + * Decide if we need to finish emitting a + * partially-finished token. There are 3 cases: + * {abc \newline xyz} or {xyz} + * - finish emitting "xyz" token + * {abc \newline} + * - don't emit token after \newline + * {} - finish emitting zero-sized token + * + * The last case ensures that there is a token + * (even if empty) that describes the braced string. + */ - if ((src != tokenPtr->start) - || (parsePtr->numTokens == startIndex)) { - tokenPtr->size = (src - tokenPtr->start); - parsePtr->numTokens++; - } - if (termPtr != NULL) { - *termPtr = src+1; + if ((src != tokenPtr->start) + || (parsePtr->numTokens == startIndex)) { + tokenPtr->size = (src - tokenPtr->start); + parsePtr->numTokens++; + } + if (termPtr != NULL) { + *termPtr = src+1; + } + return TCL_OK; + } + break; + case '\\': + TclParseBackslash(src, numBytes, &length, NULL); + if ((length > 1) && (src[1] == '\n')) { + /* + * A backslash-newline sequence must be collapsed, even + * inside braces, so we have to split the word into + * multiple tokens so that the backslash-newline can be + * represented explicitly. + */ + + if (numBytes == 2) { + parsePtr->incomplete = 1; + } + tokenPtr->size = (src - tokenPtr->start); + if (tokenPtr->size != 0) { + parsePtr->numTokens++; + } + if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; + tokenPtr->type = TCL_TOKEN_BS; + tokenPtr->start = src; + tokenPtr->size = length; + tokenPtr->numComponents = 0; + parsePtr->numTokens++; + + src += length - 1; + numBytes -= length - 1; + tokenPtr++; + tokenPtr->type = TCL_TOKEN_TEXT; + tokenPtr->start = src + 1; + tokenPtr->numComponents = 0; + } else { + src += length - 1; + numBytes -= length - 1; + } + break; + } } - return TCL_OK; - - error: - Tcl_FreeParse(parsePtr); - return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1248,7 +1528,8 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) * * Given a double-quoted string such as a quoted Tcl command argument * or a quoted value in a Tcl expression, this procedure parses the - * string and returns information about the parse. + * string and returns information about the parse. No more than + * numBytes bytes will be scanned. * * Results: * The return value is TCL_OK if the string was parsed successfully and @@ -1274,9 +1555,9 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* String containing the quoted string. + CONST char *string; /* String containing the quoted string. * The first character must be '"'. */ - int numBytes; /* Total number of bytes in string. If < 0, + register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to * the first null character. */ register Tcl_Parse *parsePtr; @@ -1286,31 +1567,30 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) * information in parsePtr; zero means * ignore existing tokens in parsePtr and * reinitialize it. */ - char **termPtr; /* If non-NULL, points to word in which to + CONST char **termPtr; /* If non-NULL, points to word in which to * store a pointer to the character just * after the quoted string's terminating * close-quote if the parse succeeds. */ { - char *end; - - if ((numBytes >= 0) || (string == NULL)) { - end = string + numBytes; - } else { - end = string + strlen(string); + if ((numBytes == 0) || (string == NULL)) { + return TCL_ERROR; } - + if (numBytes < 0) { + numBytes = strlen(string); + } + if (!append) { parsePtr->numWords = 0; parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = string; - parsePtr->end = end; + parsePtr->end = (string + numBytes); parsePtr->interp = interp; parsePtr->errorType = TCL_PARSE_SUCCESS; } - if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) { + if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) { goto error; } if (*parsePtr->term != '"') { @@ -1331,7 +1611,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) Tcl_FreeParse(parsePtr); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1353,16 +1633,16 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) */ static int -CommandComplete(script, length) - char *script; /* Script to check. */ - int length; /* Number of bytes in script. */ +CommandComplete(script, numBytes) + CONST char *script; /* Script to check. */ + int numBytes; /* Number of bytes in script. */ { Tcl_Parse parse; - char *p, *end; + CONST char *p, *end; int result; p = script; - end = p + length; + end = p + numBytes; while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse) == TCL_OK) { p = parse.commandStart + parse.commandSize; @@ -1379,7 +1659,7 @@ CommandComplete(script, length) Tcl_FreeParse(&parse); return result; } - + /* *---------------------------------------------------------------------- * @@ -1402,11 +1682,11 @@ CommandComplete(script, length) int Tcl_CommandComplete(script) - char *script; /* Script to check. */ + CONST char *script; /* Script to check. */ { return CommandComplete(script, (int) strlen(script)); } - + /* *---------------------------------------------------------------------- * @@ -1430,13 +1710,13 @@ TclObjCommandComplete(objPtr) Tcl_Obj *objPtr; /* Points to object holding script * to check. */ { - char *script; + CONST char *script; int length; script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); } - + /* *---------------------------------------------------------------------- * diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index 1c6a5f5..077dddb 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -8,11 +8,12 @@ * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. + * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParseExpr.c,v 1.14 2002/07/22 10:04:17 dkf Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.15 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -55,16 +56,16 @@ typedef struct ParseInfo { int lexeme; /* Type of last lexeme scanned in expr. * See below for definitions. Corresponds to * size characters beginning at start. */ - char *start; /* First character in lexeme. */ + CONST char *start; /* First character in lexeme. */ int size; /* Number of bytes in lexeme. */ - char *next; /* Position of the next character to be + CONST char *next; /* Position of the next character to be * scanned in the expression string. */ - char *prevEnd; /* Points to the character just after the + CONST char *prevEnd; /* Points to the character just after the * last one in the previous lexeme. Used to * compute size of subexpression tokens. */ - char *originalExpr; /* Points to the start of the expression + CONST char *originalExpr; /* Points to the start of the expression * originally passed to Tcl_ParseExpr. */ - char *lastChar; /* Points just after last byte of expr. */ + CONST char *lastChar; /* Points just after last byte of expr. */ } ParseInfo; /* @@ -148,7 +149,7 @@ static char *lexemeStrings[] = { static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr)); static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr, - char *extraInfo)); + CONST char *extraInfo)); static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr)); @@ -157,13 +158,15 @@ static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr)); +static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string, + CONST char *end)); static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr)); -static void PrependSubExprTokens _ANSI_ARGS_((char *op, - int opBytes, char *src, int srcBytes, +static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, + int opBytes, CONST char *src, int srcBytes, int firstIndex, ParseInfo *infoPtr)); /* @@ -190,7 +193,8 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op, * Given a string, this procedure parses the first Tcl expression * in the string and returns information about the structure of * the expression. This procedure is the top-level interface to the - * the expression parsing module. + * the expression parsing module. No more that numBytes bytes will + * be scanned. * * Results: * The return value is TCL_OK if the command was parsed successfully @@ -212,7 +216,7 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op, int Tcl_ParseExpr(interp, string, numBytes, parsePtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *string; /* The source string to parse. */ + CONST char *string; /* The source string to parse. */ int numBytes; /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ @@ -223,7 +227,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) { ParseInfo info; int code; - char savedChar; if (numBytes < 0) { numBytes = (string? strlen(string) : 0); @@ -250,17 +253,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) parsePtr->incomplete = 0; /* - * Temporarily overwrite the character just after the end of the - * string with a 0 byte. This acts as a sentinel and reduces the - * number of places where we have to check for the end of the - * input string. The original value of the byte is restored at - * the end of the parse. - */ - - savedChar = string[numBytes]; - string[numBytes] = 0; - - /* * Initialize the ParseInfo structure that holds state while parsing * the expression. */ @@ -290,11 +282,9 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) LogSyntaxError(&info, "extra tokens at end of expression"); goto error; } - string[numBytes] = (char) savedChar; return TCL_OK; error: - string[numBytes] = (char) savedChar; if (parsePtr->tokenPtr != parsePtr->staticTokens) { ckfree((char *) parsePtr->tokenPtr); } @@ -310,7 +300,7 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) * condExpr ::= lorExpr ['?' condExpr ':' condExpr] * * Note that this is the topmost recursive-descent parsing routine used - * by TclParseExpr to parse expressions. This avoids an extra procedure + * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure * call since such a procedure would only return the result of calling * ParseCondExpr. Other recursive-descent procedures that need to parse * complete expressions also call ParseCondExpr. @@ -336,7 +326,7 @@ ParseCondExpr(infoPtr) Tcl_Parse *parsePtr = infoPtr->parsePtr; Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr; int firstIndex, numToMove, code; - char *srcStart; + CONST char *srcStart; HERE("condExpr", 1); srcStart = infoPtr->start; @@ -449,7 +439,7 @@ ParseLorExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("lorExpr", 2); srcStart = infoPtr->start; @@ -509,7 +499,7 @@ ParseLandExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("landExpr", 3); srcStart = infoPtr->start; @@ -569,7 +559,7 @@ ParseBitOrExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("bitOrExpr", 4); srcStart = infoPtr->start; @@ -630,7 +620,7 @@ ParseBitXorExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("bitXorExpr", 5); srcStart = infoPtr->start; @@ -691,7 +681,7 @@ ParseBitAndExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("bitAndExpr", 6); srcStart = infoPtr->start; @@ -752,7 +742,7 @@ ParseEqualityExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("equalityExpr", 7); srcStart = infoPtr->start; @@ -816,7 +806,7 @@ ParseRelationalExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, operatorSize, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("relationalExpr", 8); srcStart = infoPtr->start; @@ -884,7 +874,7 @@ ParseShiftExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("shiftExpr", 9); srcStart = infoPtr->start; @@ -946,7 +936,7 @@ ParseAddExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("addExpr", 10); srcStart = infoPtr->start; @@ -1008,7 +998,7 @@ ParseMultiplyExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("multiplyExpr", 11); srcStart = infoPtr->start; @@ -1070,7 +1060,7 @@ ParseUnaryExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("unaryExpr", 12); srcStart = infoPtr->start; @@ -1135,7 +1125,7 @@ ParsePrimaryExpr(infoPtr) Tcl_Interp *interp = parsePtr->interp; Tcl_Token *tokenPtr, *exprTokenPtr; Tcl_Parse nested; - char *dollarPtr, *stringStart, *termPtr, *src; + CONST char *dollarPtr, *stringStart, *termPtr, *src; int lexeme, exprIndex, firstIndex, numToMove, code; /* @@ -1394,17 +1384,20 @@ ParsePrimaryExpr(infoPtr) * serious as this is only done when generating an error. */ Interp *iPtr = (Interp *) infoPtr->parsePtr->interp; - char savedChar; + Tcl_DString functionName; Tcl_HashEntry *hPtr; /* - * Look up the name as a function name; note that this - * requires the expression to be in writable memory. + * Look up the name as a function name. We need a writable + * copy (DString) so we can terminate it with a NULL for + * the benefit of Tcl_FindHashEntry which operates on + * NULL-terminated string keys. */ - savedChar = tokenPtr->start[tokenPtr->size]; - tokenPtr->start[tokenPtr->size] = '\0'; - hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, tokenPtr->start); - tokenPtr->start[tokenPtr->size] = savedChar; + Tcl_DStringInit(&functionName); + hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, + Tcl_DStringAppend(&functionName, tokenPtr->start, + tokenPtr->size)); + Tcl_DStringFree(&functionName); /* * Assume that we have an attempted variable reference @@ -1525,11 +1518,9 @@ GetLexeme(infoPtr) ParseInfo *infoPtr; /* Holds state needed to parse the expr, * including the resulting lexeme. */ { - register char *src; /* Points to current source char. */ - char *termPtr; /* Points to char terminating a literal. */ - double doubleValue; /* Value of a scanned double literal. */ + register CONST char *src; /* Points to current source char. */ char c; - int startsWithDigit, offset; + int offset, length, numBytes; Tcl_Parse *parsePtr = infoPtr->parsePtr; Tcl_Interp *interp = parsePtr->interp; Tcl_UniChar ch; @@ -1543,26 +1534,18 @@ GetLexeme(infoPtr) infoPtr->prevEnd = infoPtr->next; /* - * Scan over leading white space at the start of a lexeme. Note that a - * backslash-newline is treated as a space. + * Scan over leading white space at the start of a lexeme. */ src = infoPtr->next; - c = *src; - while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */ - if (c == '\\') { - if (src[1] == '\n') { - src += 2; - } else { - break; /* no longer white space */ - } - } else { - src++; - } - c = *src; - } + numBytes = parsePtr->end - src; + do { + char type; + int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); + src += scanned; numBytes -= scanned; + } while (numBytes && (*src == '\n') && (src++,numBytes--)); parsePtr->term = src; - if (src >= infoPtr->lastChar) { + if (numBytes == 0) { infoPtr->lexeme = END; infoPtr->next = src; return TCL_OK; @@ -1575,64 +1558,48 @@ GetLexeme(infoPtr) * by mistake, which would eventually cause a syntax error. */ + c = *src; if ((c != '+') && (c != '-')) { - startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */ - if (startsWithDigit && TclLooksLikeInt(src, -1)) { - errno = 0; -#ifdef TCL_WIDE_INT_IS_LONG - (void) strtoul(src, &termPtr, 0); -#else - (void) strtoull(src, &termPtr, 0); -#endif - if (errno == ERANGE) { - if (interp != NULL) { - char *s = "integer value too large to represent"; - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, - (char *) NULL); - } + CONST char *end = infoPtr->lastChar; + if ((length = TclParseInteger(src, (end - src)))) { + /* + * First length bytes look like an integer. Verify by + * attempting the conversion to the largest integer we have. + */ + int code; + Tcl_WideInt wide; + Tcl_Obj *value = Tcl_NewStringObj(src, length); + + Tcl_IncrRefCount(value); + code = Tcl_GetWideIntFromObj(interp, value, &wide); + Tcl_DecrRefCount(value); + if (code == TCL_ERROR) { parsePtr->errorType = TCL_PARSE_BAD_NUMBER; return TCL_ERROR; } - if (termPtr != src) { - /* - * src was the start of a valid integer, but was it - * a bad octal? Stopping at a digit would cause that. - */ - if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */ - /* - * We only want to report an error for the number, - * but we may have something like "08+1" - */ - if (interp != NULL) { - while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */ - Tcl_ResetResult(interp); - offset = termPtr - src; - c = src[offset]; - src[offset] = 0; - Tcl_AppendResult(interp, "\"", src, - "\" is an invalid octal number", - (char *) NULL); - src[offset] = c; - } - parsePtr->errorType = TCL_PARSE_BAD_NUMBER; - return TCL_ERROR; - } + infoPtr->lexeme = LITERAL; + infoPtr->start = src; + infoPtr->size = length; + infoPtr->next = (src + length); + parsePtr->term = infoPtr->next; + return TCL_OK; + } else if ((length = ParseMaxDoubleLength(src, end))) { + /* + * There are length characters that could be a double. + * Let strtod() tells us for sure. Need a writable copy + * so we can set an terminating NULL to keep strtod from + * scanning too far. + */ + char *startPtr, *termPtr; + double doubleValue; + Tcl_DString toParse; - infoPtr->lexeme = LITERAL; - infoPtr->start = src; - infoPtr->size = (termPtr - src); - infoPtr->next = termPtr; - parsePtr->term = termPtr; - return TCL_OK; - } - } else if (startsWithDigit || (c == '.') - || (c == 'i') || (c == 'I') /* Could be 'Inf' */ - || (c == 'n') || (c == 'N')) { /* Could be 'NaN' */ errno = 0; - doubleValue = strtod(src, &termPtr); - if (termPtr != src) { + Tcl_DStringInit(&toParse); + startPtr = Tcl_DStringAppend(&toParse, src, length); + doubleValue = strtod(startPtr, &termPtr); + Tcl_DStringFree(&toParse); + if (termPtr != startPtr) { if (errno != 0) { if (interp != NULL) { TclExprFloatError(interp, doubleValue); @@ -1642,14 +1609,19 @@ GetLexeme(infoPtr) } /* - * src was the start of a valid double. + * startPtr was the start of a valid double, copied + * from src. */ infoPtr->lexeme = LITERAL; infoPtr->start = src; - infoPtr->size = (termPtr - src); - infoPtr->next = termPtr; - parsePtr->term = termPtr; + if ((termPtr - startPtr) > length) { + infoPtr->size = length; + } else { + infoPtr->size = (termPtr - startPtr); + } + infoPtr->next = src + infoPtr->size; + parsePtr->term = infoPtr->next; return TCL_OK; } } @@ -1723,72 +1695,69 @@ GetLexeme(infoPtr) return TCL_OK; case '<': - switch (src[1]) { - case '<': - infoPtr->lexeme = LEFT_SHIFT; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - case '=': - infoPtr->lexeme = LEQ; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - default: - infoPtr->lexeme = LESS; - break; + infoPtr->lexeme = LESS; + if ((infoPtr->lastChar - src) > 1) { + switch (src[1]) { + case '<': + infoPtr->lexeme = LEFT_SHIFT; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + case '=': + infoPtr->lexeme = LEQ; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + } } parsePtr->term = infoPtr->next; return TCL_OK; case '>': - switch (src[1]) { - case '>': - infoPtr->lexeme = RIGHT_SHIFT; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - case '=': - infoPtr->lexeme = GEQ; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - default: - infoPtr->lexeme = GREATER; - break; + infoPtr->lexeme = GREATER; + if ((infoPtr->lastChar - src) > 1) { + switch (src[1]) { + case '>': + infoPtr->lexeme = RIGHT_SHIFT; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + case '=': + infoPtr->lexeme = GEQ; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + } } parsePtr->term = infoPtr->next; return TCL_OK; case '=': - if (src[1] == '=') { + infoPtr->lexeme = UNKNOWN; + if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = EQUAL; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = UNKNOWN; } parsePtr->term = infoPtr->next; return TCL_OK; case '!': - if (src[1] == '=') { + infoPtr->lexeme = NOT; + if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = NEQ; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = NOT; } parsePtr->term = infoPtr->next; return TCL_OK; case '&': - if (src[1] == '&') { + infoPtr->lexeme = BIT_AND; + if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = AND; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = BIT_AND; } parsePtr->term = infoPtr->next; return TCL_OK; @@ -1798,12 +1767,11 @@ GetLexeme(infoPtr) return TCL_OK; case '|': - if (src[1] == '|') { + infoPtr->lexeme = BIT_OR; + if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = OR; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = BIT_OR; } parsePtr->term = infoPtr->next; return TCL_OK; @@ -1813,7 +1781,7 @@ GetLexeme(infoPtr) return TCL_OK; case 'e': - if (src[1] == 'q') { + if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = STREQ; infoPtr->size = 2; infoPtr->next = src+2; @@ -1824,7 +1792,7 @@ GetLexeme(infoPtr) } case 'n': - if (src[1] == 'e') { + if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = STRNEQ; infoPtr->size = 2; infoPtr->next = src+2; @@ -1836,13 +1804,28 @@ GetLexeme(infoPtr) default: checkFuncName: - offset = Tcl_UtfToUniChar(src, &ch); + length = (infoPtr->lastChar - src); + if (Tcl_UtfCharComplete(src, length)) { + offset = Tcl_UtfToUniChar(src, &ch); + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, src, (size_t) length); + utfBytes[length] = '\0'; + offset = Tcl_UtfToUniChar(utfBytes, &ch); + } c = UCHAR(ch); if (isalpha(UCHAR(c))) { /* INTL: ISO only. */ infoPtr->lexeme = FUNC_NAME; while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */ - src += offset; - offset = Tcl_UtfToUniChar(src, &ch); + src += offset; length -= offset; + if (Tcl_UtfCharComplete(src, length)) { + offset = Tcl_UtfToUniChar(src, &ch); + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, src, (size_t) length); + utfBytes[length] = '\0'; + offset = Tcl_UtfToUniChar(utfBytes, &ch); + } c = UCHAR(ch); } infoPtr->size = (src - infoPtr->start); @@ -1902,6 +1885,107 @@ GetLexeme(infoPtr) /* *---------------------------------------------------------------------- * + * TclParseInteger -- + * + * Scans up to numBytes bytes starting at src, and checks whether + * the leading bytes look like an integer's string representation. + * + * Results: + * Returns 0 if the leading bytes do not look like an integer. + * Otherwise, returns the number of bytes examined that look + * like an integer. This may be less than numBytes if the integer + * is only the leading part of the string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclParseInteger(string, numBytes) + register CONST char *string;/* The string to examine. */ + register int numBytes; /* Max number of bytes to scan. */ +{ + register CONST char *p = string; + + /* Take care of introductory "0x" */ + if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) { + int scanned; + Tcl_UniChar ch; + p+=2; numBytes -= 2; + scanned = TclParseHex(p, numBytes, &ch); + if (scanned) { + return scanned + 2; + } + return 0; + } + while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */ + numBytes--; p++; + } + if (numBytes == 0) { + return (p - string); + } + if ((*p != '.') && (*p != 'e') && (*p != 'E')) { + return (p - string); + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * ParseMaxDoubleLength -- + * + * Scans a sequence of bytes checking that the characters could + * be in a string rep of a double. + * + * Results: + * Returns the number of bytes starting with string, runing to, but + * not including end, all of which could be part of a string rep. + * of a double. Only character identity is used, no actual + * parsing is done. + * + * The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', + * '.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x', and 'X'. + * This covers the values "Inf" and "Nan" as well as the + * decimal and hexadecimal representations recognized by a + * C99-compliant strtod(). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ParseMaxDoubleLength(string, end) + register CONST char *string;/* The string to examine. */ + CONST char *end; /* Point to the first character past the end + * of the string we are examining. */ +{ + CONST char *p = string; + while (p < end) { + switch (*p) { + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': case 'A': case 'B': + case 'C': case 'D': case 'E': case 'F': case 'I': case 'N': + case 'P': case 'X': case 'a': case 'b': case 'c': case 'd': + case 'e': case 'f': case 'i': case 'n': case 'p': case 'x': + case '.': case '+': case '-': + p++; + break; + default: + goto done; + } + } + done: + return (p - string); +} + +/* + *---------------------------------------------------------------------- + * * PrependSubExprTokens -- * * This procedure is called after the operands of an subexpression have @@ -1921,10 +2005,10 @@ GetLexeme(infoPtr) static void PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr) - char *op; /* Points to first byte of the operator + CONST char *op; /* Points to first byte of the operator * in the source script. */ int opBytes; /* Number of bytes in the operator. */ - char *src; /* Points to first byte of the subexpression + CONST char *src; /* Points to first byte of the subexpression * in the source script. */ int srcBytes; /* Number of bytes in subexpression's * source. */ @@ -1984,7 +2068,7 @@ static void LogSyntaxError(infoPtr, extraInfo) ParseInfo *infoPtr; /* Holds the parse state for the * expression being parsed. */ - char *extraInfo; /* String to provide extra information + CONST char *extraInfo; /* String to provide extra information * about the syntax error. */ { int numBytes = (infoPtr->lastChar - infoPtr->originalExpr); @@ -1994,8 +2078,8 @@ LogSyntaxError(infoPtr, extraInfo) sprintf(buffer, "syntax error in expression \"%.60s...\"", infoPtr->originalExpr); } else { - sprintf(buffer, "syntax error in expression \"%s\"", - infoPtr->originalExpr); + sprintf(buffer, "syntax error in expression \"%.*s\"", + numBytes, infoPtr->originalExpr); } Tcl_ResetResult(infoPtr->parsePtr->interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp), diff --git a/generic/tclProc.c b/generic/tclProc.c index 57829ba..2d16c7f 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclProc.c,v 1.40 2002/07/25 22:06:35 jenglish Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.41 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -798,7 +798,7 @@ TclProcInterpProc(clientData, interp, argc, argv) * invoked. */ int argc; /* Count of number of arguments to this * procedure. */ - register char **argv; /* Argument values. */ + register CONST char **argv; /* Argument values. */ { register Tcl_Obj *objPtr; register int i; diff --git a/generic/tclTest.c b/generic/tclTest.c index 2c952e8..26bc889 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,11 +13,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.55 2002/07/22 16:57:47 vincentdarley Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.56 2002/08/05 03:24:41 dgp Exp $ */ #define TCL_TEST - #include "tclInt.h" #include "tclPort.h" @@ -124,9 +123,9 @@ static void CleanupTestSetassocdataTests _ANSI_ARGS_(( static void CmdDelProc1 _ANSI_ARGS_((ClientData clientData)); static void CmdDelProc2 _ANSI_ARGS_((ClientData clientData)); static int CmdProc1 _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int CmdProc2 _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void CmdTraceDeleteProc _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, @@ -138,14 +137,14 @@ static void CmdTraceProc _ANSI_ARGS_((ClientData clientData, int argc, char **argv)); static int CreatedCommandProc _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, - int argc, char **argv)); + int argc, CONST char **argv)); static int CreatedCommandProc2 _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, - int argc, char **argv)); + int argc, CONST char **argv)); static void DelCallbackProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp)); static int DelCmdProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void DelDeleteProc _ANSI_ARGS_((ClientData clientData)); static void EncodingFreeProc _ANSI_ARGS_((ClientData clientData)); static int EncodingToUtfProc _ANSI_ARGS_((ClientData clientData, @@ -161,10 +160,10 @@ static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData, static void ExitProcEven _ANSI_ARGS_((ClientData clientData)); static void ExitProcOdd _ANSI_ARGS_((ClientData clientData)); static int GetTimesCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void MainLoop _ANSI_ARGS_((void)); static int NoopCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int NoopObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -181,7 +180,7 @@ static void PrintParse _ANSI_ARGS_((Tcl_Interp *interp, static void SpecialFree _ANSI_ARGS_((char *blockPtr)); static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp)); static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int PretendTclpAccess _ANSI_ARGS_((CONST char *path, int mode)); static int TestAccessProc1 _ANSI_ARGS_((CONST char *path, @@ -191,25 +190,25 @@ static int TestAccessProc2 _ANSI_ARGS_((CONST char *path, static int TestAccessProc3 _ANSI_ARGS_((CONST char *path, int mode)); static int TestasyncCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdcallCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdelCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdstringCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -220,31 +219,31 @@ static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestfileCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestfilelinkCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestfeventCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetplatformCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetvarfullnameCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestlinkCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -255,11 +254,11 @@ static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)); static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_(( Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)); @@ -273,7 +272,7 @@ static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_(( Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)); static int TestpanicCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -293,18 +292,19 @@ static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy, Tcl_Obj *CONST objv[])); static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr)); static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetobjerrorcodeCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -static int TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); +static int TestopenfilechannelprocCmd _ANSI_ARGS_(( + ClientData dummy, Tcl_Interp *interp, int argc, + CONST char **argv)); static int TestsetplatformCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int PretendTclpStat _ANSI_ARGS_((CONST char *path, struct stat *buf)); static int TestStatProc1 _ANSI_ARGS_((CONST char *path, @@ -314,11 +314,11 @@ static int TestStatProc2 _ANSI_ARGS_((CONST char *path, static int TestStatProc3 _ANSI_ARGS_((CONST char *path, struct stat *buf)); static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestupvarCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestWrongNumArgsObjCmd _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -326,9 +326,9 @@ static int TestGetIndexFromObjStructObjCmd _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestChannelCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); /* Filesystem testing */ static int TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy, @@ -664,7 +664,7 @@ TestasyncCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TestAsyncHandler *asyncPtr, *prevPtr; int id, code; @@ -738,7 +738,7 @@ TestasyncCmd(dummy, interp, argc, argv) break; } } - Tcl_SetResult(interp, argv[3], TCL_VOLATILE); + Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE); return code; } else { Tcl_AppendResult(interp, "bad option \"", argv[1], @@ -757,8 +757,8 @@ AsyncHandlerProc(clientData, interp, code) int code; /* Current return code from command. */ { TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData; - CONST char *listArgv[4]; - char string[TCL_INTEGER_SPACE], *cmd; + CONST char *listArgv[4], *cmd; + char string[TCL_INTEGER_SPACE]; TclFormatInt(string, code); listArgv[0] = asyncPtr->command; @@ -775,7 +775,7 @@ AsyncHandlerProc(clientData, interp, code) * checking is needed here. */ } - ckfree(cmd); + ckfree((char *)cmd); return code; } @@ -803,7 +803,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_CmdInfo info; @@ -876,7 +876,7 @@ CmdProc1(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, (char *) NULL); @@ -889,7 +889,7 @@ CmdProc2(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, (char *) NULL); @@ -938,7 +938,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_Command token; int *l; @@ -1002,7 +1002,7 @@ TestcmdtraceCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_DString buffer; int result; @@ -1176,7 +1176,7 @@ TestcreatecommandCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -1209,7 +1209,7 @@ CreatedCommandProc(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_CmdInfo info; int found; @@ -1231,7 +1231,7 @@ CreatedCommandProc2(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_CmdInfo info; int found; @@ -1270,7 +1270,7 @@ TestdcallCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int i, id; @@ -1336,7 +1336,7 @@ TestdelCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { DelCmd *dPtr; Tcl_Interp *slave; @@ -1366,7 +1366,7 @@ DelCmdProc(clientData, interp, argc, argv) ClientData clientData; /* String result to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { DelCmd *dPtr = (DelCmd *) clientData; @@ -1411,7 +1411,7 @@ TestdelassocdataCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], @@ -1445,7 +1445,7 @@ TestdstringCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int count; @@ -1852,7 +1852,7 @@ TestexithandlerCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int value; @@ -1920,7 +1920,7 @@ TestexprlongCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { long exprResult; char buf[4 + TCL_INTEGER_SPACE]; @@ -1957,7 +1957,7 @@ TestexprstringCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], @@ -2057,7 +2057,7 @@ TestgetassocdataCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { char *res; @@ -2095,7 +2095,7 @@ TestgetplatformCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static CONST char *platformStrings[] = { "unix", "mac", "windows" }; TclPlatformType *platform; @@ -2140,7 +2140,7 @@ TestinterpdeleteCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_Interp *slaveToDelete; @@ -2181,7 +2181,7 @@ TestlinkCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static int intVar = 43; static int boolVar = 4; @@ -2826,7 +2826,7 @@ TestparsevarObjCmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects. */ { CONST char *value; - char *name, *termPtr; + CONST char *name, *termPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName"); @@ -3263,7 +3263,7 @@ TestsetassocdataCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { char *buf; char *oldData; @@ -3316,7 +3316,7 @@ TestsetplatformCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { size_t length; TclPlatformType *platform; @@ -3371,7 +3371,7 @@ TeststaticpkgCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int safe, loaded; @@ -3422,7 +3422,7 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_DString buffer; CONST char *result; @@ -3464,7 +3464,7 @@ TestupvarCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int flags = 0; @@ -3556,7 +3556,7 @@ TestfeventCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static Tcl_Interp *interp2 = NULL; int code; @@ -3628,18 +3628,18 @@ TestpanicCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { - char *argString; + CONST char *argString; /* * Put the arguments into a var args structure * Append all of the arguments together separated by spaces */ - argString = Tcl_Merge(argc-1, (CONST char **) argv+1); + argString = Tcl_Merge(argc-1, argv+1); panic(argString); - ckfree(argString); + ckfree((char *)argString); return TCL_OK; } @@ -3668,7 +3668,7 @@ TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int i, mode; char *rest; @@ -3871,7 +3871,7 @@ GetTimesCmd(unused, interp, argc, argv) ClientData unused; /* Unused. */ Tcl_Interp *interp; /* The current interpreter. */ int argc; /* The number of arguments. */ - char **argv; /* The argument strings. */ + CONST char **argv; /* The argument strings. */ { Interp *iPtr = (Interp *) interp; int i, n; @@ -4051,7 +4051,7 @@ NoopCmd(unused, interp, argc, argv) ClientData unused; /* Unused. */ Tcl_Interp *interp; /* The current interpreter. */ int argc; /* The number of arguments. */ - char **argv; /* The argument strings. */ + CONST char **argv; /* The argument strings. */ { return TCL_OK; } @@ -4106,7 +4106,7 @@ TestsetCmd(data, interp, argc, argv) ClientData data; /* Additional flags for Get/SetVar2. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int flags = (int) data; CONST char *value; @@ -4288,7 +4288,7 @@ TeststatprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TclStatProc_ *proc; int retVal; @@ -4476,7 +4476,7 @@ TestmainthreadCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc == 1) { Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread()); @@ -4536,7 +4536,7 @@ TestsetmainloopCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { exitMainLoop = 0; Tcl_SetMainLoop(MainLoop); @@ -4565,7 +4565,7 @@ TestexitmainloopCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { exitMainLoop = 1; return TCL_OK; @@ -4593,7 +4593,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TclAccessProc_ *proc; int retVal; @@ -4705,7 +4705,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TclOpenFileChannelProc_ *proc; int retVal; @@ -4904,9 +4904,9 @@ TestChannelCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter for result. */ int argc; /* Count of additional args. */ - char **argv; /* Additional arg strings. */ + CONST char **argv; /* Additional arg strings. */ { - char *cmdName; /* Sub command. */ + CONST char *cmdName; /* Sub command. */ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ @@ -5332,13 +5332,13 @@ TestChannelEventCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_Obj *resultListPtr; Channel *chanPtr; ChannelState *statePtr; /* state info for channel */ EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr; - char *cmd; + CONST char *cmd; int index, i, mask, len; if ((argc < 3) || (argc > 5)) { @@ -5602,7 +5602,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - CONST char *ary[] = { + char *ary[] = { "a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL }; int idx,target; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 897d743..0fccf95 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -8,7 +8,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtf.c,v 1.27 2002/07/19 12:31:10 dkf Exp $ + * RCS: @(#) $Id: tclUtf.c,v 1.28 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -778,129 +778,19 @@ Tcl_UtfBackslash(src, readPtr, dst) char *dst; /* Filled with the bytes represented by the * backslash sequence. */ { - register CONST char *p = src+1; - Tcl_UniChar result; - int count, n; - char buf[TCL_UTF_MAX]; - - if (dst == NULL) { - dst = buf; +#define LINE_LENGTH 128 + int numRead; + int result; + + result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); + if (numRead == LINE_LENGTH) { + /* We ate a whole line. Pay the price of a strlen() */ + result = TclParseBackslash(src, (int)strlen(src), &numRead, dst); } - - count = 2; - switch (*p) { - /* - * Note: in the conversions below, use absolute values (e.g., - * 0xa) rather than symbolic values (e.g. \n) that get converted - * by the compiler. It's possible that compilers on some - * platforms will do the symbolic conversions differently, which - * could result in non-portable Tcl scripts. - */ - - case 'a': - result = 0x7; - break; - case 'b': - result = 0x8; - break; - case 'f': - result = 0xc; - break; - case 'n': - result = 0xa; - break; - case 'r': - result = 0xd; - break; - case 't': - result = 0x9; - break; - case 'v': - result = 0xb; - break; - case 'x': - if (isxdigit(UCHAR(p[1]))) { /* INTL: digit */ - char *end; - - result = (unsigned char) strtoul(p+1, &end, 16); - count = end - src; - } else { - count = 2; - result = 'x'; - } - break; - case 'u': - result = 0; - for (count = 0; count < 4; count++) { - p++; - if (!isxdigit(UCHAR(*p))) { /* INTL: digit */ - break; - } - n = *p - '0'; - if (n > 9) { - n = n + '0' + 10 - 'A'; - } - if (n > 16) { - n = n + 'A' - 'a'; - } - result = (result << 4) + n; - } - if (count == 0) { - result = 'u'; - } - count += 2; - break; - - case '\n': - do { - p++; - } while ((*p == ' ') || (*p == '\t')); - result = ' '; - count = p - src; - break; - case 0: - result = '\\'; - count = 1; - break; - default: - /* - * Check for an octal number \oo?o? - */ - if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ - result = (unsigned char)(*p - '0'); - p++; - if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */ - break; - } - count = 3; - result = (unsigned char)((result << 3) + (*p - '0')); - p++; - if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */ - break; - } - count = 4; - result = (unsigned char)((result << 3) + (*p - '0')); - break; - } - if (UCHAR(*p) < UNICODE_SELF) { - result = *p; - count = 2; - } else { - /* - * We have to convert here because the user has put a - * backslash in front of a multi-byte utf-8 character. - * While this means nothing special, we shouldn't break up - * a correct utf-8 character. [Bug #217987] test subst-3.2 - */ - count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */ - } - break; - } - if (readPtr != NULL) { - *readPtr = count; + *readPtr = numRead; } - return Tcl_UniCharToUtf((int) result, dst); + return result; } /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index ff5e53a..683f752 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.32 2002/06/25 08:59:36 dkf Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.33 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -947,7 +947,7 @@ Tcl_Backslash(src, readPtr) *---------------------------------------------------------------------- */ -char * +CONST char * Tcl_Concat(argc, argv) int argc; /* Number of strings to concatenate. */ CONST char * CONST *argv; /* Array of strings to concatenate. */ @@ -1878,7 +1878,7 @@ char * TclPrecTraceProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter containing variable. */ - char *name1; /* Name of variable. */ + CONST char *name1; /* Name of variable. */ CONST char *name2; /* Second part of variable name. */ int flags; /* Information about what happened. */ { @@ -2124,38 +2124,28 @@ TclLooksLikeInt(bytes, length) * considered (if they may appear in an * integer). */ { - register CONST char *p, *end; + register CONST char *p; + + if ((bytes == NULL) && (length > 0)) { + Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length); + } if (length < 0) { - length = (bytes? strlen(bytes) : 0); + length = (bytes? strlen(bytes) : 0); } - end = (bytes + length); p = bytes; - while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */ - p++; + while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ + length--; p++; } - if (p == end) { - return 0; + if (length == 0) { + return 0; } - if ((*p == '+') || (*p == '-')) { - p++; - } - if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */ - return 0; - } - p++; - while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */ - p++; - } - if (p == end) { - return 1; + p++; length--; } - if ((*p != '.') && (*p != 'e') && (*p != 'E')) { - return 1; - } - return 0; + + return (0 != TclParseInteger(p, length)); } /* diff --git a/generic/tclVar.c b/generic/tclVar.c index b43778e..48cc6e1 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.62 2002/07/27 01:44:24 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.63 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -43,13 +43,13 @@ static CONST char *isArrayElement = "name refers to an element in an array"; */ static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr, - Var *varPtr, char *part1, CONST char *part2, + Var *varPtr, CONST char *part1, CONST char *part2, int flags, CONST int leaveErrMsg)); static void CleanupVar _ANSI_ARGS_((Var *varPtr, Var *arrayPtr)); static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr)); static void DeleteArray _ANSI_ARGS_((Interp *iPtr, - char *arrayName, Var *varPtr, int flags)); + CONST char *arrayName, Var *varPtr, int flags)); static void DisposeTraceResult _ANSI_ARGS_((int flags, char *result)); static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, @@ -182,7 +182,7 @@ Var * TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, arrayPtrPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ - register char *part1; /* If part2 isn't NULL, this is the name of + CONST char *part1; /* If part2 isn't NULL, this is the name of * an array. Otherwise, this * is a full variable name that could * include a parenthesized array element. */ @@ -206,19 +206,21 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, Var *varPtr; CONST char *elName; /* Name of array element or NULL; may be * same as part2, or may be openParen+1. */ - char *openParen, *closeParen; + int openParen, closeParen; /* If this procedure parses a name into - * array and index, these point to the - * parens around the index. Otherwise they - * are NULL. These are needed to restore - * the parens after parsing the name. */ - register char *p; + * array and index, these are the offsets to + * the parens around the index. Otherwise + * they are -1. */ + register CONST char *p; CONST char *errMsg = NULL; int index; +#define VAR_NAME_BUF_SIZE 26 + char buffer[VAR_NAME_BUF_SIZE]; + char *newVarName = buffer; varPtr = NULL; *arrayPtrPtr = NULL; - openParen = closeParen = NULL; + openParen = closeParen = -1; /* * Parse part1 into array name and index. @@ -233,7 +235,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, elName = part2; for (p = part1; *p ; p++) { if (*p == '(') { - openParen = p; + openParen = p - part1; do { p++; } while (*p != '\0'); @@ -245,16 +247,23 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, } return NULL; } - closeParen = p; - *openParen = 0; - *closeParen = 0; - elName = openParen+1; + closeParen = p - part1; } else { - openParen = NULL; + openParen = -1; } break; } } + if (openParen != -1) { + if (closeParen >= VAR_NAME_BUF_SIZE) { + newVarName = ckalloc((unsigned int) (closeParen+1)); + } + memcpy(newVarName, part1, (unsigned int) closeParen); + newVarName[openParen] = '\0'; + newVarName[closeParen] = '\0'; + part1 = newVarName; + elName = newVarName + openParen + 1; + } varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1, &errMsg, &index); @@ -272,12 +281,13 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, msg, createPart1, createPart2, varPtr); } } - - if (openParen != NULL) { - *openParen = '('; - *closeParen = ')'; + if (newVarName != buffer) { + ckfree(newVarName); } + return varPtr; + +#undef VAR_NAME_BUF_SIZE } /* @@ -969,7 +979,7 @@ CONST char * Tcl_GetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *varName; /* Name of a variable in interp. */ + CONST char *varName; /* Name of a variable in interp. */ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG * bits. */ @@ -1004,7 +1014,7 @@ CONST char * Tcl_GetVar2(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1048,7 +1058,7 @@ Tcl_Obj * Tcl_GetVar2Ex(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1159,7 +1169,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) register Var *varPtr; /* The variable to be read.*/ Var *arrayPtr; /* NULL for scalar variables, pointer to * the containing array otherwise. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1291,7 +1301,7 @@ CONST char * Tcl_SetVar(interp, varName, newValue, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *varName; /* Name of a variable in interp. */ + CONST char *varName; /* Name of a variable in interp. */ CONST char *newValue; /* New value for varName. */ int flags; /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, @@ -1332,7 +1342,7 @@ CONST char * Tcl_SetVar2(interp, part1, part2, newValue, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ - char *part1; /* If part2 is NULL, this is name of scalar + CONST char *part1; /* If part2 is NULL, this is name of scalar * variable. Otherwise it is the name of * an array. */ CONST char *part2; /* Name of an element within an array, or @@ -1405,7 +1415,7 @@ Tcl_Obj * Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be found. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1516,7 +1526,7 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) * to be looked up. */ register Var *varPtr; Var *arrayPtr; - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1772,7 +1782,7 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) * to be found. */ Var *varPtr; Var *arrayPtr; - char *part1; /* Points to an object holding the name of + CONST char *part1; /* Points to an object holding the name of * an array (if part2 is non-NULL) or the * name of a variable. */ CONST char *part2; /* If non-null, points to an object holding @@ -1877,7 +1887,7 @@ int Tcl_UnsetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *varName; /* Name of a variable in interp. May be + CONST char *varName; /* Name of a variable in interp. May be * either a scalar name or an array name * or an element in an array. */ int flags; /* OR-ed combination of any of @@ -1912,7 +1922,7 @@ int Tcl_UnsetVar2(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *part1; /* Name of variable or array. */ + CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, @@ -2124,7 +2134,7 @@ int Tcl_TraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is * to be traced. */ - char *varName; /* Name of variable; may end with "(index)" + CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed collection of bits, including any * of TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -2163,7 +2173,7 @@ int Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is * to be traced. */ - char *part1; /* Name of scalar variable or array. */ + CONST char *part1; /* Name of scalar variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ @@ -2241,7 +2251,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) void Tcl_UntraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *varName; /* Name of variable; may end with "(index)" + CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed collection of bits describing * current trace, including any of @@ -2275,7 +2285,7 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData) void Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *part1; /* Name of variable or array. */ + CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ @@ -2386,7 +2396,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) ClientData Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *varName; /* Name of variable; may end with "(index)" + CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ @@ -2421,7 +2431,7 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) ClientData Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *part1; /* Name of variable or array. */ + CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ @@ -3581,7 +3591,7 @@ Tcl_UpVar(interp, frameName, varName, localName, flags) * to be looked up. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ - char *varName; /* Name of a variable in interp to link to. + CONST char *varName; /* Name of a variable in interp to link to. * May be either a scalar name or an * element in an array. */ CONST char *localName; /* Name of link variable. */ @@ -3618,7 +3628,7 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) * for error messages too. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ - char *part1; + CONST char *part1; CONST char *part2; /* Two parts of source variable name to * link to. */ CONST char *localName; /* Name of link variable. */ @@ -4058,7 +4068,7 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) * isn't an element of an array. */ Var *varPtr; /* Variable whose traces are to be * invoked. */ - char *part1; + CONST char *part1; CONST char *part2; /* Variable's two-part name. */ int flags; /* Flags passed to trace procedures: * indicates what's happening to variable, @@ -4071,7 +4081,8 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) { register VarTrace *tracePtr; ActiveVarTrace active; - char *result, *openParen, *p; + char *result; + CONST char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; @@ -4111,11 +4122,13 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) p--; if (*p == ')') { int offset = (openParen - part1); + char *newPart1; Tcl_DStringInit(&nameCopy); Tcl_DStringAppend(&nameCopy, part1, (p-part1)); - part2 = Tcl_DStringValue(&nameCopy) + offset + 1; - part1 = Tcl_DStringValue(&nameCopy); - part1[offset] = 0; + newPart1 = Tcl_DStringValue(&nameCopy); + newPart1[offset] = 0; + part1 = newPart1; + part2 = newPart1 + offset + 1; copiedName = 1; } break; @@ -4727,7 +4740,7 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) static void DeleteArray(iPtr, arrayName, varPtr, flags) Interp *iPtr; /* Interpreter containing array. */ - char *arrayName; /* Name of array (used for trace + CONST char *arrayName; /* Name of array (used for trace * callbacks). */ Var *varPtr; /* Pointer to variable structure. */ int flags; /* Flags to pass to CallVarTraces: @@ -4886,7 +4899,7 @@ VarErrMsg(interp, part1, part2, operation, reason) Var * TclVarTraceExists(interp, varName) Tcl_Interp *interp; /* The interpreter */ - char *varName; /* The variable name */ + CONST char *varName; /* The variable name */ { Var *varPtr; Var *arrayPtr; diff --git a/mac/tclMacTest.c b/mac/tclMacTest.c index 9598848..92becad 100644 --- a/mac/tclMacTest.c +++ b/mac/tclMacTest.c @@ -9,11 +9,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacTest.c,v 1.4 1999/05/11 07:13:36 jingham Exp $ + * RCS: @(#) $Id: tclMacTest.c,v 1.5 2002/08/05 03:24:41 dgp Exp $ */ #define TCL_TEST - +#define USE_COMPAT_CONST #include "tclInt.h" #include "tclMacInt.h" #include "tclMacPort.h" diff --git a/tests/expr-old.test b/tests/expr-old.test index a90366e..32f737a 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -13,10 +13,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr-old.test,v 1.15 2002/07/26 18:51:02 msofer Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.16 2002/08/05 03:24:41 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2.1 namespace import -force ::tcltest::* } @@ -899,9 +899,9 @@ if $gotT1 { } {1 {too many arguments for math function}} } -test expr-old-36.1 {ExprLooksLikeInt procedure} { - list [catch {expr 0289} msg] $msg -} {1 {"0289" is an invalid octal number}} +test expr-old-36.1 {ExprLooksLikeInt procedure} -body { + expr 0289 +} -returnCodes error -match glob -result {*invalid octal number*} test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0289 list [catch {expr {$x+1}} msg] $msg diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 958c515..489e6d2 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -8,7 +8,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: parseExpr.test,v 1.7 2001/12/06 10:59:18 dkf Exp $ +# RCS: @(#) $Id: parseExpr.test,v 1.8 2002/08/05 03:24:41 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -509,9 +509,11 @@ test parseExpr-16.4 {GetLexeme procedure, integer lexeme} { test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big