Tcl Source Code

Check-in [cfb9ace67b]
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: * generic/tclListObj.c: * generic/tcl.decls: * generic/tclDecls.h: Applied patch from Jim Ingham to change the prototype of Tcl_ListObjGetElements to have the last argument have a CONST so that you can feed it the objv that you get from the standard TclObj command proc.

* generic/tclAlloc.c: * generic/tclCmdIL.c: * generic/tclIO.c: * generic/tclThread.c: * win/tclWinThrd.c: * unix/tclUnixThrd.c: Fixed Brent's changes so that they work on Windows (and he fixed the bug in the Unix thread implementation).

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | core-8-2-b3-base
Files: files | file ages | folders
SHA1: cfb9ace67b1a6f28603349a246c29834927fcf0c
User & Date: redman 1999-08-10 17:35:14
Context
1999-08-10
22:45
Rolled back changes to change the prototype of Tcl_ListObjGetElements() check-in: ac48eb3341 user: redman tags: trunk
18:50
Update version numbers to 8.2b3 and update ChangeLog and changes files. check-in: 7e5102383d user: redman tags: core-8-2-b3-branch
17:35
* generic/tclListObj.c: * generic/tcl.decls: * generic/tclDecls.h: Applied patch from Jim Ingham to... check-in: cfb9ace67b user: redman tags: trunk, core-8-2-b3-base
17:17
Fixed level of indirection in Tcl_GetAllocMutex check-in: 493612de83 user: welch tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







































1
2
3
4
5
6
7





































1999-08-09  Jeff Hobbs  <[email protected]>

	* tests/string.test: added largest_int proc to adapt for >32 bit
	machines and int overflow testing.
	* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)

	* doc/Object.3: clarified Tcl_DecrRefCount docs [Bug: 1952]
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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
1999-08-10  Scott Redman  <[email protected]>

	* generic/tclListObj.c:
	* generic/tcl.decls:
	* generic/tclDecls.h: Applied patch from Jim Ingham to change the
	prototype of Tcl_ListObjGetElements to have the last argument have
	a CONST so that you can feed it the objv that you get from the
	standard TclObj command proc.

	* generic/tclAlloc.c:
	* generic/tclCmdIL.c:
	* generic/tclIO.c:
	* generic/tclThread.c:
	* win/tclWinThrd.c:
	* unix/tclUnixThrd.c: Fixed Brent's changes so that they work on
	Windows (and he fixed the bug in the Unix thread implementation).

1999-08-09  Brent Welch  <[email protected]>
        
	* generic/tcl.decls:
	* generic/tclAlloc.c:
	* generic/tclCkalloc.c:
	* generic/tclCmdIL.c:
	* generic/tclDecls.h: 
	* generic/tclIO.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:
	* generic/tclVar.c:
	* mac/tclMacThrd.c:
	* unix/tclUnixThrd.c:
	* win/tclWinThrd.c: Added use of Tcl_GetAllocMutex to tclAlloc.c
	and tclCkalloc.c so they can be linked against alternate thread
	packages. Added Tcl_GetChannelNames to tclIO.c.	Added
	TclVarTraceExists hook so "info exists" triggers read traces
	exactly like it did in Tcl 7.6. Stubs table changes to reflect new
	internal and external APIs.

1999-08-09  Jeff Hobbs  <[email protected]>

	* tests/string.test: added largest_int proc to adapt for >32 bit
	machines and int overflow testing.
	* tests/tcltest.test: fixed minor error in 8.2 result (from dgp)

	* doc/Object.3: clarified Tcl_DecrRefCount docs [Bug: 1952]

Changes to generic/tcl.decls.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
#	tclStub.c, and tclPlatStub.c files.
#	
#
# 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: tcl.decls,v 1.25 1999/08/10 02:42:12 welch Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 44 generic {
    int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, \
	    Tcl_Obj *objPtr)
}
declare 45 generic {
    int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, \
	    int *objcPtr, Tcl_Obj ***objvPtr)
}
declare 46 generic {
    int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, \
	    Tcl_Obj **objPtrPtr)
}
declare 47 generic {
    int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *intPtr)






