Tcl Source Code

Check-in [2c2b2f27f3]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:
TIP #337 IMPLEMENTATION
* doc/BackgdErr.3: Converted internal routine * doc/interp.n: TclBackgroundException() into public routine * generic/tcl.decls: Tcl_BackgroundException(). * generic/tclEvent.c: * generic/tclInt.decls:
* generic/tclDecls.h: make genstubs * generic/tclIntDecls.h: * generic/tclStubInit.c:
* generic/tclIO.c: Update callers. * generic/tclIOCmd.c: * generic/tclInterp.c: * generic/tclTimer.c: *** POTENTIAL INCOMPATIBILITY only for extensions using the converted internal routine ***
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | potential incompatibility
Files: files | file ages | folders
SHA1: 2c2b2f27f3d1998e9f174196c4209f64daf896f2
User & Date: dgp 2008-12-09 20:16:29
Context
2008-12-09
21:47
restore source and binary compatibility for TIP #337 implementation. (when it's _that_ simple, there... check-in: 10911e26ab user: nijtmans tags: trunk
20:16
TIP #337 IMPLEMENTATION
* doc/BackgdErr.3: Converted internal routine ...
check-in: 2c2b2f27f3 user: dgp tags: trunk, potential incompatibility
14:09
A bit more readability refactoring. check-in: 579d74d29f user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






















1
2
3
4
5
6
7




















2008-12-09  Donal K. Fellows  <[email protected]>

	* generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the
	code to connect to channel drivers that was common in multiple
	locations so as to make code more readable.

2008-12-06  Donal K. Fellows  <[email protected]f.net>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
2008-12-09  Don Porter  <[email protected]>

	TIP #337 IMPLEMENTATION

	* doc/BackgdErr.3:	Converted internal routine
	* doc/interp.n:		TclBackgroundException() into public routine
	* generic/tcl.decls:	Tcl_BackgroundException().
	* generic/tclEvent.c:
	* generic/tclInt.decls:

	* generic/tclDecls.h:	make genstubs
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

	* generic/tclIO.c:	Update callers.
	* generic/tclIOCmd.c:
	* generic/tclInterp.c:
	* generic/tclTimer.c:
	*** POTENTIAL INCOMPATIBILITY only for extensions using the converted
	internal routine ***

2008-12-09  Donal K. Fellows  <[email protected]>

	* generic/tclIO.c (ChanClose,ChanRead,...): Factored out some of the
	code to connect to channel drivers that was common in multiple
	locations so as to make code more readable.

2008-12-06  Donal K. Fellows  <[email protected]>

Changes to doc/BackgdErr.3.

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
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: BackgdErr.3,v 1.8 2007/12/13 15:22:30 dgp Exp $
'\" 
.so man.macros
.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_BackgroundError \- report Tcl error that occurred in background processing
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR


.sp
\fBTcl_BackgroundError\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter in which the error occurred.


.BE

.SH DESCRIPTION
.PP
This procedure is typically invoked when a Tcl error occurs during

.QW "background processing"
such as executing an event handler.
When such an error occurs, the error condition is reported to Tcl
or to a widget or some other C code, and there is not usually any
obvious way for that code to report the error to the user.
In these cases the code calls \fBTcl_BackgroundError\fR with an
\fIinterp\fR argument identifying the interpreter in which the
error occurred.  At the time \fBTcl_BackgroundError\fR is invoked,
the interpreter's result is expected to contain an error message.




\fBTcl_BackgroundError\fR will invoke the command registered
in that interpreter to handle background errors by the
\fBinterp bgerror\fR command.

The registered handler command is meant to report the error
in an application-specific fashion.  The handler command
receives two arguments, the result of the interp, and the
return options of the interp at the time the error occurred.
If the application registers no handler command, the default
handler command will attempt to call \fBbgerror\fR to report
the error.  If an error condition arises while invoking the
handler command, then \fBTcl_BackgroundError\fR reports the
error itself by printing a message on the standard error file.
.PP
\fBTcl_BackgroundError\fR does not invoke the handler command immediately
because this could potentially interfere with scripts that are in process
at the time the error occurred.
Instead, it invokes the handler command later as an idle callback.
.PP
It is possible for many background errors to accumulate before
the handler command is invoked.  When this happens, each of the errors
is processed in order.  However, if the handle command returns a
break exception, then all remaining error reports for the
interpreter are skipped.









.SH KEYWORDS
background, bgerror, error, interp






|





|



>
>





|
>
>




|
>


|

|
|

<
|
>
>
>
>
|

|
>
|






|


|




|
|
|


>
>
>
>
>
>
>
>



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
'\"
'\" Copyright (c) 1992-1994 The Regents of the University of California.
'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: BackgdErr.3,v 1.9 2008/12/09 20:16:29 dgp Exp $
'\" 
.so man.macros
.TH Tcl_BackgroundError 3 7.5 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_BackgroundException, Tcl_BackgroundError \- report Tcl exception that occurred in background processing
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
\fBTcl_BackgroundException\fR(\fIinterp, code\fR)
.sp
\fBTcl_BackgroundError\fR(\fIinterp\fR)
.SH ARGUMENTS
.AS Tcl_Interp *interp
.AP Tcl_Interp *interp in
Interpreter in which the exception occurred.
.AP int code in
The exceptional return code to be reported.
.BE