|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
#	tclStub.c, and tclPlatStub.c files.
#	
#
# 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: tcl.decls,v 1.26 1999/08/10 17:35:17 redman Exp $

library tcl

# Define the tcl interface with several sub interfaces:
#     tclPlat	 - platform specific public
#     tclInt	 - generic private
#     tclPlatInt - platform specific private
................................................................................
}
declare 44 generic {
    int Tcl_ListObjAppendElement(Tcl_Interp *interp, Tcl_Obj *listPtr, \
	    Tcl_Obj *objPtr)
}
declare 45 generic {
    int Tcl_ListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr, \
	    int *objcPtr, Tcl_Obj * CONST **objvPtr)
}
declare 46 generic {
    int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, int index, \
	    Tcl_Obj **objPtrPtr)
}
declare 47 generic {
    int Tcl_ListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr, int *intPtr)

Changes to generic/tclAlloc.c.

11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
158
159
160
161
162
163
164

165

166
167
168
169
170
171
172
...
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclAlloc.c,v 1.7 1999/08/10 02:42:12 welch Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

#if USE_TCLALLOC

................................................................................
 */

void
TclInitAlloc()
{
    if (!allocInit) {
	allocInit = 1;

	allocMutexPtr = Tcl_GetAllocMutex();

    }
}
 
/*
 *-------------------------------------------------------------------------
 *
 * TclFinalizeAllocSubsystem --
................................................................................

    if (!allocInit) {
	/*
	 * We have to make the "self initializing" because Tcl_Alloc
	 * may be used before any other part of Tcl.  E.g., see
	 * main() for tclsh!
	 */
	TclAllocInit();
    }
    Tcl_MutexLock(allocMutexPtr);
    /*
     * First the simple case: we simple allocate big blocks directly
     */
    if (nbytes + OVERHEAD >= MAXMALLOC) {
	bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) 






|







 







>

>







 







|







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
...
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclAlloc.c,v 1.8 1999/08/10 17:35:18 redman Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

#if USE_TCLALLOC

................................................................................
 */

void
TclInitAlloc()
{
    if (!allocInit) {
	allocInit = 1;
#ifdef TCL_THREADS
	allocMutexPtr = Tcl_GetAllocMutex();
#endif
    }
}
 
/*
 *-------------------------------------------------------------------------
 *
 * TclFinalizeAllocSubsystem --
................................................................................

    if (!allocInit) {
	/*
	 * We have to make the "self initializing" because Tcl_Alloc
	 * may be used before any other part of Tcl.  E.g., see
	 * main() for tclsh!
	 */
	TclInitAlloc();
    }
    Tcl_MutexLock(allocMutexPtr);
    /*
     * First the simple case: we simple allocate big blocks directly
     */
    if (nbytes + OVERHEAD >= MAXMALLOC) {
	bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) 

Changes to generic/tclCmdIL.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * 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: tclCmdIL.c,v 1.14 1999/08/10 02:42:13 welch Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

................................................................................
InfoExistsCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    char *varName;
    Var *varPtr, *arrayPtr;

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 2, objv, "varName");
        return TCL_ERROR;
    }

    varName = Tcl_GetString(objv[2]);






|







 







|







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
...
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
 * Copyright (c) 1993-1997 Lucent Technologies.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * 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: tclCmdIL.c,v 1.15 1999/08/10 17:35:18 redman Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclCompile.h"
#include "tclRegexp.h"

................................................................................
InfoExistsCmd(dummy, interp, objc, objv)
    ClientData dummy;		/* Not used. */
    Tcl_Interp *interp;		/* Current interpreter. */
    int objc;			/* Number of arguments. */
    Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    char *varName;
    Var *varPtr;

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 2, objv, "varName");
        return TCL_ERROR;
    }

    varName = Tcl_GetString(objv[2]);