.SH DESCRIPTION
.PP
This procedure is typically invoked when a Tcl exception (any
return code other than TCL_OK) occurs during
.QW "background processing"
such as executing an event handler.
When such an exception occurs, the condition is reported to Tcl
or to a widget or some other C code, and there is not usually any
obvious way for that code to report the exception to the user.
In these cases the code calls \fBTcl_BackgroundException\fR with an
\fIinterp\fR argument identifying the interpreter in which the

exception occurred, and a \fIcode\fR argument holding the return
code value of the exception.  The state of the interpreter, including
any error message in the interpreter result, and the values of
any entries in the return options dictionary, is captured and
saved.  \fBTcl_BackgroundException\fR then arranges for the event
loop to invoke at some later time the command registered
in that interpreter to handle background errors by the
\fBinterp bgerror\fR command, passing the captured values as
arguments.
The registered handler command is meant to report the exception
in an application-specific fashion.  The handler command
receives two arguments, the result of the interp, and the
return options of the interp at the time the error occurred.
If the application registers no handler command, the default
handler command will attempt to call \fBbgerror\fR to report
the error.  If an error condition arises while invoking the
handler command, then \fBTcl_BackgroundException\fR reports the
error itself by printing a message on the standard error file.
.PP
\fBTcl_BackgroundException\fR does not invoke the handler command immediately
because this could potentially interfere with scripts that are in process
at the time the error occurred.
Instead, it invokes the handler command later as an idle callback.
.PP
It is possible for many background exceptions to accumulate before
the handler command is invoked.  When this happens, each of the exceptions
is processed in order.  However, if the handler command returns a
break exception, then all remaining error reports for the
interpreter are skipped.
.PP
The \fBTcl_BackgroundError\fR routine is an older and simpler interface
useful when the exception code reported is \fBTCL_ERROR\fR.  It is
equivalent to:
.PP
.CS
Tcl_BackgroundException(interp, TCL_ERROR);
.CE

.SH KEYWORDS
background, bgerror, error, interp

Changes to doc/interp.n.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
...
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
...
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808


809
810
811
812
813
814
815
816
...
845
846
847
848
849
850
851
852
853
854
855
856
857
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2004 Donal K. Fellows
'\" Copyright (c) 2006-2008 Joe Mistachkin.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: interp.n,v 1.41 2008/10/17 10:22:25 dkf Exp $
'\" 
.so man.macros
.TH interp n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
interp \- Create and manipulate Tcl interpreters
................................................................................
aliases defined in the interpreter identified by \fIpath\fR. The tokens
correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fBinterp bgerror \fIpath\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background error handler
for the interpreter identified by \fIpath\fR. If \fIcmdPrefix\fR is
absent, the current background error handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background error to. See the
\fBBACKGROUND ERROR HANDLING\fR section for more details.
.TP
\fBinterp\fR \fBcancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR?
.VS 8.6
Cancels the script being evaluated in the interpreter identified by
\fIpath\fR. Without the \fB\-unwind\fR switch the evaluation stack for
the interpreter is unwound until an enclosing catch command is found or
there are no further invocations of the interpreter left on the call
................................................................................
See \fBALIAS INVOCATION\fR below for details.
The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background error handler
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background error handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background error to. See the
\fBBACKGROUND ERROR HANDLING\fR section for more details.
.TP
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
the resulting string as a Tcl script in \fIslave\fR.
The result of this evaluation (including all \fBreturn\fR options,
................................................................................
.TP
\fB\-command\fR
.
This option (common for all limit types) specifies (if non-empty) a Tcl script
to be executed in the global namespace of the interpreter reading and writing
the option when the particular limit in the limited interpreter is exceeded.
The callback may modify the limit on the interpreter if it wishes the limited
interpreter to continue executing. If the callback generates an error, it is
reported through the background error mechanism (see \fBBACKGROUND ERROR
HANDLING\fR). Note that the callbacks defined by one interpreter are
completely isolated from the callbacks defined by another, and that the order
in which those callbacks are called is undefined.
.TP
\fB\-granularity\fR
.
This option (common for all limit types) specifies how frequently (out of the
................................................................................
interpreter, that slave interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating master
interpreter. If the master interpreter of the limited master wishes to relax
these conditions, it should hide the \fBinterp\fR command in the child and
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
access as it chooses to the \fBinterp\fR command to the limited master as
necessary.
.SH "BACKGROUND ERROR HANDLING"
.PP
When an error happens in a situation where it cannot be reported directly up
the stack (e.g. when processing events in an \fBupdate\fR or \fBvwait\fR call)
the error is instead reported through the background error handling mechanism.
Every interpreter has a background error handler registered; the default error
handler arranges for the \fBbgerror\fR command in the interpreter's global
namespace to be called, but other error handlers may be installed and process
background errors in substantially different ways.
.PP
A background error handler consists of a non-empty list of words to which will
be appended two further words at invocation time. The first word will be the
error message string, and the second will a dictionary of return options (this
is also the sort of information that can be obtained by trapping a normal


error using \fBcatch\fR of course.) The resulting list will then be executed
in the interpreter's global namespace without further substitutions being
performed.
.SH CREDITS
The safe interpreter mechanism is based on the Safe-Tcl prototype implemented
by Nathaniel Borenstein and Marshall Rose.
.SH EXAMPLES
.PP
................................................................................
   set x 0
   while {1} {
      puts "Counting up... [incr x]"
   }
}
.CE
.SH "SEE ALSO"
bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3)
.SH KEYWORDS
alias, master interpreter, safe interpreter, slave interpreter
'\"Local Variables:
'\"mode: nroff
'\"End:






|







 







|

|

|
|







 







|

|

|
|







 







|
|







 







|

|

|
|

|
|

|

|
|
>
>
|







 







|





2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
...
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
...
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
...
847
848
849
850
851
852
853
854
855
856
857
858
859
'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
'\" Copyright (c) 2004 Donal K. Fellows
'\" Copyright (c) 2006-2008 Joe Mistachkin.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
'\" RCS: @(#) $Id: interp.n,v 1.42 2008/12/09 20:16:29 dgp Exp $
'\" 
.so man.macros
.TH interp n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
interp \- Create and manipulate Tcl interpreters
................................................................................
aliases defined in the interpreter identified by \fIpath\fR. The tokens
correspond to the values returned when
the aliases were created (which may not be the same
as the current names of the commands).
.TP
\fBinterp bgerror \fIpath\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
for the interpreter identified by \fIpath\fR. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
\fBinterp\fR \fBcancel \fR?\fB\-unwind\fR? ?\fB\-\|\-\fR? ?\fIpath\fR? ?\fIresult\fR?
.VS 8.6
Cancels the script being evaluated in the interpreter identified by
\fIpath\fR. Without the \fB\-unwind\fR switch the evaluation stack for
the interpreter is unwound until an enclosing catch command is found or
there are no further invocations of the interpreter left on the call
................................................................................
See \fBALIAS INVOCATION\fR below for details.
The command returns a token that uniquely identifies the command created
\fIsrcCmd\fR, even if the command is renamed afterwards. The token may but
does not have to be equal to \fIsrcCmd\fR.
.TP
\fIslave \fBbgerror\fR ?\fIcmdPrefix\fR?
.
This command either gets or sets the current background exception handler
for the \fIslave\fR interpreter. If \fIcmdPrefix\fR is
absent, the current background exception handler is returned, and if it is
present, it is a list of words (of minimum length one) that describes
what to set the interpreter's background exception handler to. See the
\fBBACKGROUND EXCEPTION HANDLING\fR section for more details.
.TP
\fIslave \fBeval \fIarg \fR?\fIarg ..\fR?
.
This command concatenates all of the \fIarg\fR arguments in
the same fashion as the \fBconcat\fR command, then evaluates
the resulting string as a Tcl script in \fIslave\fR.
The result of this evaluation (including all \fBreturn\fR options,
................................................................................
.TP
\fB\-command\fR
.
This option (common for all limit types) specifies (if non-empty) a Tcl script
to be executed in the global namespace of the interpreter reading and writing
the option when the particular limit in the limited interpreter is exceeded.
The callback may modify the limit on the interpreter if it wishes the limited
interpreter to continue executing. If the callback generates an exception, it is
reported through the background exception mechanism (see \fBBACKGROUND EXCEPTION
HANDLING\fR). Note that the callbacks defined by one interpreter are
completely isolated from the callbacks defined by another, and that the order
in which those callbacks are called is undefined.
.TP
\fB\-granularity\fR
.
This option (common for all limit types) specifies how frequently (out of the
................................................................................
interpreter, that slave interpreter will have resource limits imposed on it
that are at least as restrictive as the limits on the creating master
interpreter. If the master interpreter of the limited master wishes to relax
these conditions, it should hide the \fBinterp\fR command in the child and
then use aliases and the \fBinterp invokehidden\fR subcommand to provide such
access as it chooses to the \fBinterp\fR command to the limited master as
necessary.
.SH "BACKGROUND EXCEPTION HANDLING"
.PP
When an exception happens in a situation where it cannot be reported directly up
the stack (e.g. when processing events in an \fBupdate\fR or \fBvwait\fR call)
the exception is instead reported through the background exception handling mechanism.
Every interpreter has a background exception handler registered; the default exception
handler arranges for the \fBbgerror\fR command in the interpreter's global
namespace to be called, but other exception handlers may be installed and process
background exceptions in substantially different ways.
.PP
A background exception handler consists of a non-empty list of words to which will
be appended two further words at invocation time. The first word will be the
interpreter result at time of the exception, typically an error message,
and the second will be the dictionary of return options at the time of
the exception.  These are the same values that \fBcatch\fR can capture
when it controls script evaluation in a non-background situation.
The resulting list will then be executed
in the interpreter's global namespace without further substitutions being
performed.
.SH CREDITS
The safe interpreter mechanism is based on the Safe-Tcl prototype implemented
by Nathaniel Borenstein and Marshall Rose.
.SH EXAMPLES
.PP
................................................................................
   set x 0
   while {1} {
      puts "Counting up... [incr x]"
   }
}
.CE
.SH "SEE ALSO"
bgerror(n), load(n), safe(n), Tcl_CreateSlave(3), Tcl_Eval(3), Tcl_BackgroundException(3)
.SH KEYWORDS
alias, master interpreter, safe interpreter, slave interpreter
'\"Local Variables:
'\"mode: nroff
'\"End:

Changes to generic/tcl.decls.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2212
2213
2214
2215
2216
2217
2218





2219
2220
2221
2222
2223
2224
2225
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tcl.decls,v 1.157 2008/12/05 21:38:47 dkf Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
	    Tcl_Interp *targetInterp)
}