Changes to generic/tclDecls.h.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
....
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
 *	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.26 1999/08/10 02:42:13 welch Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
................................................................................
/* 44 */
EXTERN int		Tcl_ListObjAppendElement _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * listPtr, 
				Tcl_Obj * objPtr));
/* 45 */
EXTERN int		Tcl_ListObjGetElements _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * listPtr, 
				int * objcPtr, Tcl_Obj *** objvPtr));
/* 46 */
EXTERN int		Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * listPtr, int index, 
				Tcl_Obj ** objPtrPtr));
/* 47 */
EXTERN int		Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * listPtr, int * intPtr));
................................................................................
    int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */
    int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */
    Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((char * typeName)); /* 40 */
    char * (*tcl_GetStringFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 41 */
    void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 42 */
    int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 43 */
    int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */
    int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj *** objvPtr)); /* 45 */
    int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */
    int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 47 */
    int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */
    Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */
    Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((unsigned char * bytes, int length)); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) _ANSI_ARGS_((double doubleValue)); /* 51 */
    Tcl_Obj * (*tcl_NewIntObj) _ANSI_ARGS_((int intValue)); /* 52 */






|







 







|







 







|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
....
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
 *	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.27 1999/08/10 17:35:18 redman Exp $
 */

#ifndef _TCLDECLS
#define _TCLDECLS

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
................................................................................
/* 44 */
EXTERN int		Tcl_ListObjAppendElement _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * listPtr, 
				Tcl_Obj * objPtr));
/* 45 */
EXTERN int		Tcl_ListObjGetElements _ANSI_ARGS_((
				Tcl_Interp * interp, Tcl_Obj * listPtr, 
				int * objcPtr, Tcl_Obj * CONST ** objvPtr));
/* 46 */
EXTERN int		Tcl_ListObjIndex _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * listPtr, int index, 
				Tcl_Obj ** objPtrPtr));
/* 47 */
EXTERN int		Tcl_ListObjLength _ANSI_ARGS_((Tcl_Interp * interp, 
				Tcl_Obj * listPtr, int * intPtr));
................................................................................
    int (*tcl_GetIntFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int * intPtr)); /* 38 */
    int (*tcl_GetLongFromObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * longPtr)); /* 39 */
    Tcl_ObjType * (*tcl_GetObjType) _ANSI_ARGS_((char * typeName)); /* 40 */
    char * (*tcl_GetStringFromObj) _ANSI_ARGS_((Tcl_Obj * objPtr, int * lengthPtr)); /* 41 */
    void (*tcl_InvalidateStringRep) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 42 */
    int (*tcl_ListObjAppendList) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * elemListPtr)); /* 43 */
    int (*tcl_ListObjAppendElement) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, Tcl_Obj * objPtr)); /* 44 */
    int (*tcl_ListObjGetElements) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * objcPtr, Tcl_Obj * CONST ** objvPtr)); /* 45 */
    int (*tcl_ListObjIndex) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int index, Tcl_Obj ** objPtrPtr)); /* 46 */
    int (*tcl_ListObjLength) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int * intPtr)); /* 47 */
    int (*tcl_ListObjReplace) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * listPtr, int first, int count, int objc, Tcl_Obj *CONST objv[])); /* 48 */
    Tcl_Obj * (*tcl_NewBooleanObj) _ANSI_ARGS_((int boolValue)); /* 49 */
    Tcl_Obj * (*tcl_NewByteArrayObj) _ANSI_ARGS_((unsigned char * bytes, int length)); /* 50 */
    Tcl_Obj * (*tcl_NewDoubleObj) _ANSI_ARGS_((double doubleValue)); /* 51 */
    Tcl_Obj * (*tcl_NewIntObj) _ANSI_ARGS_((int intValue)); /* 52 */

Changes to generic/tclIO.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
 *
 * Copyright (c) 1998 Scriptics Corporation
 * 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.13 1999/08/10 02:42:13 welch Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