# TIP#335 (detect if interpreter in use)
declare 608 generic {
    int Tcl_InterpActive(Tcl_Interp *interp)
}






##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat






|







 







>
>
>
>
>







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
....
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: tcl.decls,v 1.158 2008/12/09 20:16:29 dgp Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
	    Tcl_Interp *targetInterp)
}

# TIP#335 (detect if interpreter in use)
declare 608 generic {
    int Tcl_InterpActive(Tcl_Interp *interp)
}

# TIP 337
declare 609 generic {
    void Tcl_BackgroundException(Tcl_Interp *interp, int code)
}

##############################################################################

# Define the platform specific public Tcl interface. These functions are only
# available on the designated platform.

interface tclPlat

Changes to generic/tclDecls.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
3677
3678
3679
3680
3681
3682
3683






3684
3685
3686
3687
3688
3689
3690
....
4345
4346
4347
4348
4349
4350
4351

4352
4353
4354
4355
4356
4357
4358
....
6853
6854
6855
6856
6857
6858
6859




6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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.159 2008/12/05 21:40:38 dkf Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
................................................................................
				int result, Tcl_Interp * targetInterp);
#endif
#ifndef Tcl_InterpActive_TCL_DECLARED
#define Tcl_InterpActive_TCL_DECLARED
/* 608 */
EXTERN int		Tcl_InterpActive (Tcl_Interp * interp);
#endif







typedef struct TclStubHooks {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_SetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * paramList); /* 602 */
    int (*tcl_GetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** paramListPtr); /* 603 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp * interp, const Tcl_ArgvInfo * argTable, int * objcPtr, Tcl_Obj *const * objv, Tcl_Obj *** remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp * interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp * interp, int value); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp * sourceInterp, int result, Tcl_Interp * targetInterp); /* 607 */
    int (*tcl_InterpActive) (Tcl_Interp * interp); /* 608 */

} TclStubs;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
extern const TclStubs *tclStubsPtr;
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
................................................................................
#define Tcl_TransferResult \
	(tclStubsPtr->tcl_TransferResult) /* 607 */
#endif
#ifndef Tcl_InterpActive
#define Tcl_InterpActive \
	(tclStubsPtr->tcl_InterpActive) /* 608 */
#endif





#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLDECLS */







|







 







>
>
>
>
>
>







 







>







 







>
>
>
>










4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
....
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
....
6860
6861
6862
6863
6864
6865
6866
6867
6868
6869
6870
6871
6872
6873
6874
6875
6876
6877
6878
6879
6880
 *	Declarations of functions in the platform independent public Tcl API.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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.160 2008/12/09 20:16:29 dgp Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
................................................................................
				int result, Tcl_Interp * targetInterp);
#endif
#ifndef Tcl_InterpActive_TCL_DECLARED
#define Tcl_InterpActive_TCL_DECLARED
/* 608 */
EXTERN int		Tcl_InterpActive (Tcl_Interp * interp);
#endif
#ifndef Tcl_BackgroundException_TCL_DECLARED
#define Tcl_BackgroundException_TCL_DECLARED
/* 609 */
EXTERN void		Tcl_BackgroundException (Tcl_Interp * interp,
				int code);
#endif

typedef struct TclStubHooks {
    const struct TclPlatStubs *tclPlatStubs;
    const struct TclIntStubs *tclIntStubs;
    const struct TclIntPlatStubs *tclIntPlatStubs;
} TclStubHooks;

................................................................................
    int (*tcl_SetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * paramList); /* 602 */
    int (*tcl_GetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** paramListPtr); /* 603 */
    int (*tcl_ParseArgsObjv) (Tcl_Interp * interp, const Tcl_ArgvInfo * argTable, int * objcPtr, Tcl_Obj *const * objv, Tcl_Obj *** remObjv); /* 604 */
    int (*tcl_GetErrorLine) (Tcl_Interp * interp); /* 605 */
    void (*tcl_SetErrorLine) (Tcl_Interp * interp, int value); /* 606 */
    void (*tcl_TransferResult) (Tcl_Interp * sourceInterp, int result, Tcl_Interp * targetInterp); /* 607 */
    int (*tcl_InterpActive) (Tcl_Interp * interp); /* 608 */
    void (*tcl_BackgroundException) (Tcl_Interp * interp, int code); /* 609 */
} TclStubs;

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
extern const TclStubs *tclStubsPtr;
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
................................................................................
#define Tcl_TransferResult \
	(tclStubsPtr->tcl_TransferResult) /* 607 */
#endif
#ifndef Tcl_InterpActive
#define Tcl_InterpActive \
	(tclStubsPtr->tcl_InterpActive) /* 608 */
#endif
#ifndef Tcl_BackgroundException
#define Tcl_BackgroundException \
	(tclStubsPtr->tcl_BackgroundException) /* 609 */
#endif

#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCLDECLS */

Changes to generic/tclEvent.c.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Zoran Vasiljevic.
 *
 * 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.85 2008/10/26 18:34:04 dkf Exp $
 */

#include "tclInt.h"

/*
 * The data structure below is used to report background errors. One such
 * structure is allocated for each error; it holds information about the
................................................................................
 */

void
Tcl_BackgroundError(
    Tcl_Interp *interp)		/* Interpreter in which an error has
				 * occurred. */
{
    TclBackgroundException(interp, TCL_ERROR);
}
void
TclBackgroundException(
    Tcl_Interp *interp,		/* Interpreter in which an exception has
				 * occurred. */
    int code)			/* The exception code value */
{
    BgError *errPtr;
    ErrAssocData *assocPtr;

................................................................................
    if (level != 0) {
	/* We're handling a TCL_RETURN exception */
	code = TCL_RETURN;
    }
    if (code == TCL_OK) {
	/*
	 * Somehow we got to exception handling with no exception.
	 * (Pass TCL_OK to TclBackgroundException()?)
	 * Just return without doing anything.
	 */
	return TCL_OK;
    }

    /* Construct the bgerror command */
    TclNewLiteralStringObj(tempObjv[0], "bgerror");






|







 







|


|







 







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
...
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
 * Copyright (c) 1990-1994 The Regents of the University of California.
 * Copyright (c) 1994-1998 Sun Microsystems, Inc.
 * Copyright (c) 2004 by Zoran Vasiljevic.
 *
 * 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.86 2008/12/09 20:16:29 dgp Exp $
 */

#include "tclInt.h"

/*
 * The data structure below is used to report background errors. One such
 * structure is allocated for each error; it holds information about the
................................................................................
 */

void
Tcl_BackgroundError(
    Tcl_Interp *interp)		/* Interpreter in which an error has
				 * occurred. */
{
    Tcl_BackgroundException(interp, TCL_ERROR);
}
void
Tcl_BackgroundException(
    Tcl_Interp *interp,		/* Interpreter in which an exception has
				 * occurred. */
    int code)			/* The exception code value */
{
    BgError *errPtr;
    ErrAssocData *assocPtr;

................................................................................
    if (level != 0) {
	/* We're handling a TCL_RETURN exception */
	code = TCL_RETURN;
    }
    if (code == TCL_OK) {
	/*
	 * Somehow we got to exception handling with no exception.
	 * (Pass TCL_OK to Tcl_BackgroundException()?)
	 * Just return without doing anything.
	 */
	return TCL_OK;
    }

    /* Construct the bgerror command */
    TclNewLiteralStringObj(tempObjv[0], "bgerror");

Changes to generic/tclIO.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
8317
....
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820
8821
8822
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIO.c,v 1.152 2008/12/09 14:09:14 dkf Exp $
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>

/*
................................................................................
     * because the background error may want to reinstall the handler.
     */

    if (result != TCL_OK) {
	if (chanPtr->typePtr != NULL) {
	    DeleteScriptRecord(interp, chanPtr, mask);
	}
	TclBackgroundException(interp, result);
    }
    Tcl_Release(interp);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
	if (errObj) {
	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
	}
	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
	if (code != TCL_OK) {
	    TclBackgroundException(interp, code);
	    result = TCL_ERROR;
	}
	TclDecrRefCount(cmdPtr);
	Tcl_Release(interp);
    } else {
	StopCopy(csPtr);
	if (interp) {






|







 







|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
8317
....
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820
8821
8822
 *
 * Copyright (c) 1998-2000 Ajuba Solutions
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIO.c,v 1.153 2008/12/09 20:16:29 dgp Exp $
 */

#include "tclInt.h"
#include "tclIO.h"
#include <assert.h>

/*
................................................................................
     * because the background error may want to reinstall the handler.
     */

    if (result != TCL_OK) {
	if (chanPtr->typePtr != NULL) {
	    DeleteScriptRecord(interp, chanPtr, mask);
	}
	Tcl_BackgroundException(interp, result);
    }
    Tcl_Release(interp);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................

	Tcl_ListObjAppendElement(interp, cmdPtr, Tcl_NewIntObj(total));
	if (errObj) {
	    Tcl_ListObjAppendElement(interp, cmdPtr, errObj);
	}
	code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL);
	if (code != TCL_OK) {
	    Tcl_BackgroundException(interp, code);
	    result = TCL_ERROR;
	}
	TclDecrRefCount(cmdPtr);
	Tcl_Release(interp);
    } else {
	StopCopy(csPtr);
	if (interp) {

Changes to generic/tclIOCmd.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOCmd.c,v 1.59 2008/10/16 22:34:19 nijtmans Exp $
 */

#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */
................................................................................
	 */

	Tcl_RegisterChannel(NULL, chan);

	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
		" ", address, " ", portBuf, NULL);
	if (result != TCL_OK) {
	    TclBackgroundException(interp, result);
	    Tcl_UnregisterChannel(interp, chan);
	}

	/*
	 * Decrement the artificially bumped refcount. After this it is not
	 * safe anymore to use "chan", because it may now be deleted.
	 */






|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
 *	Contains the definitions of most of the Tcl commands relating to IO.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclIOCmd.c,v 1.60 2008/12/09 20:16:29 dgp Exp $
 */

#include "tclInt.h"

/*
 * Callback structure for accept callback in a TCP server.
 */
................................................................................
	 */

	Tcl_RegisterChannel(NULL, chan);

	result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
		" ", address, " ", portBuf, NULL);
	if (result != TCL_OK) {
	    Tcl_BackgroundException(interp, result);
	    Tcl_UnregisterChannel(interp, chan);
	}

	/*
	 * Decrement the artificially bumped refcount. After this it is not
	 * safe anymore to use "chan", because it may now be deleted.
	 */

Changes to generic/tclInt.decls.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
929
930
931
932
933
934
935

936
937
938

939
940
941
942
943
944
945
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# 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.129 2008/10/22 20:23:59 nijtmans Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

................................................................................
             int *newPtr)
}
declare 235 generic {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}