................................................................................
             * channel with CHANNEL_DEAD to prevent any further IO operations
             * on it.
             */

            chanPtr->instanceData = (ClientData) NULL;
            chanPtr->flags |= CHANNEL_DEAD;
        }
    }
}

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_CloseChannels --
 *
 *	Close all open channels in this interp, except for the
 *	standard input/output channels.  This is useful for cleanup.
 *
 * Results:
 *	None
 *
 * Side effects:
 *	May closes one or more channels.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CloseChannels(Tcl_Interp *interp)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Channel *chanPtr, *nextChanPtr;

    for (chanPtr = tsdPtr->firstChanPtr; chanPtr != NULL; chanPtr = nextChanPtr) {
	nextChanPtr = chanPtr->nextChanPtr;
	if (chanPtr != (Channel *) tsdPtr->stdinChannel
		&& chanPtr != (Channel *) tsdPtr->stdoutChannel
		&& chanPtr != (Channel *) tsdPtr->stderrChannel) {
            (void) Tcl_UnregisterChannel(interp, (Tcl_Channel) chanPtr);
	}
    }
}

 
/*
 *----------------------------------------------------------------------
 *






|







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
586
587
588
589
590
591
592


































593
594
595
596
597
598
599
 *
 * Copyright (c) 1998 Scriptics Corporation
 * 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.14 1999/08/10 17:35:18 redman Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 * Make sure that both EAGAIN and EWOULDBLOCK are defined. This does not
................................................................................
             * channel with CHANNEL_DEAD to prevent any further IO operations
             * on it.
             */

            chanPtr->instanceData = (ClientData) NULL;
            chanPtr->flags |= CHANNEL_DEAD;
        }


































    }
}

 
/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclListObj.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclListObj.c,v 1.5 1999/04/28 17:06:06 stanton Exp $
 */

#include "tclInt.h"

/*
 * Prototypes for procedures defined later in this file:
 */