declare 236 generic {
    void TclBackgroundException(Tcl_Interp *interp, int code)
}


# TIP #285: Script cancellation support.
declare 237 generic {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to






|







 







>
|
|
<
>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
...
929
930
931
932
933
934
935
936
937
938

939
940
941
942
943
944
945
946
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 2001 by Kevin B. Kenny.  All rights reserved.
# Copyright (c) 2007 Daniel A. Steffen <[email protected]>
#
# 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.130 2008/12/09 20:16:29 dgp Exp $

library tcl

# Define the unsupported generic interfaces.

interface tclInt

................................................................................
             int *newPtr)
}
declare 235 generic {
    void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}


# TIP 337 made this one public
#declare 236 generic {
#    void TclBackgroundException(Tcl_Interp *interp, int code)

#}

# TIP #285: Script cancellation support.
declare 237 generic {
    int TclResetCancellation(Tcl_Interp *interp, int force)
}

# NRE functions for "rogue" extensions to exploit NRE; they will need to

Changes to generic/tclIntDecls.h.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
....
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
....
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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.125 2008/10/22 20:23:59 nijtmans Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

................................................................................
#endif
#ifndef TclInitVarHashTable_TCL_DECLARED
#define TclInitVarHashTable_TCL_DECLARED
/* 235 */
EXTERN void		TclInitVarHashTable (TclVarHashTable * tablePtr,
				Namespace * nsPtr);
#endif
#ifndef TclBackgroundException_TCL_DECLARED
#define TclBackgroundException_TCL_DECLARED
/* 236 */
EXTERN void		TclBackgroundException (Tcl_Interp * interp,
				int code);
#endif
#ifndef TclResetCancellation_TCL_DECLARED
#define TclResetCancellation_TCL_DECLARED
/* 237 */
EXTERN int		TclResetCancellation (Tcl_Interp * interp, int force);
#endif
#ifndef TclNRInterpProc_TCL_DECLARED
#define TclNRInterpProc_TCL_DECLARED
................................................................................
    int (*tclPtrMakeUpvar) (Tcl_Interp * interp, Var * otherP1Ptr, const char * myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp * interp, Tcl_Obj * part1Ptr, const char * part2, int flags, const char * msg, const int createPart1, const int createPart2, Var ** arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Namespace ** nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame * contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable * tablePtr, Namespace * nsPtr); /* 235 */
    void (*tclBackgroundException) (Tcl_Interp * interp, int code); /* 236 */
    int (*tclResetCancellation) (Tcl_Interp * interp, int force); /* 237 */
    int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp * interp, Tcl_Obj * procNameObj, int skip, ProcErrorProc errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp * interp, int result, struct TEOV_callback * rootPtr, int tebcCall); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp * interp, int objc, Tcl_Obj *const objv[], int flags, Command * cmdPtr); /* 242 */
} TclIntStubs;
................................................................................
#define TclVarHashCreateVar \
	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#endif
#ifndef TclInitVarHashTable
#define TclInitVarHashTable \
	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
#endif
#ifndef TclBackgroundException
#define TclBackgroundException \
	(tclIntStubsPtr->tclBackgroundException) /* 236 */
#endif
#ifndef TclResetCancellation
#define TclResetCancellation \
	(tclIntStubsPtr->tclResetCancellation) /* 237 */
#endif
#ifndef TclNRInterpProc
#define TclNRInterpProc \
	(tclIntStubsPtr->tclNRInterpProc) /* 238 */






|







 







|
<
<
<
<
<







 







|







 







|
<
<
<







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
....
1055
1056
1057
1058
1059
1060
1061
1062





1063
1064
1065
1066
1067
1068
1069
....
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
....
2101
2102
2103
2104
2105
2106
2107
2108



2109
2110
2111
2112
2113
2114
2115
 *	versions.  Use at your own risk.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * 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.126 2008/12/09 20:16:30 dgp Exp $
 */

#ifndef _TCLINTDECLS
#define _TCLINTDECLS

#include "tclPort.h"

................................................................................
#endif
#ifndef TclInitVarHashTable_TCL_DECLARED
#define TclInitVarHashTable_TCL_DECLARED
/* 235 */
EXTERN void		TclInitVarHashTable (TclVarHashTable * tablePtr,
				Namespace * nsPtr);
#endif
/* Slot 236 is reserved */





#ifndef TclResetCancellation_TCL_DECLARED
#define TclResetCancellation_TCL_DECLARED
/* 237 */
EXTERN int		TclResetCancellation (Tcl_Interp * interp, int force);
#endif
#ifndef TclNRInterpProc_TCL_DECLARED
#define TclNRInterpProc_TCL_DECLARED
................................................................................
    int (*tclPtrMakeUpvar) (Tcl_Interp * interp, Var * otherP1Ptr, const char * myName, int myFlags, int index); /* 229 */
    Var * (*tclObjLookupVar) (Tcl_Interp * interp, Tcl_Obj * part1Ptr, const char * part2, int flags, const char * msg, const int createPart1, const int createPart2, Var ** arrayPtrPtr); /* 230 */
    int (*tclGetNamespaceFromObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Namespace ** nsPtrPtr); /* 231 */
    int (*tclEvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 232 */
    void (*tclGetSrcInfoForPc) (CmdFrame * contextPtr); /* 233 */
    Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */
    void (*tclInitVarHashTable) (TclVarHashTable * tablePtr, Namespace * nsPtr); /* 235 */
    void *reserved236;
    int (*tclResetCancellation) (Tcl_Interp * interp, int force); /* 237 */
    int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *const objv[]); /* 238 */
    int (*tclNRInterpProcCore) (Tcl_Interp * interp, Tcl_Obj * procNameObj, int skip, ProcErrorProc errorProc); /* 239 */
    int (*tclNRRunCallbacks) (Tcl_Interp * interp, int result, struct TEOV_callback * rootPtr, int tebcCall); /* 240 */
    int (*tclNREvalObjEx) (Tcl_Interp * interp, Tcl_Obj * objPtr, int flags, const CmdFrame * invoker, int word); /* 241 */
    int (*tclNREvalObjv) (Tcl_Interp * interp, int objc, Tcl_Obj *const objv[], int flags, Command * cmdPtr); /* 242 */
} TclIntStubs;
................................................................................
#define TclVarHashCreateVar \
	(tclIntStubsPtr->tclVarHashCreateVar) /* 234 */
#endif
#ifndef TclInitVarHashTable
#define TclInitVarHashTable \
	(tclIntStubsPtr->tclInitVarHashTable) /* 235 */
#endif
/* Slot 236 is reserved */



#ifndef TclResetCancellation
#define TclResetCancellation \
	(tclIntStubsPtr->tclResetCancellation) /* 237 */
#endif
#ifndef TclNRInterpProc
#define TclNRInterpProc \
	(tclIntStubsPtr->tclNRInterpProc) /* 238 */

Changes to generic/tclInterp.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
....
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2004 Donal K. Fellows
 *
 * 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.98 2008/12/05 14:27:36 dkf Exp $
 */

#include "tclInt.h"

/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script
................................................................................
    int code;

    Tcl_Preserve(interp);
    ((Interp *) interp)->limit.timeEvent = NULL;
    code = Tcl_LimitCheck(interp);
    if (code != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
	TclBackgroundException(interp, code);
    }
    Tcl_Release(interp);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;
    }
    Tcl_Preserve(limitCBPtr->interp);
    code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
	    TCL_EVAL_GLOBAL);
    if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
	TclBackgroundException(limitCBPtr->interp, code);
    }
    Tcl_Release(limitCBPtr->interp);
}
 
/*
 *----------------------------------------------------------------------
 *






|







 







|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
....
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
3941
3942
3943
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2004 Donal K. Fellows
 *
 * 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.99 2008/12/09 20:16:30 dgp Exp $
 */

#include "tclInt.h"

/*
 * A pointer to a string that holds an initialization script that if non-NULL
 * is evaluated in Tcl_Init() prior to the built-in initialization script
................................................................................
    int code;

    Tcl_Preserve(interp);
    ((Interp *) interp)->limit.timeEvent = NULL;
    code = Tcl_LimitCheck(interp);
    if (code != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (while waiting for event)");
	Tcl_BackgroundException(interp, code);
    }
    Tcl_Release(interp);
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
    if (Tcl_InterpDeleted(limitCBPtr->interp)) {
	return;
    }
    Tcl_Preserve(limitCBPtr->interp);
    code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj,
	    TCL_EVAL_GLOBAL);
    if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) {
	Tcl_BackgroundException(limitCBPtr->interp, code);
    }
    Tcl_Release(limitCBPtr->interp);
}
 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclStubInit.c.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
....
1130
1131
1132
1133
1134
1135
1136

1137
1138
1139
1140
1141
1142
1143
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.170 2008/12/05 21:40:38 dkf Exp $
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    TclPtrMakeUpvar, /* 229 */
    TclObjLookupVar, /* 230 */
    TclGetNamespaceFromObj, /* 231 */
    TclEvalObjEx, /* 232 */
    TclGetSrcInfoForPc, /* 233 */
    TclVarHashCreateVar, /* 234 */
    TclInitVarHashTable, /* 235 */
    TclBackgroundException, /* 236 */
    TclResetCancellation, /* 237 */
    TclNRInterpProc, /* 238 */
    TclNRInterpProcCore, /* 239 */
    TclNRRunCallbacks, /* 240 */
    TclNREvalObjEx, /* 241 */
    TclNREvalObjv, /* 242 */
};
................................................................................
    Tcl_SetEnsembleParameterList, /* 602 */
    Tcl_GetEnsembleParameterList, /* 603 */
    Tcl_ParseArgsObjv, /* 604 */
    Tcl_GetErrorLine, /* 605 */
    Tcl_SetErrorLine, /* 606 */
    Tcl_TransferResult, /* 607 */
    Tcl_InterpActive, /* 608 */

};

/* !END!: Do not edit above this line. */

/*
 * Module-scope pointers to the main static stubs tables, used for package
 * initialization via Tcl_PkgProvideEx().






|







 







|







 







>







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
....
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
 *	This file contains the initializers for the Tcl stub vectors.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.171 2008/12/09 20:16:30 dgp Exp $
 */

#include "tclInt.h"
#include "tommath.h"

/*
 * Remove macros that will interfere with the definitions below.
................................................................................
    TclPtrMakeUpvar, /* 229 */
    TclObjLookupVar, /* 230 */
    TclGetNamespaceFromObj, /* 231 */
    TclEvalObjEx, /* 232 */
    TclGetSrcInfoForPc, /* 233 */
    TclVarHashCreateVar, /* 234 */
    TclInitVarHashTable, /* 235 */
    NULL, /* 236 */
    TclResetCancellation, /* 237 */
    TclNRInterpProc, /* 238 */
    TclNRInterpProcCore, /* 239 */
    TclNRRunCallbacks, /* 240 */
    TclNREvalObjEx, /* 241 */
    TclNREvalObjv, /* 242 */
};
................................................................................
    Tcl_SetEnsembleParameterList, /* 602 */
    Tcl_GetEnsembleParameterList, /* 603 */
    Tcl_ParseArgsObjv, /* 604 */
    Tcl_GetErrorLine, /* 605 */
    Tcl_SetErrorLine, /* 606 */
    Tcl_TransferResult, /* 607 */
    Tcl_InterpActive, /* 608 */
    Tcl_BackgroundException, /* 609 */
};

/* !END!: Do not edit above this line. */

/*
 * Module-scope pointers to the main static stubs tables, used for package
 * initialization via Tcl_PkgProvideEx().

Changes to generic/tclTimer.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
 *	including the "after" command.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTimer.c,v 1.36 2008/10/26 18:34:04 dkf Exp $
 */

#include "tclInt.h"

/*
 * For each timer callback that's pending there is one record of the following
 * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
................................................................................
     */

    interp = assocPtr->interp;
    Tcl_Preserve((ClientData) interp);
    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
	TclBackgroundException(interp, result);
    }
    Tcl_Release((ClientData) interp);

    /*
     * Free the memory for the callback.
     */







|







 







|







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
....
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
 *	including the "after" command.
 *
 * Copyright (c) 1997 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclTimer.c,v 1.37 2008/12/09 20:16:30 dgp Exp $
 */

#include "tclInt.h"

/*
 * For each timer callback that's pending there is one record of the following
 * type. The normal handlers (created by Tcl_CreateTimerHandler) are chained
................................................................................
     */

    interp = assocPtr->interp;
    Tcl_Preserve((ClientData) interp);
    result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL);
    if (result != TCL_OK) {
	Tcl_AddErrorInfo(interp, "\n    (\"after\" script)");
	Tcl_BackgroundException(interp, result);
    }
    Tcl_Release((ClientData) interp);

    /*
     * Free the memory for the callback.
     */