................................................................................
int
Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
    register Tcl_Obj *listPtr;	/* List object for which an element array
				 * is to be returned. */
    int *objcPtr;		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj ***objvPtr;		/* Where to store the pointer to an array
				 * of pointers to the list's objects. */
{
    register List *listRepPtr;

    if (listPtr->typePtr != &tclListType) {
	int result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {






|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 1998 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: tclListObj.c,v 1.6 1999/08/10 17:35:19 redman Exp $
 */

#include "tclInt.h"

/*
 * Prototypes for procedures defined later in this file:
 */
................................................................................
int
Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr)
    Tcl_Interp *interp;		/* Used to report errors if not NULL. */
    register Tcl_Obj *listPtr;	/* List object for which an element array
				 * is to be returned. */
    int *objcPtr;		/* Where to store the count of objects
				 * referenced by objv. */
    Tcl_Obj * CONST **objvPtr;	/* Where to store the pointer to an array
				 * of pointers to the list's objects. */
{
    register List *listRepPtr;

    if (listPtr->typePtr != &tclListType) {
	int result = SetListFromAny(interp, listPtr);
	if (result != TCL_OK) {

Changes to generic/tclThread.c.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
399
400
401
402
403
404
405

406

407
408
409
410
411
412
413
 *	Most of the real work is done in the platform dependent files.
 *
 * Copyright (c) 1998 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: tclThread.c,v 1.2 1999/04/16 00:46:54 stanton Exp $
 */

#include "tclInt.h"

/*
 * There are three classes of synchronization objects:
 * mutexes, thread data keys, and condition variables.
................................................................................
#else
	if (*keyPtr != NULL) {
	    ckfree((char *)*keyPtr);
	    *keyPtr = NULL;
	}
#endif
    }

    TclpMasterUnlock();

}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeSyncronization --
 *






|







 







>

>







5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
...
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
 *	Most of the real work is done in the platform dependent files.
 *
 * Copyright (c) 1998 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: tclThread.c,v 1.3 1999/08/10 17:35:19 redman Exp $
 */

#include "tclInt.h"

/*
 * There are three classes of synchronization objects:
 * mutexes, thread data keys, and condition variables.
................................................................................
#else
	if (*keyPtr != NULL) {
	    ckfree((char *)*keyPtr);
	    *keyPtr = NULL;
	}
#endif
    }
#ifdef TCL_THREADS
    TclpMasterUnlock();
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
 * TclFinalizeSyncronization --
 *

Changes to win/tclWinThrd.c.

38
39
40
41
42
43
44

45
46
47
48
49
50
51
...
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
...
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
...
321
322
323
324
325
326
327

328
329
330
331
332

























333
334
335
336
337
338
339
/*
 * allocLock is used by Tcl's version of malloc for synchronization.
 * For obvious reasons, cannot use any dyamically allocated storage.
 */

static CRITICAL_SECTION allocLock;


/*
 * Condition variables are implemented with a combination of a 
 * per-thread Windows Event and a per-condition waiting queue.
 * The idea is that each thread has its own Event that it waits
 * on when it is doing a ConditionWait; it uses the same event for
 * all condition variables because it only waits on one at a time.
................................................................................
	 * the first Tcl interpreter in a single threaded environment.
	 * Once the interpreter has been created, it is safe to create
	 * more threads that create interpreters in parallel.
	 */
	init = 1;
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&masterLock);
	InitializeCriticalSection(&allocLock);
    }
    EnterCriticalSection(&initLock);
}

 
/*
 *----------------------------------------------------------------------
................................................................................
	 * the first Tcl interpreter in a single threaded environment.
	 * Once the interpreter has been created, it is safe to create
	 * more threads that create interpreters in parallel.
	 */
	init = 1;
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&masterLock);
	InitializeCriticalSection(&allocLock);
    }
    EnterCriticalSection(&masterLock);
}

 
/*
 *----------------------------------------------------------------------
 *
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation
 *	and deletion of synchronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Release the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterUnlock()
{
    LeaveCriticalSection(&masterLock);
}

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAllocMutex
 *
 *	This procedure returns a pointer to a statically initialized
................................................................................
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex()
{
#ifdef TCL_THREADS

    return &allocLock;
#else
    return NULL;
#endif
}


























 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *






>







 







<







 







<




<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
...
206
207
208
209
210
211
212

213
214
215
216
217
218
219
...
268
269
270
271
272
273
274

275
276
277
278
























279
280
281
282
283
284
285
...
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
/*
 * allocLock is used by Tcl's version of malloc for synchronization.
 * For obvious reasons, cannot use any dyamically allocated storage.
 */

static CRITICAL_SECTION allocLock;
static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;

/*
 * Condition variables are implemented with a combination of a 
 * per-thread Windows Event and a per-condition waiting queue.
 * The idea is that each thread has its own Event that it waits
 * on when it is doing a ConditionWait; it uses the same event for
 * all condition variables because it only waits on one at a time.
................................................................................
	 * the first Tcl interpreter in a single threaded environment.
	 * Once the interpreter has been created, it is safe to create
	 * more threads that create interpreters in parallel.
	 */
	init = 1;
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&masterLock);

    }
    EnterCriticalSection(&initLock);
}

 
/*
 *----------------------------------------------------------------------
................................................................................
	 * the first Tcl interpreter in a single threaded environment.
	 * Once the interpreter has been created, it is safe to create
	 * more threads that create interpreters in parallel.
	 */
	init = 1;
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&masterLock);

    }
    EnterCriticalSection(&masterLock);
}

























 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAllocMutex
 *
 *	This procedure returns a pointer to a statically initialized
................................................................................
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex()
{
#ifdef TCL_THREADS
    InitializeCriticalSection(&allocLock);
    return &allocLockPtr;
#else
    return NULL;
#endif
}

 
#ifdef TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpMasterUnlock
 *
 *	This procedure is used to release a lock that serializes creation
 *	and deletion of synchronization objects.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Release the master mutex.
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterUnlock()
{
    LeaveCriticalSection(&masterLock);
}

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *