summaryrefslogtreecommitdiffstats
path: root/mac
diff options
context:
space:
mode:
authorstanton <stanton>1999-04-16 00:46:29 (GMT)
committerstanton <stanton>1999-04-16 00:46:29 (GMT)
commit97464e6cba8eb0008cf2727c15718671992b913f (patch)
treece9959f2747257d98d52ec8d18bf3b0de99b9535 /mac
parenta8c96ddb94d1483a9de5e340b740cb74ef6cafa7 (diff)
downloadtcl-97464e6cba8eb0008cf2727c15718671992b913f.zip
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.gz
tcl-97464e6cba8eb0008cf2727c15718671992b913f.tar.bz2
merged tcl 8.1 branch back into the main trunk
Diffstat (limited to 'mac')
-rw-r--r--mac/MW_TclHeader.pch6
-rw-r--r--mac/README65
-rw-r--r--mac/tclMacAppInit.c4
-rw-r--r--mac/tclMacBOAAppInit.c4
-rw-r--r--mac/tclMacBOAMain.c27
-rw-r--r--mac/tclMacChan.c159
-rw-r--r--mac/tclMacExit.c4
-rw-r--r--mac/tclMacFCmd.c465
-rw-r--r--mac/tclMacFile.c660
-rw-r--r--mac/tclMacInit.c592
-rw-r--r--mac/tclMacInt.h13
-rw-r--r--mac/tclMacLibrary.r6
-rw-r--r--mac/tclMacLoad.c61
-rw-r--r--mac/tclMacNotify.c146
-rw-r--r--mac/tclMacOSA.c8
-rw-r--r--mac/tclMacPort.h236
-rw-r--r--mac/tclMacResource.c88
-rw-r--r--mac/tclMacResource.r6
-rw-r--r--mac/tclMacShLib.exp5
-rw-r--r--mac/tclMacSock.c216
-rw-r--r--mac/tclMacTclCode.r36
-rw-r--r--mac/tclMacThrd.c795
-rw-r--r--mac/tclMacThrd.h20
-rw-r--r--mac/tclMacUnix.c145
24 files changed, 2650 insertions, 1117 deletions
diff --git a/mac/MW_TclHeader.pch b/mac/MW_TclHeader.pch
index 11b5d28..4982c3b 100644
--- a/mac/MW_TclHeader.pch
+++ b/mac/MW_TclHeader.pch
@@ -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: MW_TclHeader.pch,v 1.5 1999/04/15 22:38:46 stanton Exp $
+ * RCS: @(#) $Id: MW_TclHeader.pch,v 1.6 1999/04/16 00:47:19 stanton Exp $
*/
/*
@@ -42,8 +42,6 @@
#include "tcl.h"
#include "tclMac.h"
#include "tclInt.h"
-#ifdef TCL_TEST
-#include "tclMacPort.h"
-#endif
+
#pragma export reset
diff --git a/mac/README b/mac/README
index fe37383..8f05bbc 100644
--- a/mac/README
+++ b/mac/README
@@ -1,4 +1,4 @@
-Tcl 8.0.5 for Macintosh
+Tcl 8.1b2 for Macintosh
by Ray Johnson
Scriptics Corporation
@@ -8,7 +8,7 @@ Jim Ingham
Cygnus Solutions
jingham@cygnus.com
-RCS: @(#) $Id: README,v 1.5 1999/04/15 22:38:46 stanton Exp $
+RCS: @(#) $Id: README,v 1.6 1999/04/16 00:47:19 stanton Exp $
1. Introduction
---------------
@@ -21,34 +21,14 @@ please read the README file in the main Tcl directory.
2. What's new?
--------------
-The main new feature is the Tcl compilier. You should certainly
-notice the speed improvements. Any problems are probably
-generic rather than Mac specific. If you have questions or
-comments about the compilier feel free to forward them to the
-author of the compilier: Brian Lewis <btlewis@eng.sun.com>.
-Several things were fixed/changed since the a1 release so be
-sure to check this out.
-
-The largest incompatible change on the Mac is the removal of the
-following commands: "rm", "rmdir", "mkdir", "mv" and "cp". These
-commands were never really supported and their functionality is
-superceded by the file command.
-
-I've also added in a new "AppleScript" command. This was contributed
-by Jim Ingham who is a new member of the Tcl group. It's very cool.
-The command isn't actually in the core - you need to do a "package
-require Tclapplescript" to get access to it. This code is officially
-unsupported and will change in the next release. However, the core
-functionality is there and is stable enough to use. Documentation
-can be found in "AppleScript.html" in the mac subdirectory.
-
-The resource command has also been rewacked. You can now read and
-write any Mac resource. Tcl now has the new (and VERY COOL) binary
-command that will allow you to pack and unpack the resources into
-useful Tcl code. We will eventually provide Tcl libraries for
-accessing the most common resources.
-
-See the main Tcl README for other features new to Tcl 8.0.
+Internationalization! This is the first Tcl release that features
+can handle international characters.
+
+On the Macintosh, the System Encoding is taken from the script of the
+Finder Font as set in the Views control panel, or in the Finder
+Preferences in OS8.0.
+
+See the main Tcl README for other features new to Tcl 8.
3. Mac specific features
------------------------
@@ -67,8 +47,8 @@ pointers to where you can find more information about the feature.
* The only command NOT available on the Mac is the exec command.
However, we include a Mac only package called Tclapplescript that
provides access to Mac's AppleScript system. This command is still
- under design & construction. Documentatin can be found in the mac
- subdirectory in a file called "AppleScript.html".
+ under design & construction. Documentatin can be found in the "HTML
+ Docs:tcl8.1" folder in a file called "AppleScript.html".
* The env variable on the Macintosh works rather differently than on
Windows or UNIX platforms. Check out the tclvars man page for
@@ -89,6 +69,7 @@ If you are writing cross platform code but would still like to use
some of these Mac specific commands, please remember to use the
tcl_platform variable to special case your code.
+
4. The Distribution
-------------------
@@ -96,7 +77,7 @@ Macintosh Tcl is distributed in three different forms. This
should make it easier to only download what you need. The
packages are as follows:
-mactk8.0.5.sea.hqx
+mactk8.1b2.sea.hqx
This distribution is a "binary" only release. It contains an
installer program that will install a 68k, PowerPC, or Fat
@@ -104,15 +85,15 @@ mactk8.0.5.sea.hqx
it installs the Tcl & Tk libraries in the Extensions folder inside
your System Folder.
-mactcltk-full-8.0.5.sea.hqx
+mactcltk-full-8.1b2.sea.hqx
This release contains the full release of Tcl and Tk for the
Macintosh plus the More Files packages which Macintosh Tcl and Tk
rely on.
-mactcl-source-8.0.5.sea.hqx
+mactcl-source-8.1b2.sea.hqx
- This release contains the complete source for Tcl 8.0. In
+ This release contains the complete source for Tcl 8.1. In
addition, Metrowerks CodeWarrior libraries and project files
are included. However, you must already have the More Files
package to compile this code.
@@ -123,7 +104,7 @@ mactcl-source-8.0.5.sea.hqx
The "html" subdirectory contains reference documentation in
in the HTML format. You may also find these pages at:
- http://www.scriptics.com/man/tcl8.0/contents.html
+ http://www.scriptics.com/man/tcl8.1/contents.html
Other documentation and sample Tcl scripts can be found at
the Tcl archive site:
@@ -144,14 +125,14 @@ available (see below).
In order to compile Macintosh Tcl you must have the
following items:
- CodeWarrior Pro 2 through 4
- Mac Tcl 8.0 (source)
- More Files 1.4.3, or 1.4.9
+ CodeWarrior Pro 2 or 3
+ Mac Tcl 8.1 (source)
+ More Files 1.4.3
There are two sets of project files included with the package. The ones
we use for the release are for CodeWarrior Pro 3, and are not compatible
with CodeWarrior Gold release 11 and earlier. We have included the files
-for earlier versions of CodeWarrior in the folder tcl8.0:mac:CW11 Projects,
+for earlier versions of CodeWarrior in the folder tcl8.1:mac:CW11 Projects,
but they are unsupported, and a little out of date.
As of Tcl8.0p2, the code will also build under CW Pro 2. The only
@@ -181,7 +162,7 @@ Special notes:
* There is a small bug in More Files 1.4.3. Also you should not use
MoreFiles 1.4.4 - 1.4.6. Look in the file named morefiles.doc for
- more details. Tcl 8.0.5 is compiled with MoreFiles 1.4.9.
+ more details.
* You may not have the libmoto library which will cause a compile
error. You don't REALLY need it - it can be removed. Look at the
diff --git a/mac/tclMacAppInit.c b/mac/tclMacAppInit.c
index 2505bd5..c4e4746 100644
--- a/mac/tclMacAppInit.c
+++ b/mac/tclMacAppInit.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: tclMacAppInit.c,v 1.4 1999/02/03 02:58:25 stanton Exp $
+ * RCS: @(#) $Id: tclMacAppInit.c,v 1.5 1999/04/16 00:47:19 stanton Exp $
*/
#include "tcl.h"
@@ -85,7 +85,7 @@ main(
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
diff --git a/mac/tclMacBOAAppInit.c b/mac/tclMacBOAAppInit.c
index 173495a..4fc34e8 100644
--- a/mac/tclMacBOAAppInit.c
+++ b/mac/tclMacBOAAppInit.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: tclMacBOAAppInit.c,v 1.2 1998/09/14 18:40:04 stanton Exp $
+ * RCS: @(#) $Id: tclMacBOAAppInit.c,v 1.3 1999/04/16 00:47:19 stanton Exp $
*/
#include "tcl.h"
@@ -97,7 +97,7 @@ main(
*
* Results:
* Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
+ * message in the interp's result if an error occurs.
*
* Side effects:
* Depends on the startup script.
diff --git a/mac/tclMacBOAMain.c b/mac/tclMacBOAMain.c
index ebec082..d863e9c 100644
--- a/mac/tclMacBOAMain.c
+++ b/mac/tclMacBOAMain.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: tclMacBOAMain.c,v 1.2 1998/09/14 18:40:04 stanton Exp $
+ * RCS: @(#) $Id: tclMacBOAMain.c,v 1.3 1999/04/16 00:47:19 stanton Exp $
*/
#include "tcl.h"
@@ -147,14 +147,16 @@ Tcl_Main(argc, argv, appInitProc)
*/
if ((*appInitProc)(interp) != TCL_OK) {
- Tcl_DString errStr;
- Tcl_DStringInit(&errStr);
- Tcl_DStringAppend(&errStr,
- "application-specific initialization failed: \n", -1);
- Tcl_DStringAppend(&errStr, interp->result, -1);
- Tcl_DStringAppend(&errStr, "\n", 1);
- TclMacDoNotification(Tcl_DStringValue(&errStr));
- goto done;
+ Tcl_DString errStr;
+
+ Tcl_DStringInit(&errStr);
+ Tcl_DStringAppend(&errStr,
+ "application-specific initialization failed: \n", -1);
+ Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
+ Tcl_DStringAppend(&errStr, "\n", 1);
+ TclMacDoNotification(Tcl_DStringValue(&errStr));
+ Tcl_DStringFree(&errStr);
+ goto done;
}
/*
@@ -192,10 +194,9 @@ Tcl_Main(argc, argv, appInitProc)
Tcl_DStringAppend(&errStr, " Error sourcing resource or file: ", -1);
Tcl_DStringAppend(&errStr, fileName, -1);
Tcl_DStringAppend(&errStr, "\n\nError was: ", -1);
- Tcl_DStringAppend(&errStr, interp->result, -1);
-
+ Tcl_DStringAppend(&errStr, Tcl_GetStringResult(interp), -1);
TclMacDoNotification(Tcl_DStringValue(&errStr));
-
+ Tcl_DStringFree(&errStr);
}
goto done;
}
@@ -312,7 +313,7 @@ Tcl_MacBGNotifyObjCmd(clientData, interp, objc, objv)
return TCL_ERROR;
}
- TclMacDoNotification(Tcl_GetStringFromObj(objv[1], (int *) NULL));
+ TclMacDoNotification(Tcl_GetString(objv[1]));
return TCL_OK;
}
diff --git a/mac/tclMacChan.c b/mac/tclMacChan.c
index fc53f42..2fbac8f 100644
--- a/mac/tclMacChan.c
+++ b/mac/tclMacChan.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: tclMacChan.c,v 1.5 1999/04/15 22:38:46 stanton Exp $
+ * RCS: @(#) $Id: tclMacChan.c,v 1.6 1999/04/16 00:47:19 stanton Exp $
*/
#include "tclInt.h"
@@ -25,12 +25,6 @@
#include <MoreFiles.h>
#include <MoreFilesExtras.h>
-/*
- * The following variable is used to tell whether this module has been
- * initialized.
- */
-
-static int initialized = 0;
/*
* The following are flags returned by GetOpenMode. They
@@ -66,12 +60,16 @@ typedef struct FileState {
struct FileState *nextPtr; /* Pointer to next registered file. */
} FileState;
-/*
- * The following pointer refers to the head of the list of files managed
- * that are being watched for file events.
- */
+typedef struct ThreadSpecificData {
+ int initialized; /* True after the thread initializes */
+ FileState *firstFilePtr; /* the head of the list of files managed
+ * that are being watched for file events. */
+ Tcl_Channel stdinChannel;
+ Tcl_Channel stdoutChannel; /* Note - these seem unused */
+ Tcl_Channel stderrChannel;
+} ThreadSpecificData;
-static FileState *firstFilePtr;
+static Tcl_ThreadDataKey dataKey;
/*
* The following structure is what is added to the Tcl event queue when
@@ -87,12 +85,6 @@ typedef struct FileEvent {
* pointer. */
} FileEvent;
-/*
- * This is defined in tclMacSerial.c.
- */
-
-EXTERN Tcl_Channel TclMacOpenSerialChannel _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName, int *errorCode));
/*
* Static routines for this file:
@@ -112,7 +104,7 @@ static int FileClose _ANSI_ARGS_((ClientData instanceData,
Tcl_Interp *interp));
static int FileEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
int flags));
-static void FileInit _ANSI_ARGS_((void));
+static ThreadSpecificData *FileInit _ANSI_ARGS_((void));
static int FileInput _ANSI_ARGS_((ClientData instanceData,
char *buf, int toRead, int *errorCode));
static int FileOutput _ANSI_ARGS_((ClientData instanceData,
@@ -122,9 +114,9 @@ static int FileSeek _ANSI_ARGS_((ClientData instanceData,
static void FileSetupProc _ANSI_ARGS_((ClientData clientData,
int flags));
static int GetOpenMode _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-static Tcl_Channel OpenFileChannel _ANSI_ARGS_((char *fileName, int mode,
- int permissions, int *errorCodePtr));
+ CONST char *string));
+static Tcl_Channel OpenFileChannel _ANSI_ARGS_((CONST char *fileName,
+ int mode, int permissions, int *errorCodePtr));
static int StdIOBlockMode _ANSI_ARGS_((ClientData instanceData,
int mode));
static int StdIOClose _ANSI_ARGS_((ClientData instanceData,
@@ -183,13 +175,6 @@ typedef void (*TclGetStdChannelsProc) _ANSI_ARGS_((Tcl_Channel *stdinPtr,
TclGetStdChannelsProc getStdChannelsProc = NULL;
-/*
- * Static variables to hold channels for stdin, stdout and stderr.
- */
-
-static Tcl_Channel stdinChannel = NULL;
-static Tcl_Channel stdoutChannel = NULL;
-static Tcl_Channel stderrChannel = NULL;
/*
*----------------------------------------------------------------------
@@ -207,13 +192,18 @@ static Tcl_Channel stderrChannel = NULL;
*----------------------------------------------------------------------
*/
-static void
+static ThreadSpecificData *
FileInit()
{
- initialized = 1;
- firstFilePtr = NULL;
- Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
- Tcl_CreateExitHandler(FileChannelExitHandler, NULL);
+ ThreadSpecificData *tsdPtr =
+ (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr = TCL_TSD_INIT(&dataKey);
+ tsdPtr->firstFilePtr = NULL;
+ Tcl_CreateEventSource(FileSetupProc, FileCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(FileChannelExitHandler, NULL);
+ }
+ return tsdPtr;
}
/*
@@ -238,7 +228,6 @@ FileChannelExitHandler(
ClientData clientData) /* Old window proc */
{
Tcl_DeleteEventSource(FileSetupProc, FileCheckProc, NULL);
- initialized = 0;
}
/*
@@ -265,6 +254,7 @@ FileSetupProc(
{
FileState *infoPtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -274,7 +264,8 @@ FileSetupProc(
* Check to see if there is a ready file. If so, poll.
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask) {
Tcl_SetMaxBlockTime(&blockTime);
break;
@@ -308,6 +299,7 @@ FileCheckProc(
FileState *infoPtr;
int sentMsg = 0;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -319,7 +311,8 @@ FileCheckProc(
* events).
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (infoPtr->watchMask && !infoPtr->pending) {
infoPtr->pending = 1;
evPtr = (FileEvent *) ckalloc(sizeof(FileEvent));
@@ -358,6 +351,7 @@ FileEventProc(
{
FileEvent *fileEvPtr = (FileEvent *)evPtr;
FileState *infoPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -370,7 +364,8 @@ FileEventProc(
* event is in the queue.
*/
- for (infoPtr = firstFilePtr; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
if (fileEvPtr->infoPtr == infoPtr) {
infoPtr->pending = 0;
Tcl_NotifyChannel(infoPtr->fileChan, infoPtr->watchMask);
@@ -434,29 +429,31 @@ StdIOClose(
Tcl_Interp *interp) /* Unused. */
{
int fd, errorCode = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
/*
* Invalidate the stdio cache if necessary. Note that we assume that
* the stdio file and channel pointers will become invalid at the same
* time.
+ * Do not close standard channels while in thread-exit.
*/
fd = (int) ((FileState*)instanceData)->fileRef;
- if (fd == 0) {
- fd = 0;
- stdinChannel = NULL;
- } else if (fd == 1) {
- stdoutChannel = NULL;
- } else if (fd == 2) {
- stderrChannel = NULL;
- } else {
- panic("recieved invalid std file");
- }
-
- if (close(fd) < 0) {
- errorCode = errno;
+ if (!TclInExit()) {
+ if (fd == 0) {
+ tsdPtr->stdinChannel = NULL;
+ } else if (fd == 1) {
+ tsdPtr->stdoutChannel = NULL;
+ } else if (fd == 2) {
+ tsdPtr->stderrChannel = NULL;
+ } else {
+ panic("recieved invalid std file");
+ }
+
+ if (close(fd) < 0) {
+ errorCode = errno;
+ }
}
-
return errorCode;
}
@@ -465,7 +462,7 @@ StdIOClose(
*
* CommonGetHandle --
*
- * Called from Tcl_GetChannelFile to retrieve OS handles from inside
+ * Called from Tcl_GetChannelHandle to retrieve OS handles from inside
* a file based channel.
*
* Results:
@@ -648,7 +645,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
sprintf(buf, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
Tcl_SetStringObj(resultPtr, buf, -1);
} else {
- chan = Tcl_GetChannel(interp, Tcl_GetStringFromObj(objv[1], NULL),
+ chan = Tcl_GetChannel(interp, Tcl_GetString(objv[1]),
NULL);
if (chan == (Tcl_Channel) NULL) {
return TCL_ERROR;
@@ -665,7 +662,7 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
/*
*----------------------------------------------------------------------
*
- * TclGetDefaultStdChannel --
+ * TclpGetDefaultStdChannel --
*
* Constructs a channel for the specified standard OS handle.
*
@@ -680,14 +677,14 @@ Tcl_PidObjCmd(dummy, interp, objc, objv)
*/
Tcl_Channel
-TclGetDefaultStdChannel(
+TclpGetDefaultStdChannel(
int type) /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
{
Tcl_Channel channel = NULL;
int fd = 0; /* Initializations needed to prevent */
int mode = 0; /* compiler warning (used before set). */
char *bufMode = NULL;
- char channelName[20];
+ char channelName[16 + TCL_INTEGER_SPACE];
int channelPermissions;
FileState *fileState;
@@ -765,27 +762,24 @@ TclpOpenFileChannel(
{
Tcl_Channel chan;
int mode;
- char *nativeName;
- Tcl_DString buffer;
- int errorCode, port = 0;
+ char *native;
+ Tcl_DString ds, buffer;
+ int errorCode;
mode = GetOpenMode(interp, modeString);
if (mode == -1) {
return NULL;
}
- /*
- * Look for the magic cookies that refer to the modem ports.
- */
-
- nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
- if (nativeName == NULL) {
+ if (Tcl_TranslateFileName(interp, fileName, &buffer) == NULL) {
return NULL;
}
-
- chan = OpenFileChannel(nativeName, mode, permissions, &errorCode);
+ native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
+ chan = OpenFileChannel(native, mode, permissions, &errorCode);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
-
+
if (chan == NULL) {
Tcl_SetErrno(errorCode);
if (interp != (Tcl_Interp *) NULL) {
@@ -816,7 +810,7 @@ TclpOpenFileChannel(
static Tcl_Channel
OpenFileChannel(
- char *fileName, /* Name of file to open. */
+ CONST char *fileName, /* Name of file to open (native). */
int mode, /* Mode for opening file. */
int permissions, /* If the open involves creating a
* file, with what modes to create
@@ -830,7 +824,7 @@ OpenFileChannel(
OSErr err;
short fileRef;
FileState *fileState;
- char channelName[64];
+ char channelName[16 + TCL_INTEGER_SPACE];
/*
* Note we use fsRdWrShPerm instead of fsRdWrPerm which allows shared
@@ -1229,16 +1223,15 @@ CommonWatch(
FileState **nextPtrPtr, *ptr;
FileState *infoPtr = (FileState *) instanceData;
int oldMask = infoPtr->watchMask;
+ ThreadSpecificData *tsdPtr;
- if (!initialized) {
- FileInit();
- }
+ tsdPtr = FileInit();
infoPtr->watchMask = mask;
if (infoPtr->watchMask) {
if (!oldMask) {
- infoPtr->nextPtr = firstFilePtr;
- firstFilePtr = infoPtr;
+ infoPtr->nextPtr = tsdPtr->firstFilePtr;
+ tsdPtr->firstFilePtr = infoPtr;
}
} else {
if (oldMask) {
@@ -1246,7 +1239,7 @@ CommonWatch(
* Remove the file from the list of watched files.
*/
- for (nextPtrPtr = &firstFilePtr, ptr = *nextPtrPtr;
+ for (nextPtrPtr = &(tsdPtr->firstFilePtr), ptr = *nextPtrPtr;
ptr != NULL;
nextPtrPtr = &ptr->nextPtr, ptr = *nextPtrPtr) {
if (infoPtr == ptr) {
@@ -1270,7 +1263,7 @@ CommonWatch(
*
* Results:
* On success, returns mode to pass to "open". If an error occurs, the
- * returns -1 and if interp is not NULL, sets interp->result to an
+ * returns -1 and if interp is not NULL, sets the interp's result to an
* error message.
*
* Side effects:
@@ -1288,7 +1281,7 @@ static int
GetOpenMode(
Tcl_Interp *interp, /* Interpreter to use for error
* reporting - may be NULL. */
- char *string) /* Mode string, e.g. "r+" or
+ CONST char *string) /* Mode string, e.g. "r+" or
* "RDONLY CREAT". */
{
int mode, modeArgc, c, i, gotRW;
@@ -1301,7 +1294,13 @@ GetOpenMode(
*/
mode = 0;
- if (islower(UCHAR(string[0]))) {
+ /*
+ * Guard against international characters before using byte oriented
+ * routines.
+ */
+
+ if (!(string[0] & 0x80)
+ && islower(UCHAR(string[0]))) { /* INTL: ISO only. */
switch (string[0]) {
case 'r':
mode = TCL_RDONLY;
diff --git a/mac/tclMacExit.c b/mac/tclMacExit.c
index f7d92c4..347ff4e 100644
--- a/mac/tclMacExit.c
+++ b/mac/tclMacExit.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacExit.c,v 1.3 1998/11/11 07:46:13 jingham Exp $
+ * RCS: @(#) $Id: tclMacExit.c,v 1.4 1999/04/16 00:47:19 stanton Exp $
*/
#include "tclInt.h"
@@ -104,7 +104,7 @@ static ExitToShellDataPtr gExitToShellData = (ExitToShellDataPtr) NULL;
*/
void
-TclPlatformExit(
+TclpExit(
int status) /* Ignored. */
{
TclMacExitHandler();
diff --git a/mac/tclMacFCmd.c b/mac/tclMacFCmd.c
index 7e8fd22..716237e 100644
--- a/mac/tclMacFCmd.c
+++ b/mac/tclMacFCmd.c
@@ -4,12 +4,12 @@
* Implements the Macintosh specific portions of the file manipulation
* subcommands of the "file" command.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 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: tclMacFCmd.c,v 1.3 1999/04/15 22:38:47 stanton Exp $
+ * RCS: @(#) $Id: tclMacFCmd.c,v 1.4 1999/04/16 00:47:20 stanton Exp $
*/
#include "tclInt.h"
@@ -31,16 +31,16 @@
*/
static int GetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **attributePtrPtr));
static int GetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj **readOnlyPtrPtr));
static int SetFileFinderAttributes _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *attributePtr));
static int SetFileReadOnly _ANSI_ARGS_((Tcl_Interp *interp,
- int objIndex, char *fileName,
+ int objIndex, CONST char *fileName,
Tcl_Obj *readOnlyPtr));
/*
@@ -72,14 +72,25 @@ CONST TclFileAttrProcs tclpFileAttrProcs[] = {
static pascal Boolean CopyErrHandler _ANSI_ARGS_((OSErr error,
short failedOperation,
short srcVRefNum, long srcDirID,
- const unsigned char *srcName, short dstVRefNum,
- long dstDirID, const unsigned char *dstName));
+ StringPtr srcName, short dstVRefNum,
+ long dstDirID,StringPtr dstName));
+static int DoCopyDirectory _ANSI_ARGS_((CONST char *src,
+ CONST char *dst, Tcl_DString *errorPtr));
+static int DoCopyFile _ANSI_ARGS_((CONST char *src,
+ CONST char *dst));
+static int DoCreateDirectory _ANSI_ARGS_((CONST char *path));
+static int DoDeleteFile _ANSI_ARGS_((CONST char *path));
+static int DoRemoveDirectory _ANSI_ARGS_((CONST char *path,
+ int recursive, Tcl_DString *errorPtr));
+static int DoRenameFile _ANSI_ARGS_((CONST char *src,
+ CONST char *dst));
OSErr FSpGetFLockCompat _ANSI_ARGS_((const FSSpec *specPtr,
Boolean *lockedPtr));
static OSErr GenerateUniqueName _ANSI_ARGS_((short vRefNum,
long dirID1, long dirID2, Str31 uniqueName));
-static OSErr GetFileSpecs _ANSI_ARGS_((char *path, FSSpec *pathSpecPtr,
- FSSpec *dirSpecPtr, Boolean *pathExistsPtr,
+static OSErr GetFileSpecs _ANSI_ARGS_((CONST char *path,
+ FSSpec *pathSpecPtr, FSSpec *dirSpecPtr,
+ Boolean *pathExistsPtr,
Boolean *pathIsDirectoryPtr));
static OSErr MoveRename _ANSI_ARGS_((const FSSpec *srcSpecPtr,
const FSSpec *dstSpecPtr, StringPtr copyName));
@@ -89,7 +100,7 @@ static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
/*
*---------------------------------------------------------------------------
*
- * TclpRenameFile --
+ * TclpRenameFile, DoRenameFile --
*
* Changes the name of an existing file or directory, from src to dst.
* If src and dst refer to the same file or directory, does nothing
@@ -123,8 +134,29 @@ static int Pstrequal _ANSI_ARGS_((ConstStr255Param stringA,
int
TclpRenameFile(
- char *src, /* Pathname of file or dir to be renamed. */
- char *dst) /* New pathname for file or directory. */
+ CONST char *src, /* Pathname of file or dir to be renamed
+ * (UTF-8). */
+ CONST char *dst) /* New pathname of file or directory
+ * (UTF-8). */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoRenameFile(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString));
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoRenameFile(
+ CONST char *src, /* Pathname of file or dir to be renamed
+ * (native). */
+ CONST char *dst) /* New pathname of file or directory
+ * (native). */
{
FSSpec srcFileSpec, dstFileSpec, dstDirSpec;
OSErr err;
@@ -157,7 +189,7 @@ TclpRenameFile(
* fails, it's because it wasn't empty.
*/
- if (TclpRemoveDirectory(dst, 0, NULL) != TCL_OK) {
+ if (DoRemoveDirectory(dst, 0, NULL) != TCL_OK) {
return TCL_ERROR;
}
@@ -230,9 +262,128 @@ TclpRenameFile(
}
/*
+ *--------------------------------------------------------------------------
+ *
+ * MoveRename --
+ *
+ * Helper function for TclpRenameFile. Renames a file or directory
+ * into the same directory or another directory. The target name
+ * must not already exist in the destination directory.
+ *
+ * Don't use FSpMoveRenameCompat because it doesn't work with
+ * directories or with locked files.
+ *
+ * Results:
+ * Returns a mac error indicating the cause of the failure.
+ *
+ * Side effects:
+ * Creates a temp file in the target directory to handle a rename
+ * between directories.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+static OSErr
+MoveRename(
+ const FSSpec *srcFileSpecPtr, /* Source object. */
+ const FSSpec *dstDirSpecPtr, /* Destination directory. */
+ StringPtr copyName) /* New name for object in destination
+ * directory. */
+{
+ OSErr err;
+ long srcID, dstID;
+ Boolean srcIsDir, dstIsDir;
+ Str31 tmpName;
+ FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
+ Boolean locked;
+
+ if (srcFileSpecPtr->parID == 1) {
+ /*
+ * Trying to rename a volume.
+ */
+
+ return badMovErr;
+ }
+ if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
+ /*
+ * Renaming across volumes.
+ */
+
+ return diffVolErr;
+ }
+ err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
+ if (locked) {
+ FSpRstFLockCompat(srcFileSpecPtr);
+ }
+ if (err == noErr) {
+ err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
+ }
+ if (err == noErr) {
+ if (srcFileSpecPtr->parID == dstID) {
+ /*
+ * Renaming object within directory.
+ */
+
+ err = FSpRenameCompat(srcFileSpecPtr, copyName);
+ goto done;
+ }
+ if (Pstrequal(srcFileSpecPtr->name, copyName)) {
+ /*
+ * Moving object to another directory (under same name).
+ */
+
+ err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
+ goto done;
+ }
+ err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
+ }
+ if (err == noErr) {
+ /*
+ * Fullblown: rename source object to temp name, move temp to
+ * dest directory, and rename temp to target.
+ */
+
+ err = GenerateUniqueName(srcFileSpecPtr->vRefNum,
+ srcFileSpecPtr->parID, dstID, tmpName);
+ FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
+ tmpName, &tmpSrcFileSpec);
+ FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
+ &tmpDstFileSpec);
+ }
+ if (err == noErr) {
+ err = FSpRenameCompat(srcFileSpecPtr, tmpName);
+ }
+ if (err == noErr) {
+ err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
+ if (err == noErr) {
+ err = FSpRenameCompat(&tmpDstFileSpec, copyName);
+ if (err == noErr) {
+ goto done;
+ }
+ FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
+ NULL, &srcDirSpec);
+ FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
+ }
+ FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
+ }
+
+ done:
+ if (locked != false) {
+ if (err == noErr) {
+ FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum,
+ dstID, copyName, &dstFileSpec);
+ FSpSetFLockCompat(&dstFileSpec);
+ } else {
+ FSpSetFLockCompat(srcFileSpecPtr);
+ }
+ }
+ return err;
+}
+
+/*
*---------------------------------------------------------------------------
*
- * TclpCopyFile --
+ * TclpCopyFile, DoCopyFile --
*
* Copy a single file (not a directory). If dst already exists and
* is not a directory, it is removed.
@@ -258,8 +409,25 @@ TclpRenameFile(
int
TclpCopyFile(
- char *src, /* Pathname of file to be copied. */
- char *dst) /* Pathname of file to copy to. */
+ CONST char *src, /* Pathname of file to be copied (UTF-8). */
+ CONST char *dst) /* Pathname of file to copy to (UTF-8). */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoCopyFile(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString));
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoCopyFile(
+ CONST char *src, /* Pathname of file to be copied (native). */
+ CONST char *dst) /* Pathname of file to copy to (native). */
{
OSErr err, dstErr;
Boolean dstExists, dstIsDirectory, dstLocked;
@@ -328,7 +496,7 @@ TclpCopyFile(
/*
*---------------------------------------------------------------------------
*
- * TclpDeleteFile --
+ * TclpDeleteFile, DoDeleteFile --
*
* Removes a single file (not a directory).
*
@@ -349,13 +517,26 @@ TclpCopyFile(
int
TclpDeleteFile(
- char *path) /* Pathname of file to be removed. */
+ CONST char *path) /* Pathname of file to be removed (UTF-8). */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoDeleteFile(Tcl_DStringValue(&pathString));
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoDeleteFile(
+ CONST char *path) /* Pathname of file to be removed (native). */
{
OSErr err;
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
-
+
err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if (err == noErr) {
/*
@@ -387,7 +568,7 @@ TclpDeleteFile(
/*
*---------------------------------------------------------------------------
*
- * TclpCreateDirectory --
+ * TclpCreateDirectory, DoCreateDirectory --
*
* Creates the specified directory. All parent directories of the
* specified directory must already exist. The directory is
@@ -412,7 +593,20 @@ TclpDeleteFile(
int
TclpCreateDirectory(
- char *path) /* Pathname of directory to create. */
+ CONST char *path) /* Pathname of directory to create (UTF-8). */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoCreateDirectory(Tcl_DStringValue(&pathString));
+ Tcl_DStringFree(&pathString);
+ return result;
+}
+
+static int
+DoCreateDirectory(
+ CONST char *path) /* Pathname of directory to create (native). */
{
OSErr err;
FSSpec dirSpec;
@@ -435,7 +629,7 @@ TclpCreateDirectory(
/*
*---------------------------------------------------------------------------
*
- * TclpCopyDirectory --
+ * TclpCopyDirectory, DoCopyDirectory --
*
* Recursively copies a directory. The target directory dst must
* not already exist. Note that this function does not merge two
@@ -460,10 +654,33 @@ TclpCreateDirectory(
int
TclpCopyDirectory(
- char *src, /* Pathname of directory to be copied. */
- char *dst, /* Pathname of target directory. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
+ CONST char *src, /* Pathname of directory to be copied
+ * (UTF-8). */
+ CONST char *dst, /* Pathname of target directory (UTF-8). */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ int result;
+ Tcl_DString srcString, dstString;
+
+ Tcl_UtfToExternalDString(NULL, src, -1, &srcString);
+ Tcl_UtfToExternalDString(NULL, dst, -1, &dstString);
+ result = DoCopyDirectory(Tcl_DStringValue(&srcString),
+ Tcl_DStringValue(&dstString), errorPtr);
+ Tcl_DStringFree(&srcString);
+ Tcl_DStringFree(&dstString);
+ return result;
+}
+
+static int
+DoCopyDirectory(
+ CONST char *src, /* Pathname of directory to be copied
+ * (UTF-8). */
+ CONST char *dst, /* Pathname of target directory (UTF-8). */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
{
OSErr err, saveErr;
long srcID, tmpDirID;
@@ -572,7 +789,7 @@ TclpCopyDirectory(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, dst, -1);
+ Tcl_ExternalToUtfDString(NULL, dst, -1, errorPtr);
}
return TCL_ERROR;
}
@@ -604,10 +821,10 @@ CopyErrHandler(
short failedOperation, /* operation that caused the error */
short srcVRefNum, /* volume ref number of source */
long srcDirID, /* directory id of source */
- const unsigned char *srcName, /* name of source */
+ StringPtr srcName, /* name of source */
short dstVRefNum, /* volume ref number of dst */
long dstDirID, /* directory id of dst */
- const unsigned char *dstName) /* name of dst directory */
+ StringPtr dstName) /* name of dst directory */
{
return true;
}
@@ -615,7 +832,7 @@ CopyErrHandler(
/*
*---------------------------------------------------------------------------
*
- * TclpRemoveDirectory --
+ * TclpRemoveDirectory, DoRemoveDirectory --
*
* Removes directory (and its contents, if the recursive flag is set).
*
@@ -640,13 +857,37 @@ CopyErrHandler(
int
TclpRemoveDirectory(
- char *path, /* Pathname of directory to be removed. */
+ CONST char *path, /* Pathname of directory to be removed
+ * (UTF-8). */
+ int recursive, /* If non-zero, removes directories that
+ * are nonempty. Otherwise, will only remove
+ * empty directories. */
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
+ int result;
+ Tcl_DString pathString;
+
+ Tcl_UtfToExternalDString(NULL, path, -1, &pathString);
+ result = DoRemoveDirectory(Tcl_DStringValue(&pathString), recursive,
+ errorPtr);
+ Tcl_DStringFree(&pathString);
+
+ return result;
+}
+
+static int
+DoRemoveDirectory(
+ CONST char *path, /* Pathname of directory to be removed
+ * (native). */
int recursive, /* If non-zero, removes directories that
* are nonempty. Otherwise, will only remove
* empty directories. */
- Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
- * error reporting. */
-{
+ Tcl_DString *errorPtr) /* If non-NULL, uninitialized or free
+ * DString filled with UTF-8 name of file
+ * causing error. */
+{
OSErr err;
FSSpec fileSpec;
long dirID;
@@ -655,6 +896,7 @@ TclpRemoveDirectory(
CInfoPBRec pb;
Str255 fileName;
+
locked = 0;
err = FSpLocationFromPath(strlen(path), path, &fileSpec);
if (err != noErr) {
@@ -715,7 +957,7 @@ TclpRemoveDirectory(
done:
if (err != noErr) {
if (errorPtr != NULL) {
- Tcl_DStringAppend(errorPtr, path, -1);
+ Tcl_UtfToExternalDString(NULL, path, -1, errorPtr);
}
if (locked) {
FSpSetFLockCompat(&fileSpec);
@@ -725,130 +967,11 @@ TclpRemoveDirectory(
}
return TCL_OK;
}
-
-/*
- *--------------------------------------------------------------------------
- *
- * MoveRename --
- *
- * Helper function for TclpRenameFile. Renames a file or directory
- * into the same directory or another directory. The target name
- * must not already exist in the destination directory.
- *
- * Don't use FSpMoveRenameCompat because it doesn't work with
- * directories or with locked files.
- *
- * Results:
- * Returns a mac error indicating the cause of the failure.
- *
- * Side effects:
- * Creates a temp file in the target directory to handle a rename
- * between directories.
- *
- *--------------------------------------------------------------------------
- */
-
-static OSErr
-MoveRename(
- const FSSpec *srcFileSpecPtr, /* Source object. */
- const FSSpec *dstDirSpecPtr, /* Destination directory. */
- StringPtr copyName) /* New name for object in destination
- * directory. */
-{
- OSErr err;
- long srcID, dstID;
- Boolean srcIsDir, dstIsDir;
- Str31 tmpName;
- FSSpec dstFileSpec, srcDirSpec, tmpSrcFileSpec, tmpDstFileSpec;
- Boolean locked;
-
- if (srcFileSpecPtr->parID == 1) {
- /*
- * Trying to rename a volume.
- */
-
- return badMovErr;
- }
- if (srcFileSpecPtr->vRefNum != dstDirSpecPtr->vRefNum) {
- /*
- * Renaming across volumes.
- */
-
- return diffVolErr;
- }
- err = FSpGetFLockCompat(srcFileSpecPtr, &locked);
- if (locked) {
- FSpRstFLockCompat(srcFileSpecPtr);
- }
- if (err == noErr) {
- err = FSpGetDirectoryID(dstDirSpecPtr, &dstID, &dstIsDir);
- }
- if (err == noErr) {
- if (srcFileSpecPtr->parID == dstID) {
- /*
- * Renaming object within directory.
- */
-
- err = FSpRenameCompat(srcFileSpecPtr, copyName);
- goto done;
- }
- if (Pstrequal(srcFileSpecPtr->name, copyName)) {
- /*
- * Moving object to another directory (under same name).
- */
-
- err = FSpCatMoveCompat(srcFileSpecPtr, dstDirSpecPtr);
- goto done;
- }
- err = FSpGetDirectoryID(srcFileSpecPtr, &srcID, &srcIsDir);
- }
- if (err == noErr) {
- /*
- * Fullblown: rename source object to temp name, move temp to
- * dest directory, and rename temp to target.
- */
-
- err = GenerateUniqueName(srcFileSpecPtr->vRefNum,
- srcFileSpecPtr->parID, dstID, tmpName);
- FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
- tmpName, &tmpSrcFileSpec);
- FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum, dstID, tmpName,
- &tmpDstFileSpec);
- }
- if (err == noErr) {
- err = FSpRenameCompat(srcFileSpecPtr, tmpName);
- }
- if (err == noErr) {
- err = FSpCatMoveCompat(&tmpSrcFileSpec, dstDirSpecPtr);
- if (err == noErr) {
- err = FSpRenameCompat(&tmpDstFileSpec, copyName);
- if (err == noErr) {
- goto done;
- }
- FSMakeFSSpecCompat(srcFileSpecPtr->vRefNum, srcFileSpecPtr->parID,
- NULL, &srcDirSpec);
- FSpCatMoveCompat(&tmpDstFileSpec, &srcDirSpec);
- }
- FSpRenameCompat(&tmpSrcFileSpec, srcFileSpecPtr->name);
- }
-
- done:
- if (locked != false) {
- if (err == noErr) {
- FSMakeFSSpecCompat(dstDirSpecPtr->vRefNum,
- dstID, copyName, &dstFileSpec);
- FSpSetFLockCompat(&dstFileSpec);
- } else {
- FSpSetFLockCompat(srcFileSpecPtr);
- }
- }
- return err;
-}
/*
*---------------------------------------------------------------------------
*
- * GetFileSpecs --
+ * GenerateUniqueName --
*
* Generate a filename that is not in either of the two specified
* directories (on the same volume).
@@ -928,7 +1051,7 @@ GenerateUniqueName(
static OSErr
GetFileSpecs(
- char *path, /* The path to query. */
+ CONST char *path, /* The path to query. */
FSSpec *pathSpecPtr, /* Filled with information about path. */
FSSpec *dirSpecPtr, /* Filled with information about path's
* parent directory. */
@@ -1071,7 +1194,7 @@ static int
GetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute option. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file. */
Tcl_Obj **attributePtrPtr) /* A pointer to return the object with. */
{
OSErr err;
@@ -1114,7 +1237,7 @@ GetFileFinderAttributes(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't get attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1146,7 +1269,7 @@ static int
GetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file. */
Tcl_Obj **readOnlyPtrPtr) /* A pointer to return the object with. */
{
OSErr err;
@@ -1179,7 +1302,7 @@ GetFileReadOnly(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't get attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1207,7 +1330,7 @@ static int
SetFileFinderAttributes(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file. */
Tcl_Obj *attributePtr) /* The command line object. */
{
OSErr err;
@@ -1267,7 +1390,7 @@ SetFileFinderAttributes(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't set attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1295,7 +1418,7 @@ static int
SetFileReadOnly(
Tcl_Interp *interp, /* The interp to report errors with. */
int objIndex, /* The index of the attribute. */
- char *fileName, /* The name of the file. */
+ CONST char *fileName, /* The name of the file. */
Tcl_Obj *readOnlyPtr) /* The command line object. */
{
OSErr err;
@@ -1338,7 +1461,7 @@ SetFileReadOnly(
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
- "couldn't set attributes for file \"", fileName, "\": ",
+ "could not read \"", fileName, "\": ",
Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
@@ -1362,7 +1485,6 @@ SetFileReadOnly(
*
*---------------------------------------------------------------------------
*/
-
int
TclpListVolumes(
Tcl_Interp *interp) /* Interpreter to which to pass the volume list */
@@ -1372,6 +1494,7 @@ TclpListVolumes(
OSErr theError = noErr;
Tcl_Obj *resultPtr, *elemPtr;
short volIndex = 1;
+ Tcl_DString dstr;
resultPtr = Tcl_NewObj();
@@ -1386,7 +1509,7 @@ TclpListVolumes(
*/
while ( 1 ) {
- pb.volumeParam.ioNamePtr = (StringPtr) & name;
+ pb.volumeParam.ioNamePtr = (StringPtr) &name;
pb.volumeParam.ioVolIndex = volIndex;
theError = PBHGetVInfoSync(&pb);
@@ -1394,10 +1517,14 @@ TclpListVolumes(
if ( theError != noErr ) {
break;
}
-
- elemPtr = Tcl_NewStringObj((char *) name + 1, (int) name[0]);
+
+ Tcl_ExternalToUtfDString(NULL, (char *) &name[1], name[0], &dstr);
+ elemPtr = Tcl_NewStringObj(Tcl_DStringValue(&dstr),
+ Tcl_DStringLength(&dstr));
Tcl_AppendToObj(elemPtr, ":", 1);
Tcl_ListObjAppendElement(interp, resultPtr, elemPtr);
+
+ Tcl_DStringFree(&dstr);
volIndex++;
}
diff --git a/mac/tclMacFile.c b/mac/tclMacFile.c
index 2fc697e..94582bd 100644
--- a/mac/tclMacFile.c
+++ b/mac/tclMacFile.c
@@ -5,12 +5,12 @@
* files. It also comtains Macintosh version of other Tcl
* functions that deal with the file system.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 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: tclMacFile.c,v 1.5 1999/03/10 05:52:51 stanton Exp $
+ * RCS: @(#) $Id: tclMacFile.c,v 1.6 1999/04/16 00:47:20 stanton Exp $
*/
/*
@@ -34,164 +34,10 @@
/*
* Static variables used by the TclpStat function.
*/
-static int initalized = false;
+static int initialized = false;
static long gmt_offset;
+TCL_DECLARE_MUTEX(gmtMutex)
-/*
- * The variable below caches the name of the current working directory
- * in order to avoid repeated calls to getcwd. The string is malloc-ed.
- * NULL means the cache needs to be refreshed.
- */
-
-static char *currentDir = NULL;
-
-/*
- *----------------------------------------------------------------------
- *
- * TclChdir --
- *
- * Change the current working directory.
- *
- * Results:
- * The result is a standard Tcl result. If an error occurs and
- * interp isn't NULL, an error message is left in interp->result.
- *
- * Side effects:
- * The working directory for this application is changed. Also
- * the cache maintained used by TclGetCwd is deallocated and
- * set to NULL.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclChdir(
- Tcl_Interp *interp, /* If non NULL, used for error reporting. */
- char *dirName) /* Path to new working directory. */
-{
- FSSpec spec;
- OSErr err;
- Boolean isFolder;
- long dirID;
-
- if (currentDir != NULL) {
- ckfree(currentDir);
- currentDir = NULL;
- }
-
- err = FSpLocationFromPath(strlen(dirName), dirName, &spec);
- if (err != noErr) {
- errno = ENOENT;
- goto chdirError;
- }
-
- err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
- if (err != noErr) {
- errno = ENOENT;
- goto chdirError;
- }
-
- if (isFolder != true) {
- errno = ENOTDIR;
- goto chdirError;
- }
-
- err = FSpSetDefaultDir(&spec);
- if (err != noErr) {
- switch (err) {
- case afpAccessDenied:
- errno = EACCES;
- break;
- default:
- errno = ENOENT;
- }
- goto chdirError;
- }
-
- return TCL_OK;
- chdirError:
- if (interp != NULL) {
- Tcl_AppendResult(interp, "couldn't change working directory to \"",
- dirName, "\": ", Tcl_PosixError(interp), (char *) NULL);
- }
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetCwd --
- *
- * Return the path name of the current working directory.
- *
- * Results:
- * The result is the full path name of the current working
- * directory, or NULL if an error occurred while figuring it
- * out. If an error occurs and interp isn't NULL, an error
- * message is left in interp->result.
- *
- * Side effects:
- * The path name is cached to avoid having to recompute it
- * on future calls; if it is already cached, the cached
- * value is returned.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-TclGetCwd(
- Tcl_Interp *interp) /* If non NULL, used for error reporting. */
-{
- FSSpec theSpec;
- int length;
- Handle pathHandle = NULL;
-
- if (currentDir == NULL) {
- if (FSpGetDefaultDir(&theSpec) != noErr) {
- if (interp != NULL) {
- interp->result = "error getting working directory name";
- }
- return NULL;
- }
- if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
- if (interp != NULL) {
- interp->result = "error getting working directory name";
- }
- return NULL;
- }
- HLock(pathHandle);
- currentDir = (char *) ckalloc((unsigned) (length + 1));
- strcpy(currentDir, *pathHandle);
- HUnlock(pathHandle);
- DisposeHandle(pathHandle);
- }
- return currentDir;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitPid --
- *
- * Fakes a call to wait pid.
- *
- * Results:
- * Always returns -1.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_Pid
-Tcl_WaitPid(
- Tcl_Pid pid,
- int *statPtr,
- int options)
-{
- return (Tcl_Pid) -1;
-}
/*
*----------------------------------------------------------------------
@@ -200,7 +46,7 @@ Tcl_WaitPid(
*
* This procedure computes the absolute path name of the current
* application, given its argv[0] value. However, this
- * implementation doesn't use of need the argv[0] value. NULL
+ * implementation doesn't need the argv[0] value. NULL
* may be passed in its place.
*
* Results:
@@ -216,7 +62,7 @@ Tcl_WaitPid(
void
Tcl_FindExecutable(
- char *argv0) /* The value of the application's argv[0]. */
+ CONST char *argv0) /* The value of the application's argv[0]. */
{
ProcessSerialNumber psn;
ProcessInfoRec info;
@@ -225,6 +71,9 @@ Tcl_FindExecutable(
int pathLength;
Handle pathName = NULL;
OSErr err;
+ Tcl_DString ds;
+
+ TclInitSubsystems(argv0);
GetCurrentProcess(&psn);
info.processInfoLength = sizeof(ProcessInfoRec);
@@ -238,52 +87,28 @@ Tcl_FindExecutable(
}
err = FSpPathFromLocation(&fileSpec, &pathLength, &pathName);
-
- tclExecutableName = (char *) ckalloc((unsigned) pathLength + 1);
HLock(pathName);
- strcpy(tclExecutableName, *pathName);
+ Tcl_ExternalToUtfDString(NULL, *pathName, pathLength, &ds);
HUnlock(pathName);
DisposeHandle(pathName);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclGetUserHome --
- *
- * This function takes the passed in user name and finds the
- * corresponding home directory specified in the password file.
- *
- * Results:
- * On a Macintosh we always return a NULL.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-char *
-TclGetUserHome(
- char *name, /* User name to use to find home directory. */
- Tcl_DString *bufferPtr) /* May be used to hold result. Must not hold
- * anything at the time of the call, and need
- * not even be initialized. */
-{
- return NULL;
+ tclExecutableName = (char *) ckalloc((unsigned)
+ (Tcl_DStringLength(&ds) + 1));
+ strcpy(tclExecutableName, Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
}
/*
*----------------------------------------------------------------------
*
- * TclMatchFiles --
+ * TclpMatchFiles --
*
* This routine is used by the globbing code to search a
* directory for all files which match a given pattern.
*
* Results:
* If the tail argument is NULL, then the matching files are
- * added to the interp->result. Otherwise, TclDoGlob is called
+ * added to the the interp's result. Otherwise, TclDoGlob is called
* recursively for each matching subdirectory. The return value
* is a standard Tcl result indicating whether an error occurred
* in globbing.
@@ -294,13 +119,14 @@ TclGetUserHome(
*---------------------------------------------------------------------- */
int
-TclMatchFiles(
+TclpMatchFiles(
Tcl_Interp *interp, /* Interpreter to receive results. */
char *separators, /* Directory separators to pass to TclDoGlob. */
Tcl_DString *dirPtr, /* Contains path to directory to search. */
char *pattern, /* Pattern to match against. */
char *tail) /* Pointer to end of pattern. Tail must
- * point to a location in pattern. */
+ * point to a location in pattern and must
+ * not be static.*/
{
char *dirName, *patternEnd = tail;
char savedChar;
@@ -313,7 +139,7 @@ TclMatchFiles(
long dirID;
short itemIndex;
Str255 fileName;
-
+ Tcl_DString fileString;
/*
* Make sure that the directory part of the name really is a
@@ -368,11 +194,12 @@ TclMatchFiles(
* directories before calling TclDoGlob. Otherwise, just add
* the file to the result.
*/
-
- p2cstr(fileName);
- if (Tcl_StringMatch((char *) fileName, pattern)) {
+
+ Tcl_ExternalToUtfDString(NULL, (char *) fileName + 1, fileName[0],
+ &fileString);
+ if (Tcl_StringMatch(Tcl_DStringValue(&fileString), pattern)) {
Tcl_DStringSetLength(dirPtr, baseLength);
- Tcl_DStringAppend(dirPtr, (char *) fileName, -1);
+ Tcl_DStringAppend(dirPtr, Tcl_DStringValue(&fileString), -1);
if (tail == NULL) {
if ((dirPtr->length > 1) &&
(strchr(dirPtr->string+1, ':') == NULL)) {
@@ -384,10 +211,12 @@ TclMatchFiles(
Tcl_DStringAppend(dirPtr, ":", 1);
result = TclDoGlob(interp, separators, dirPtr, tail);
if (result != TCL_OK) {
+ Tcl_DStringFree(&fileString);
break;
}
}
}
+ Tcl_DStringFree(&fileString);
itemIndex++;
}
@@ -399,25 +228,23 @@ TclMatchFiles(
/*
*----------------------------------------------------------------------
*
- * TclpStat --
+ * TclpAccess --
*
- * This function replaces the library version of stat. The stat
- * function provided by most Mac compiliers is rather broken and
- * incomplete.
+ * This function replaces the library version of access().
*
* Results:
- * See stat documentation.
+ * See access documentation.
*
* Side effects:
- * See stat documentation.
+ * See access documentation.
*
*----------------------------------------------------------------------
*/
int
-TclpStat(
- CONST char *path,
- struct stat *buf)
+TclpAccess(
+ CONST char *path, /* Path of file to access (UTF-8). */
+ int mode) /* Permission setting. */
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -425,8 +252,14 @@ TclpStat(
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
-
- err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+ Tcl_DString ds;
+ char *native;
+ int full_mode = 0;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
+ Tcl_DStringFree(&ds);
+
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
@@ -435,7 +268,6 @@ TclpStat(
/*
* Fill the fpb & vpb struct up with info about file or directory.
*/
-
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
@@ -450,101 +282,189 @@ TclpStat(
if (err == noErr) {
vpb.ioVolIndex = 0;
err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
- if (err == noErr && buf != NULL) {
+ if (err == noErr) {
/*
- * Files are always readable by everyone.
+ * Use the Volume Info & File Info to determine
+ * access information. If we have got this far
+ * we know the directory is searchable or the file
+ * exists. (We have F_OK)
*/
-
- buf->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
- /*
- * Use the Volume Info & File Info to fill out stat buf.
+ /*
+ * Check to see if the volume is hardware or
+ * software locked. If so we arn't W_OK.
*/
- if (fpb.ioFlAttrib & 0x10) {
- buf->st_mode |= S_IFDIR;
- buf->st_nlink = 2;
- } else {
- buf->st_nlink = 1;
- if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
- buf->st_mode |= S_IFLNK;
- } else {
- buf->st_mode |= S_IFREG;
+ if (mode & W_OK) {
+ if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
+ errno = EROFS;
+ return -1;
+ }
+ if (fpb.ioFlAttrib & 0x01) {
+ errno = EACCES;
+ return -1;
}
}
- if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
- /*
- * Directories and applications are executable by everyone.
- */
-
- buf->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
- }
- if ((fpb.ioFlAttrib & 0x01) == 0){
- /*
- * If not locked, then everyone has write acces.
- */
-
- buf->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
- }
- buf->st_ino = fpb.ioDirID;
- buf->st_dev = fpb.ioVRefNum;
- buf->st_uid = -1;
- buf->st_gid = -1;
- buf->st_rdev = 0;
- buf->st_size = fpb.ioFlLgLen;
- buf->st_blksize = vpb.ioVAlBlkSiz;
- buf->st_blocks = (buf->st_size + buf->st_blksize - 1)
- / buf->st_blksize;
-
+
/*
- * The times returned by the Mac file system are in the
- * local time zone. We convert them to GMT so that the
- * epoch starts from GMT. This is also consistant with
- * what is returned from "clock seconds".
+ * Directories are always searchable and executable. But only
+ * files of type 'APPL' are executable.
*/
- if (initalized == false) {
- MachineLocation loc;
-
- ReadLocation(&loc);
- gmt_offset = loc.u.gmtDelta & 0x00ffffff;
- if (gmt_offset & 0x00800000) {
- gmt_offset = gmt_offset | 0xff000000;
- }
- initalized = true;
+ if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
+ && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
+ return -1;
}
- buf->st_atime = buf->st_mtime = fpb.ioFlMdDat - gmt_offset;
- buf->st_ctime = fpb.ioFlCrDat - gmt_offset;
-
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
+ return -1;
}
- return (err == noErr ? 0 : -1);
+ return 0;
}
/*
*----------------------------------------------------------------------
*
- * TclMacReadlink --
+ * TclpChdir --
*
- * This function replaces the library version of readlink.
+ * This function replaces the library version of chdir().
*
* Results:
- * See readlink documentation.
+ * See chdir() documentation.
*
* Side effects:
- * None.
+ * See chdir() documentation. Also the cache maintained used by
+ * TclGetCwd() is deallocated and set to NULL.
*
*----------------------------------------------------------------------
*/
int
-TclMacReadlink(
- char *path,
- char *buf,
- int size)
+TclpChdir(
+ CONST char *dirName) /* Path to new working directory (UTF-8). */
+{
+ FSSpec spec;
+ OSErr err;
+ Boolean isFolder;
+ long dirID;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &spec);
+ Tcl_DStringFree(&ds);
+
+ if (err != noErr) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ err = FSpGetDirectoryID(&spec, &dirID, &isFolder);
+ if (err != noErr) {
+ errno = ENOENT;
+ return -1;
+ }
+
+ if (isFolder != true) {
+ errno = ENOTDIR;
+ return -1;
+ }
+
+ err = FSpSetDefaultDir(&spec);
+ if (err != noErr) {
+ switch (err) {
+ case afpAccessDenied:
+ errno = EACCES;
+ break;
+ default:
+ errno = ENOENT;
+ }
+ return -1;
+ }
+
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpGetCwd --
+ *
+ * This function replaces the library version of getcwd().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the current
+ * directory, or NULL if the current directory could not be
+ * determined. If NULL is returned, an error message is left in the
+ * interp's result. Storage for the result string is allocated in
+ * bufferPtr; the caller must call Tcl_DStringFree() when the result
+ * is no longer needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TclpGetCwd(
+ Tcl_Interp *interp, /* If non-NULL, used for error reporting. */
+ Tcl_DString *bufferPtr) /* Uninitialized or free DString filled
+ * with name of current directory. */
+{
+ FSSpec theSpec;
+ int length;
+ Handle pathHandle = NULL;
+
+ if (FSpGetDefaultDir(&theSpec) != noErr) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "error getting working directory name",
+ TCL_STATIC);
+ }
+ return NULL;
+ }
+ if (FSpPathFromLocation(&theSpec, &length, &pathHandle) != noErr) {
+ if (interp != NULL) {
+ Tcl_SetResult(interp, "error getting working directory name",
+ TCL_STATIC);
+ }
+ return NULL;
+ }
+ HLock(pathHandle);
+ Tcl_ExternalToUtfDString(NULL, *pathHandle, length, bufferPtr);
+ HUnlock(pathHandle);
+ DisposeHandle(pathHandle);
+
+ return Tcl_DStringValue(bufferPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpReadlink --
+ *
+ * This function replaces the library version of readlink().
+ *
+ * Results:
+ * The result is a pointer to a string specifying the contents
+ * of the symbolic link given by 'path', or NULL if the symbolic
+ * link could not be read. Storage for the result string is
+ * allocated in bufferPtr; the caller must call Tcl_DStringFree()
+ * when the result is no longer needed.
+ *
+ * Side effects:
+ * See readlink() documentation.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclpReadlink(
+ CONST char *path, /* Path of file to readlink (UTF-8). */
+ Tcl_DString *linkPtr) /* Uninitialized or free DString filled
+ * with contents of link (UTF-8). */
{
HFileInfo fpb;
OSErr err;
@@ -552,45 +472,54 @@ TclMacReadlink(
Boolean isDirectory;
Boolean wasAlias;
long dirID;
- char fileName[256];
+ char fileName[257];
char *end;
Handle theString = NULL;
int pathSize;
+ Tcl_DString ds;
+ char *native;
+
+ native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
/*
* Remove ending colons if they exist.
*/
- while ((strlen(path) != 0) && (path[strlen(path) - 1] == ':')) {
- path[strlen(path) - 1] = NULL;
+
+ while ((strlen(native) != 0) && (path[strlen(native) - 1] == ':')) {
+ native[strlen(native) - 1] = NULL;
}
- if (strchr(path, ':') == NULL) {
- strcpy(fileName, path);
- path = NULL;
+ if (strchr(native, ':') == NULL) {
+ strcpy(fileName + 1, native);
+ native = NULL;
} else {
- end = strrchr(path, ':') + 1;
- strcpy(fileName, end);
+ end = strrchr(native, ':') + 1;
+ strcpy(fileName + 1, end);
*end = NULL;
}
- c2pstr(fileName);
+ fileName[0] = (char) strlen(fileName + 1);
/*
* Create the file spec for the directory of the file
* we want to look at.
*/
- if (path != NULL) {
- err = FSpLocationFromPath(strlen(path), path, &fileSpec);
+
+ if (native != NULL) {
+ err = FSpLocationFromPath(strlen(native), native, &fileSpec);
if (err != noErr) {
+ Tcl_DStringFree(&ds);
errno = EINVAL;
- return -1;
+ return NULL;
}
} else {
FSMakeFSSpecCompat(0, 0, NULL, &fileSpec);
}
+ Tcl_DStringFree(&ds);
/*
* Fill the fpb struct up with info about file or directory.
*/
+
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
fpb.ioVRefNum = fileSpec.vRefNum;
fpb.ioDirID = dirID;
@@ -600,11 +529,11 @@ TclMacReadlink(
err = PBGetCatInfoSync((CInfoPBPtr)&fpb);
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
- return -1;
+ return NULL;
} else {
if (fpb.ioFlAttrib & 0x10) {
errno = EINVAL;
- return -1;
+ return NULL;
} else {
if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
/*
@@ -612,7 +541,7 @@ TclMacReadlink(
*/
} else {
errno = EINVAL;
- return -1;
+ return NULL;
}
}
}
@@ -621,50 +550,49 @@ TclMacReadlink(
* If we are here it's really a link - now find out
* where it points to.
*/
- err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName, &fileSpec);
+ err = FSMakeFSSpecCompat(fileSpec.vRefNum, dirID, (StringPtr) fileName,
+ &fileSpec);
if (err == noErr) {
err = ResolveAliasFile(&fileSpec, true, &isDirectory, &wasAlias);
}
if ((err == fnfErr) || wasAlias) {
err = FSpPathFromLocation(&fileSpec, &pathSize, &theString);
- if ((err != noErr) || (pathSize > size)) {
+ if (err != noErr) {
DisposeHandle(theString);
errno = ENAMETOOLONG;
- return -1;
+ return NULL;
}
} else {
errno = EINVAL;
- return -1;
+ return NULL;
}
-
- strncpy(buf, *theString, pathSize);
+
+ Tcl_ExternalToUtfDString(NULL, *theString, pathSize, linkPtr);
DisposeHandle(theString);
- return pathSize;
+ return Tcl_DStringValue(linkPtr);
}
/*
*----------------------------------------------------------------------
*
- * TclpAccess --
+ * TclpStat --
*
- * This function replaces the library version of access. The
- * access function provided by most Mac compiliers is rather
- * broken or incomplete.
+ * This function replaces the library version of stat().
*
* Results:
- * See access documentation.
+ * See stat() documentation.
*
* Side effects:
- * See access documentation.
+ * See stat() documentation.
*
*----------------------------------------------------------------------
*/
int
-TclpAccess(
- const char *path,
- int mode)
+TclpStat(
+ CONST char *path, /* Path of file to stat (in UTF-8). */
+ struct stat *bufPtr) /* Filled with results of stat call. */
{
HFileInfo fpb;
HVolumeParam vpb;
@@ -672,9 +600,12 @@ TclpAccess(
FSSpec fileSpec;
Boolean isDirectory;
long dirID;
- int full_mode = 0;
-
- err = FSpLocationFromPath(strlen(path), (char *) path, &fileSpec);
+ Tcl_DString ds;
+
+ path = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), path, &fileSpec);
+ Tcl_DStringFree(&ds);
+
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
return -1;
@@ -683,6 +614,7 @@ TclpAccess(
/*
* Fill the fpb & vpb struct up with info about file or directory.
*/
+
FSpGetDirectoryID(&fileSpec, &dirID, &isDirectory);
vpb.ioVRefNum = fpb.ioVRefNum = fileSpec.vRefNum;
vpb.ioNamePtr = fpb.ioNamePtr = fileSpec.name;
@@ -697,46 +629,106 @@ TclpAccess(
if (err == noErr) {
vpb.ioVolIndex = 0;
err = PBHGetVInfoSync((HParmBlkPtr)&vpb);
- if (err == noErr) {
+ if (err == noErr && bufPtr != NULL) {
/*
- * Use the Volume Info & File Info to determine
- * access information. If we have got this far
- * we know the directory is searchable or the file
- * exists. (We have F_OK)
+ * Files are always readable by everyone.
*/
+
+ bufPtr->st_mode = S_IRUSR | S_IRGRP | S_IROTH;
- /*
- * Check to see if the volume is hardware or
- * software locked. If so we arn't W_OK.
+ /*
+ * Use the Volume Info & File Info to fill out stat buf.
*/
- if (mode & W_OK) {
- if ((vpb.ioVAtrb & 0x0080) || (vpb.ioVAtrb & 0x8000)) {
- errno = EROFS;
- return -1;
- }
- if (fpb.ioFlAttrib & 0x01) {
- errno = EACCES;
- return -1;
+ if (fpb.ioFlAttrib & 0x10) {
+ bufPtr->st_mode |= S_IFDIR;
+ bufPtr->st_nlink = 2;
+ } else {
+ bufPtr->st_nlink = 1;
+ if (fpb.ioFlFndrInfo.fdFlags & 0x8000) {
+ bufPtr->st_mode |= S_IFLNK;
+ } else {
+ bufPtr->st_mode |= S_IFREG;
}
}
-
+ if ((fpb.ioFlAttrib & 0x10) || (fpb.ioFlFndrInfo.fdType == 'APPL')) {
+ /*
+ * Directories and applications are executable by everyone.
+ */
+
+ bufPtr->st_mode |= S_IXUSR | S_IXGRP | S_IXOTH;
+ }
+ if ((fpb.ioFlAttrib & 0x01) == 0){
+ /*
+ * If not locked, then everyone has write acces.
+ */
+
+ bufPtr->st_mode |= S_IWUSR | S_IWGRP | S_IWOTH;
+ }
+ bufPtr->st_ino = fpb.ioDirID;
+ bufPtr->st_dev = fpb.ioVRefNum;
+ bufPtr->st_uid = -1;
+ bufPtr->st_gid = -1;
+ bufPtr->st_rdev = 0;
+ bufPtr->st_size = fpb.ioFlLgLen;
+ bufPtr->st_blksize = vpb.ioVAlBlkSiz;
+ bufPtr->st_blocks = (bufPtr->st_size + bufPtr->st_blksize - 1)
+ / bufPtr->st_blksize;
+
/*
- * Directories are always searchable and executable. But only
- * files of type 'APPL' are executable.
+ * The times returned by the Mac file system are in the
+ * local time zone. We convert them to GMT so that the
+ * epoch starts from GMT. This is also consistant with
+ * what is returned from "clock seconds".
*/
- if (!(fpb.ioFlAttrib & 0x10) && (mode & X_OK)
- && (fpb.ioFlFndrInfo.fdType != 'APPL')) {
- return -1;
+
+ Tcl_MutexLock(&gmtMutex);
+ if (initialized == false) {
+ MachineLocation loc;
+
+ ReadLocation(&loc);
+ gmt_offset = loc.u.gmtDelta & 0x00ffffff;
+ if (gmt_offset & 0x00800000) {
+ gmt_offset = gmt_offset | 0xff000000;
+ }
+ initialized = true;
}
+ Tcl_MutexUnlock(&gmtMutex);
+
+ bufPtr->st_atime = bufPtr->st_mtime = fpb.ioFlMdDat - gmt_offset;
+ bufPtr->st_ctime = fpb.ioFlCrDat - gmt_offset;
}
}
if (err != noErr) {
errno = TclMacOSErrorToPosixError(err);
- return -1;
}
- return 0;
+ return (err == noErr ? 0 : -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitPid --
+ *
+ * Fakes a call to wait pid.
+ *
+ * Results:
+ * Always returns -1.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Pid
+Tcl_WaitPid(
+ Tcl_Pid pid,
+ int *statPtr,
+ int options)
+{
+ return (Tcl_Pid) -1;
}
/*
@@ -759,8 +751,8 @@ TclpAccess(
#undef fopen
FILE *
TclMacFOpenHack(
- const char *path,
- const char *mode)
+ CONST char *path,
+ CONST char *mode)
{
OSErr err;
FSSpec fileSpec;
diff --git a/mac/tclMacInit.c b/mac/tclMacInit.c
index 13015a5..6bf6169 100644
--- a/mac/tclMacInit.c
+++ b/mac/tclMacInit.c
@@ -3,59 +3,518 @@
*
* Contains the Mac-specific interpreter initialization functions.
*
- * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1995-1998 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: tclMacInit.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacInit.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
+#include <AppleEvents.h>
+#include <AEDataModel.h>
+#include <AEObjects.h>
+#include <AEPackObject.h>
+#include <AERegistry.h>
#include <Files.h>
+#include <Folders.h>
#include <Gestalt.h>
#include <TextUtils.h>
#include <Resources.h>
#include <Strings.h>
#include "tclInt.h"
#include "tclMacInt.h"
+#include "tclPort.h"
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It looks on the library path and in the resource fork for
+ * a script "init.tcl" that is compatible with this version of Tcl. The
+ * init.tcl script does all of the real work of initialization.
+ */
+
+static char initCmd[] = "\
+proc sourcePath {file} {\n\
+ set dirs {}\n\
+ foreach i $::auto_path {\n\
+ set init [file join $i $file.tcl]\n\
+ if {[catch {uplevel #0 [list source $init]}] == 0} {\n\
+ return\n\
+ }\n\
+ }\n\
+ if {[catch {uplevel #0 [list source -rsrc $file]}] == 0} {\n\
+ return\n\
+ }\n\
+ rename sourcePath {}\n\
+ set msg \"can't find $file resource or a usable $file.tcl file\n\"\n\
+ append msg \"in the following directories:\n\"\n\
+ append msg \" $::auto_path\n\"\n\
+ append msg \" perhaps you need to install Tcl or set your \n\"\n\
+ append msg \"TCL_LIBRARY environment variable?\"\n\
+ error $msg\n\
+}\n\
+if {[info exists env(EXT_FOLDER)]} {\n\
+ lappend tcl_pkgPath [file join $env(EXT_FOLDER) {:Tool Command Language}]\n\
+}\n\
+if {[info exists tcl_pkgPath] == 0} {\n\
+ set tcl_pkgPath {no extension folder}\n\
+}\n\
+sourcePath Init\n\
+sourcePath Auto\n\
+sourcePath Package\n\
+sourcePath History\n\
+sourcePath Word\n\
+rename sourcePath {}";
+
+/*
+ * The following structures are used to map the script/language codes of a
+ * font to the name that should be passed to Tcl_GetEncoding() to obtain
+ * the encoding for that font. The set of numeric constants is fixed and
+ * defined by Apple.
+ */
+
+typedef struct Map {
+ int numKey;
+ char *strKey;
+} Map;
+
+static Map scriptMap[] = {
+ {smRoman, "macRoman"},
+ {smJapanese, "macJapan"},
+ {smTradChinese, "macChinese"},
+ {smKorean, "macKorean"},
+ {smArabic, "macArabic"},
+ {smHebrew, "macHebrew"},
+ {smGreek, "macGreek"},
+ {smCyrillic, "macCyrillic"},
+ {smRSymbol, "macRSymbol"},
+ {smDevanagari, "macDevanagari"},
+ {smGurmukhi, "macGurmukhi"},
+ {smGujarati, "macGujarati"},
+ {smOriya, "macOriya"},
+ {smBengali, "macBengali"},
+ {smTamil, "macTamil"},
+ {smTelugu, "macTelugu"},
+ {smKannada, "macKannada"},
+ {smMalayalam, "macMalayalam"},
+ {smSinhalese, "macSinhalese"},
+ {smBurmese, "macBurmese"},
+ {smKhmer, "macKhmer"},
+ {smThai, "macThailand"},
+ {smLaotian, "macLaos"},
+ {smGeorgian, "macGeorgia"},
+ {smArmenian, "macArmenia"},
+ {smSimpChinese, "macSimpChinese"},
+ {smTibetan, "macTIbet"},
+ {smMongolian, "macMongolia"},
+ {smGeez, "macEthiopia"},
+ {smEastEurRoman, "macCentEuro"},
+ {smVietnamese, "macVietnam"},
+ {smExtArabic, "macSindhi"},
+ {NULL, NULL}
+};
+
+static Map romanMap[] = {
+ {langCroatian, "macCroatian"},
+ {langSlovenian, "macCroatian"},
+ {langIcelandic, "macIceland"},
+ {langRomanian, "macRomania"},
+ {langTurkish, "macTurkish"},
+ {langGreek, "macGreek"},
+ {NULL, NULL}
+};
+
+static Map cyrillicMap[] = {
+ {langUkrainian, "macUkraine"},
+ {langBulgarian, "macBulgaria"},
+ {NULL, NULL}
+};
+
+static int GetFinderFont(int *finderID);
+
/*
*----------------------------------------------------------------------
*
- * TclPlatformInit --
+ * GetFinderFont --
*
- * Performs Mac-specific interpreter initialization related to the
- * tcl_platform and tcl_library variables.
+ * Gets the "views" font of the Macintosh Finder
*
* Results:
- * None.
+ * Standard Tcl result, and sets finderID to the font family
+ * id for the current finder font.
*
* Side effects:
- * Sets "tcl_library" & "tcl_platfrom" Tcl variable
+ * None.
*
*----------------------------------------------------------------------
*/
+static int
+GetFinderFont(int *finderID)
+{
+ OSErr err = noErr;
+ OSType finderPrefs, viewFont = 'vfnt';
+ DescType returnType;
+ Size returnSize;
+ long result, sys8Mask = 0x0800;
+ static AppleEvent outgoingAevt = {typeNull, NULL};
+ AppleEvent returnAevt;
+ AEAddressDesc fndrAddress;
+ AEDesc nullContainer = {typeNull, NULL},
+ tempDesc = {typeNull, NULL},
+ tempDesc2 = {typeNull, NULL},
+ finalDesc = {typeNull, NULL};
+ const OSType finderSignature = 'MACS';
+
+
+ if (outgoingAevt.descriptorType == typeNull) {
+ if ((Gestalt(gestaltSystemVersion, &result) != noErr)
+ || (result >= sys8Mask)) {
+ finderPrefs = 'pfrp';
+ } else {
+ finderPrefs = 'pvwp';
+ }
+
+ AECreateDesc(typeApplSignature, &finderSignature,
+ sizeof(finderSignature), &fndrAddress);
+
+ err = AECreateAppleEvent(kAECoreSuite, kAEGetData, &fndrAddress,
+ kAutoGenerateReturnID, kAnyTransactionID, &outgoingAevt);
+
+ AEDisposeDesc(&fndrAddress);
+
+ /*
+ * The structure is:
+ * the property view font ('vfnt')
+ * of the property view preferences ('pvwp')
+ * of the Null Container (i.e. the Finder itself).
+ */
+
+ AECreateDesc(typeType, &finderPrefs, sizeof(finderPrefs), &tempDesc);
+ err = CreateObjSpecifier(typeType, &nullContainer, formPropertyID,
+ &tempDesc, true, &tempDesc2);
+ AECreateDesc(typeType, &viewFont, sizeof(viewFont), &tempDesc);
+ err = CreateObjSpecifier(typeType, &tempDesc2, formPropertyID,
+ &tempDesc, true, &finalDesc);
+
+ AEPutKeyDesc(&outgoingAevt, keyDirectObject, &finalDesc);
+ AEDisposeDesc(&finalDesc);
+ }
+
+ err = AESend(&outgoingAevt, &returnAevt, kAEWaitReply, kAEHighPriority,
+ kAEDefaultTimeout, NULL, NULL);
+ if (err == noErr) {
+ err = AEGetKeyPtr(&returnAevt, keyDirectObject, typeInteger,
+ &returnType, (void *) finderID, sizeof(int), &returnSize);
+ if (err == noErr) {
+ return TCL_OK;
+ }
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclMacGetFontEncoding --
+ *
+ * Determine the encoding of the specified font. The encoding
+ * can be used to convert bytes from UTF-8 into the encoding of
+ * that font.
+ *
+ * Results:
+ * The return value is a string that specifies the font's encoding
+ * and that can be passed to Tcl_GetEncoding() to construct the
+ * encoding. If the font's encoding could not be identified, NULL
+ * is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TclMacGetFontEncoding(
+ int fontId)
+{
+ int script, lang;
+ char *name;
+ Map *mapPtr;
+
+ script = FontToScript(fontId);
+ lang = GetScriptVariable(script, smScriptLang);
+ name = NULL;
+ if (script == smRoman) {
+ for (mapPtr = romanMap; mapPtr->strKey != NULL; mapPtr++) {
+ if (mapPtr->numKey == lang) {
+ name = mapPtr->strKey;
+ break;
+ }
+ }
+ } else if (script == smCyrillic) {
+ for (mapPtr = cyrillicMap; mapPtr->strKey != NULL; mapPtr++) {
+ if (mapPtr->numKey == lang) {
+ name = mapPtr->strKey;
+ break;
+ }
+ }
+ }
+ if (name == NULL) {
+ for (mapPtr = scriptMap; mapPtr->strKey != NULL; mapPtr++) {
+ if (mapPtr->numKey == script) {
+ name = mapPtr->strKey;
+ break;
+ }
+ }
+ }
+ return name;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitPlatform --
+ *
+ * Initialize all the platform-dependant things like signals and
+ * floating-point error handling.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
void
-TclPlatformInit(
- Tcl_Interp *interp) /* Tcl interpreter to initialize. */
+TclpInitPlatform()
{
- char *libDir;
- Tcl_DString path, libPath;
- long int gestaltResult;
- int minor, major;
- char versStr[10];
+ tclPlatform = TCL_PLATFORM_MAC;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpInitLibraryPath --
+ *
+ * Initialize the library path at startup. We have a minor
+ * metacircular problem that we don't know the encoding of the
+ * operating system but we may need to talk to operating system
+ * to find the library directories so that we know how to talk to
+ * the operating system.
+ *
+ * We do not know the encoding of the operating system.
+ * We do know that the encoding is some multibyte encoding.
+ * In that multibyte encoding, the characters 0..127 are equivalent
+ * to ascii.
+ *
+ * So although we don't know the encoding, it's safe:
+ * to look for the last colon character in a path in the encoding.
+ * to append an ascii string to a path.
+ * to pass those strings back to the operating system.
+ *
+ * But any strings that we remembered before we knew the encoding of
+ * the operating system must be translated to UTF-8 once we know the
+ * encoding so that the rest of Tcl can use those strings.
+ *
+ * This call sets the library path to strings in the unknown native
+ * encoding. TclpSetInitialEncodings() will translate the library
+ * path from the native encoding to UTF-8 as soon as it determines
+ * what the native encoding actually is.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TclpInitLibraryPath(argv0)
+ CONST char *argv0; /* Name of executable from argv[0] to main().
+ * Not used because we can determine the name
+ * by querying the module handle. */
+{
+ Tcl_Obj *objPtr, *pathPtr;
+ char *str;
+ Tcl_DString ds;
+
+ TclMacCreateEnv();
+
+ pathPtr = Tcl_NewObj();
+
+ str = TclGetEnv("TCL_LIBRARY", &ds);
+ if ((str != NULL) && (str[0] != '\0')) {
+ /*
+ * If TCL_LIBRARY is set, search there.
+ */
+
+ objPtr = Tcl_NewStringObj(str, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+
+ objPtr = TclGetLibraryPath();
+ if (objPtr != NULL) {
+ Tcl_ListObjAppendList(NULL, pathPtr, objPtr);
+ }
+
/*
- * Set runtime C variable that tells cross platform C functions
- * what platform they are running on. This can change at
- * runtime for testing purposes.
+ * lappend path [file join $env(EXT_FOLDER) \
+ * ":Tool Command Language:tcl[info version]"
*/
- tclPlatform = TCL_PLATFORM_MAC;
+
+ str = TclGetEnv("EXT_FOLDER", &ds);
+ if ((str != NULL) && (str[0] != '\0')) {
+ objPtr = Tcl_NewStringObj(str, -1);
+ if (str[strlen(str) - 1] != ':') {
+ Tcl_AppendToObj(objPtr, ":", 1);
+ }
+ Tcl_AppendToObj(objPtr, "Tool Command Language:tcl" TCL_VERSION, -1);
+ Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
+ Tcl_DStringFree(&ds);
+ }
+ TclSetLibraryPath(pathPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetInitialEncodings --
+ *
+ * Based on the locale, determine the encoding of the operating
+ * system and the default encoding for newly opened files.
+ *
+ * Called at process initialization time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Tcl library path is converted from native encoding to UTF-8.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TclpSetInitialEncodings()
+{
+ CONST char *encoding;
+ Tcl_Obj *pathPtr;
+ int fontId;
+
+ fontId = 0;
+ GetFinderFont(&fontId);
+ encoding = TclMacGetFontEncoding(fontId);
+ if (encoding == NULL) {
+ encoding = "macRoman";
+ }
+
+ Tcl_SetSystemEncoding(NULL, encoding);
/*
- * Define the tcl_platfrom variable.
+ * Until the system encoding was actually set, the library path was
+ * actually in the native multi-byte encoding, and not really UTF-8
+ * as advertised. We cheated as follows:
+ *
+ * 1. It was safe to allow the Tcl_SetSystemEncoding() call to
+ * append the ASCII chars that make up the encoding's filename to
+ * the names (in the native encoding) of directories in the library
+ * path, since all Unix multi-byte encodings have ASCII in the
+ * beginning.
+ *
+ * 2. To open the encoding file, the native bytes in the file name
+ * were passed to the OS, without translating from UTF-8 to native,
+ * because the name was already in the native encoding.
+ *
+ * Now that the system encoding was actually successfully set,
+ * translate all the names in the library path to UTF-8. That way,
+ * next time we search the library path, we'll translate the names
+ * from UTF-8 to the system encoding which will be the native
+ * encoding.
+ */
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ int i, objc;
+ Tcl_Obj **objv;
+
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ for (i = 0; i < objc; i++) {
+ int length;
+ char *string;
+ Tcl_DString ds;
+
+ string = Tcl_GetStringFromObj(objv[i], &length);
+ Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+ Tcl_SetStringObj(objv[i], Tcl_DStringValue(&ds),
+ Tcl_DStringLength(&ds));
+ Tcl_DStringFree(&ds);
+ }
+ }
+
+ /*
+ * Keep the iso8859-1 encoding preloaded. The IO package uses it for
+ * gets on a binary channel.
*/
+
+ Tcl_GetEncoding(NULL, "iso8859-1");
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclpSetVariables --
+ *
+ * Performs platform-specific interpreter initialization related to
+ * the tcl_library and tcl_platform variables, and other platform-
+ * specific things.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets "tcl_library" and "tcl_platform" Tcl variables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpSetVariables(interp)
+ Tcl_Interp *interp;
+{
+ long int gestaltResult;
+ int minor, major, objc;
+ Tcl_Obj **objv;
+ char versStr[2 * TCL_INTEGER_SPACE];
+ char *str;
+ Tcl_Obj *pathPtr;
+ Tcl_DString ds;
+
+ str = "no library";
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr != NULL) {
+ objc = 0;
+ Tcl_ListObjGetElements(NULL, pathPtr, &objc, &objv);
+ if (objc > 0) {
+ str = Tcl_GetStringFromObj(objv[0], NULL);
+ }
+ }
+ Tcl_SetVar(interp, "tcl_library", str, TCL_GLOBAL_ONLY);
+
+ if (pathPtr != NULL) {
+ Tcl_SetVar2Ex(interp, "tcl_pkgPath", NULL, pathPtr, TCL_GLOBAL_ONLY);
+ }
+
Tcl_SetVar2(interp, "tcl_platform", "platform", "macintosh",
TCL_GLOBAL_ONLY);
Tcl_SetVar2(interp, "tcl_platform", "os", "MacOS", TCL_GLOBAL_ONLY);
@@ -71,47 +530,20 @@ TclPlatformInit(
#endif
/*
- * The tcl_library path can be found in one of two places. As an element
- * in the env array. Or the default which is to a folder in side the
- * Extensions folder of your system.
+ * Copy USER or LOGIN environment variable into tcl_platform(user)
+ * These are set by SystemVariables in tclMacEnv.c
*/
-
- Tcl_DStringInit(&path);
- libDir = Tcl_GetVar2(interp, "env", "TCL_LIBRARY", TCL_GLOBAL_ONLY);
- if (libDir != NULL) {
- Tcl_SetVar(interp, "tcl_library", libDir, TCL_GLOBAL_ONLY);
- } else {
- libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
- if (libDir != NULL) {
- Tcl_JoinPath(1, &libDir, &path);
-
- Tcl_DStringInit(&libPath);
- Tcl_DStringAppend(&libPath, ":Tool Command Language:tcl", -1);
- Tcl_DStringAppend(&libPath, TCL_VERSION, -1);
- Tcl_JoinPath(1, &libPath.string, &path);
- Tcl_DStringFree(&libPath);
- Tcl_SetVar(interp, "tcl_library", path.string, TCL_GLOBAL_ONLY);
- } else {
- Tcl_SetVar(interp, "tcl_library", "no library", TCL_GLOBAL_ONLY);
+
+ Tcl_DStringInit(&ds);
+ str = TclGetEnv("USER", &ds);
+ if (str == NULL) {
+ str = TclGetEnv("LOGIN", &ds);
+ if (str == NULL) {
+ str = "";
}
}
-
- /*
- * Now create the tcl_pkgPath variable.
- */
- Tcl_DStringSetLength(&path, 0);
- libDir = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
- if (libDir != NULL) {
- Tcl_JoinPath(1, &libDir, &path);
- libDir = ":Tool Command Language:";
- Tcl_JoinPath(1, &libDir, &path);
- Tcl_SetVar(interp, "tcl_pkgPath", path.string,
- TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
- } else {
- Tcl_SetVar(interp, "tcl_pkgPath", "no extension folder",
- TCL_GLOBAL_ONLY|TCL_LIST_ELEMENT);
- }
- Tcl_DStringFree(&path);
+ Tcl_SetVar2(interp, "tcl_platform", "user", str, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&ds);
}
/*
@@ -148,7 +580,7 @@ TclpCheckStackSpace()
* such as sourcing the "init.tcl" script.
*
* Results:
- * Returns a standard Tcl completion code and sets interp->result
+ * Returns a standard Tcl completion code and sets the interp's result
* if there is an error.
*
* Side effects:
@@ -161,41 +593,19 @@ int
Tcl_Init(
Tcl_Interp *interp) /* Interpreter to initialize. */
{
- static char initCmd[] =
- "if {[catch {source -rsrc Init}] != 0} {\n\
- if [file exists [info library]:init.tcl] {\n\
- source [info library]:init.tcl\n\
- } else {\n\
- set msg \"can't find Init resource or [info library]:init.tcl;\"\n\
- append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
- error $msg\n\
- }\n}\n\
- if {[catch {source -rsrc History}] != 0} {\n\
- if [file exists [info library]:history.tcl] {\n\
- source [info library]:history.tcl\n\
- } else {\n\
- set msg \"can't find History resource or [info library]:history.tcl;\"\n\
- append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
- error $msg\n\
- }\n}\n\
- if {[catch {source -rsrc Word}] != 0} {\n\
- if [file exists [info library]:word.tcl] {\n\
- source [info library]:word.tcl\n\
- } else {\n\
- set msg \"can't find Word resource or [info library]:word.tcl;\"\n\
- append msg \" perhaps you need to\\ninstall Tcl or set your \"\n\
- append msg \"TCL_LIBRARY environment variable?\"\n\
- error $msg\n\
- }\n}";
+ Tcl_Obj *pathPtr;
/*
* For Macintosh applications the Init function may be contained in
* the application resources. If it exists we use it - otherwise we
* look in the tcl_library directory. Ditto for the history command.
*/
-
+
+ pathPtr = TclGetLibraryPath();
+ if (pathPtr == NULL) {
+ pathPtr = Tcl_NewObj();
+ }
+ Tcl_SetVar2Ex(interp, "auto_path", NULL, pathPtr, TCL_GLOBAL_ONLY);
return Tcl_Eval(interp, initCmd);
}
@@ -254,8 +664,8 @@ Tcl_SourceRCFile(
if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
}
@@ -273,8 +683,8 @@ Tcl_SourceRCFile(
if (Tcl_MacEvalResource(interp, fileName, 0, NULL) != TCL_OK) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
if (errChannel) {
- Tcl_Write(errChannel, interp->result, -1);
- Tcl_Write(errChannel, "\n", 1);
+ Tcl_WriteObj(errChannel, Tcl_GetObjResult(interp));
+ Tcl_WriteChars(errChannel, "\n", 1);
}
}
Tcl_ResetResult(interp);
diff --git a/mac/tclMacInt.h b/mac/tclMacInt.h
index 494cf8b..f721e0f 100644
--- a/mac/tclMacInt.h
+++ b/mac/tclMacInt.h
@@ -3,12 +3,12 @@
*
* Declarations of Macintosh specific shared variables and procedures.
*
- * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1996-1998 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: tclMacInt.h,v 1.3 1999/03/10 05:52:51 stanton Exp $
+ * RCS: @(#) $Id: tclMacInt.h,v 1.4 1999/04/16 00:47:20 stanton Exp $
*/
#ifndef _TCLMACINT
@@ -46,8 +46,15 @@
*/
typedef pascal void (*ExitToShellProcPtr)(void);
-#include "tclIntPlatDecls.h"
+/*
+ * Prototypes of Mac only internal functions.
+ */
+EXTERN char * TclMacGetFontEncoding _ANSI_ARGS_((int fontId));
+EXTERN int TclMacHaveThreads(void);
+
+#include "tclIntPlatDecls.h"
+
#pragma export reset
#endif /* _TCLMACINT */
diff --git a/mac/tclMacLibrary.r b/mac/tclMacLibrary.r
index e775d94..eda1f7f 100644
--- a/mac/tclMacLibrary.r
+++ b/mac/tclMacLibrary.r
@@ -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: tclMacLibrary.r,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacLibrary.r,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#include <Types.r>
@@ -141,9 +141,7 @@ resource 'STR ' (-16397, purgeable) {
* will load the TEXT resource named "Init".
*/
-read 'TEXT' (TCL_LIBRARY_RESOURCES, "Init", purgeable) "::library:init.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "History", purgeable) "::library:history.tcl";
-read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "Word", purgeable,preload) "::library:word.tcl";
+#include "tclMacTclCode.r"
/*
* The following are icons for the shared library.
diff --git a/mac/tclMacLoad.c b/mac/tclMacLoad.c
index 9c84ac8..622eb65 100644
--- a/mac/tclMacLoad.c
+++ b/mac/tclMacLoad.c
@@ -5,12 +5,12 @@
* on the Macintosh. This procedure will only work with systems
* that use the Code Fragment Manager.
*
- * Copyright (c) 1995-1996 Sun Microsystems, Inc.
+ * 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: tclMacLoad.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacLoad.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#include <CodeFragments.h>
@@ -88,7 +88,7 @@ typedef struct CfrgItem CfrgItem;
*
* Results:
* The result is TCL_ERROR, and an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* New binary code is loaded.
@@ -97,16 +97,19 @@ typedef struct CfrgItem CfrgItem;
*/
int
-TclLoadFile(
+TclpLoadFile(
Tcl_Interp *interp, /* Used for error reporting. */
char *fileName, /* Name of the file containing the desired
* code. */
char *sym1, char *sym2, /* Names of two procedures to look up in
* the file's symbol table. */
Tcl_PackageInitProc **proc1Ptr,
- Tcl_PackageInitProc **proc2Ptr)
+ Tcl_PackageInitProc **proc2Ptr,
/* Where to return the addresses corresponding
* to sym1 and sym2. */
+ ClientData *clientDataPtr) /* Filled with token for dynamically loaded
+ * file which will be passed back to
+ * TclpUnloadFile() to unload the file. */
{
CFragConnectionID connID;
Ptr dummy;
@@ -119,6 +122,8 @@ TclLoadFile(
UInt32 length = kCFragGoesToEOF;
char packageName[255];
Str255 errName;
+ Tcl_DString ds;
+ char *native;
/*
* First thing we must do is infer the package name from the sym1
@@ -126,22 +131,26 @@ TclLoadFile(
* this value, it just doesn't give it to us.
*/
strcpy(packageName, sym1);
- *packageName = (char) tolower(*packageName);
- packageName[strlen(packageName) - 5] = NULL;
+ Tcl_UtfToLower(packageName);
+ *(Tcl_UtfAtIndex(packageName, Tcl_NumUtfChars(packageName, -1) - 5)) = 0;
+ native = Tcl_UtfToExternalDString(NULL, fileName, -1, &ds);
err = FSpLocationFromPath(strlen(fileName), fileName, &fileSpec);
+ Tcl_DStringFree(&ds);
+
if (err != noErr) {
- interp->result = "could not locate shared library";
+ Tcl_SetResult(interp, "could not locate shared library", TCL_STATIC);
return TCL_ERROR;
}
/*
- * See if this fragment has a 'cfrg' resource. It will tell us were
+ * See if this fragment has a 'cfrg' resource. It will tell us where
* to look for the fragment in the file. If it doesn't exist we will
* assume we have a ppc frag using the whole data fork. If it does
* exist we find the frag that matches the one we are looking for and
* get the offset and size from the resource.
*/
+
saveFileRef = CurResFile();
SetResLoad(false);
fragFileRef = FSpOpenResFile(&fileSpec, fsRdPerm);
@@ -199,8 +208,9 @@ TclLoadFile(
err = FindSymbol(connID, (StringPtr) sym1, (Ptr *) proc1Ptr, &symClass);
p2cstr((StringPtr) sym1);
if (err != fragNoErr || symClass == kDataCFragSymbol) {
- interp->result =
- "could not find Initialization routine in library";
+ Tcl_SetResult(interp,
+ "could not find Initialization routine in library",
+ TCL_STATIC);
return TCL_ERROR;
}
@@ -211,12 +221,41 @@ TclLoadFile(
*proc2Ptr = NULL;
}
+ *clientDataPtr = (ClientData) connID;
+
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
+ * TclpUnloadFile --
+ *
+ * Unloads a dynamically loaded binary code file from memory.
+ * Code pointers in the formerly loaded file are no longer valid
+ * after calling this function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Does nothing. Can anything be done?
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpUnloadFile(clientData)
+ ClientData clientData; /* ClientData returned by a previous call
+ * to TclpLoadFile(). The clientData is
+ * a token that represents the loaded
+ * file. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGuessPackageName --
*
* If the "load" command is invoked without providing a package
diff --git a/mac/tclMacNotify.c b/mac/tclMacNotify.c
index a652c8d..773490f 100644
--- a/mac/tclMacNotify.c
+++ b/mac/tclMacNotify.c
@@ -5,12 +5,16 @@
* which is the lowest-level part of the Tcl event loop. This file
* works together with ../generic/tclNotify.c.
*
+ * The Mac notifier only polls for system and OS events, so it is process
+ * wide, rather than thread specific. However, this means that the convert
+ * event proc will have to arbitrate which events go to which threads.
+ *
* Copyright (c) 1995-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: tclMacNotify.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacNotify.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#include "tclInt.h"
@@ -22,6 +26,7 @@
#include <LowMem.h>
#include <Processes.h>
#include <Timer.h>
+#include <Threads.h>
/*
@@ -81,9 +86,105 @@ static void NotifierExitHandler _ANSI_ARGS_((
/*
*----------------------------------------------------------------------
*
+ * Tcl_InitNotifier --
+ *
+ * Initializes the platform specific notifier state. There is no thread
+ * specific platform notifier on the Mac, so this really doesn't do
+ * anything. However, we need to return the ThreadID, since the generic
+ * notifier hands this back to us in AlertThread.
+ *
+ * Results:
+ * Returns the threadID for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_InitNotifier()
+{
+
+#ifdef TCL_THREADS
+ ThreadID curThread;
+ if (TclMacHaveThreads()) {
+ GetCurrentThread(&curThread);
+ return (ClientData) curThread;
+ } else {
+ return NULL;
+ }
+#else
+ return NULL;
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ * This function is called to cleanup the notifier state before
+ * a thread is terminated. There is no platform thread specific
+ * notifier, so this does nothing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeNotifier(clientData)
+ ClientData clientData; /* Pointer to notifier data. */
+{
+ /* Nothing to do on the Mac */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AlertNotifier --
+ *
+ * Wake up the specified notifier from any thread. This routine
+ * is called by the platform independent notifier code whenever
+ * the Tcl_ThreadAlert routine is called. This routine is
+ * guaranteed not to be called on a given notifier after
+ * Tcl_FinalizeNotifier is called for that notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls YieldToThread from this thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AlertNotifier(clientData)
+ ClientData clientData; /* Pointer to thread data. */
+{
+
+#ifdef TCL_THREADS
+ if (TclMacHaveThreads()) {
+ YieldToThread((ThreadID) clientData);
+ }
+#endif
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* InitNotifier --
*
- * Initializes the notifier structure.
+ * Initializes the notifier structure. Note - this function is never
+ * used.
*
* Results:
* None.
@@ -108,7 +209,8 @@ InitNotifier(void)
* NotifierExitHandler --
*
* This function is called to cleanup the notifier state before
- * Tcl is unloaded.
+ * Tcl is unloaded. This function is never used, since InitNotifier
+ * isn't either.
*
* Results:
* None.
@@ -246,6 +348,29 @@ Tcl_SetTimer(
/*
*----------------------------------------------------------------------
*
+ * Tcl_ServiceModeHook --
+ *
+ * This function is invoked whenever the service mode changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ServiceModeHook(mode)
+ int mode; /* Either TCL_SERVICE_ALL, or
+ * TCL_SERVICE_NONE. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_WaitForEvent --
*
* This function is called by Tcl_DoOneEvent to wait for new
@@ -346,6 +471,17 @@ Tcl_WaitForEvent(
}
}
TclMacRemoveTimer(timerToken);
+
+ /*
+ * Yield time to nay other thread at this point. If we find that the
+ * apps thrash too switching between threads, we can put a timer here,
+ * and only yield when the timer fires.
+ */
+
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
+
return 0;
}
@@ -381,7 +517,9 @@ Tcl_Sleep(
timerToken = TclMacStartTimer((long) ms);
while (1) {
WaitNextEvent(0, &dummy, (ms / 16.66) + 1, NULL);
-
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
if (TclMacTimerExpired(timerToken)) {
break;
}
diff --git a/mac/tclMacOSA.c b/mac/tclMacOSA.c
index d4bc14d..b09cb59 100644
--- a/mac/tclMacOSA.c
+++ b/mac/tclMacOSA.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: tclMacOSA.c,v 1.2 1998/09/14 18:40:05 stanton Exp $
+ * RCS: @(#) $Id: tclMacOSA.c,v 1.3 1999/04/16 00:47:20 stanton Exp $
*/
#define MAC_TCL
@@ -1926,7 +1926,7 @@ tclOSAAddContext(
int newPtr;
if (contextName == NULL) {
- contextName = ckalloc(24 * sizeof(char));
+ contextName = ckalloc(16 + TCL_INTEGER_SPACE);
sprintf(contextName, "OSAContext%d", contextIndex++);
} else if (*contextName == '\0') {
sprintf(contextName, "OSAContext%d", contextIndex++);
@@ -2057,7 +2057,7 @@ tclOSAStore(
Str255 rezName;
int result = TCL_OK;
short saveRef, fileRef = -1;
- char idStr[64];
+ char idStr[16 + TCL_INTEGER_SPACE];
FSSpec fileSpec;
Tcl_DString buffer;
char *nativeName;
@@ -2276,7 +2276,7 @@ tclOSALoad(
Str255 rezName;
int result = TCL_OK;
short saveRef, fileRef = -1;
- char idStr[64];
+ char idStr[16 + TCL_INTEGER_SPACE];
FSSpec fileSpec;
Tcl_DString buffer;
char *nativeName;
diff --git a/mac/tclMacPort.h b/mac/tclMacPort.h
index 558fecd..7be4938 100644
--- a/mac/tclMacPort.h
+++ b/mac/tclMacPort.h
@@ -10,20 +10,27 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacPort.h,v 1.7 1999/03/11 00:19:24 stanton Exp $
+ * RCS: @(#) $Id: tclMacPort.h,v 1.8 1999/04/16 00:47:21 stanton Exp $
*/
+
#ifndef _MACPORT
#define _MACPORT
-#ifndef _TCL
-#include "tcl.h"
+#ifndef _TCLINT
+# include "tclInt.h"
#endif
+/*
+ *---------------------------------------------------------------------------
+ * The following sets of #includes and #ifdefs are required to get Tcl to
+ * compile on the macintosh.
+ *---------------------------------------------------------------------------
+ */
+
#include "tclErrno.h"
#include <float.h>
-/* Includes */
#ifdef THINK_C
/*
* The Symantic C code has not been tested
@@ -41,64 +48,85 @@
#elif defined(__MWERKS__)
# include <time.h>
# include <unistd.h>
+
/*
* The following definitions are usually found if fcntl.h.
* However, MetroWerks has screwed that file up a couple of times
* and all we need are the defines.
*/
-#define O_RDWR 0x0 /* open the file in read/write mode */
-#define O_RDONLY 0x1 /* open the file in read only mode */
-#define O_WRONLY 0x2 /* open the file in write only mode */
-#define O_APPEND 0x0100 /* open the file in append mode */
-#define O_CREAT 0x0200 /* create the file if it doesn't exist */
-#define O_EXCL 0x0400 /* if the file exists don't create it again */
-#define O_TRUNC 0x0800 /* truncate the file after opening it */
+
+# define O_RDWR 0x0 /* open the file in read/write mode */
+# define O_RDONLY 0x1 /* open the file in read only mode */
+# define O_WRONLY 0x2 /* open the file in write only mode */
+# define O_APPEND 0x0100 /* open the file in append mode */
+# define O_CREAT 0x0200 /* create the file if it doesn't exist */
+# define O_EXCL 0x0400 /* if the file exists don't create it again */
+# define O_TRUNC 0x0800 /* truncate the file after opening it */
/*
* MetroWerks stat.h file is rather weak. The defines
* after the include are needed to fill in the missing
* defines.
*/
+
# include <stat.h>
# ifndef S_IFIFO
-# define S_IFIFO 0x0100
+# define S_IFIFO 0x0100
# endif
# ifndef S_IFBLK
-# define S_IFBLK 0x0600
+# define S_IFBLK 0x0600
# endif
# ifndef S_ISLNK
-# define S_ISLNK(m) (((m)&(S_IFMT)) == (S_IFLNK))
+# define S_ISLNK(m) (((m)&(S_IFMT)) == (S_IFLNK))
# endif
# ifndef S_ISSOCK
-# define S_ISSOCK(m) (((m)&(S_IFMT)) == (S_IFSOCK))
+# define S_ISSOCK(m) (((m)&(S_IFMT)) == (S_IFSOCK))
# endif
# ifndef S_IRWXU
-# define S_IRWXU 00007 /* read, write, execute: owner */
-# define S_IRUSR 00004 /* read permission: owner */
-# define S_IWUSR 00002 /* write permission: owner */
-# define S_IXUSR 00001 /* execute permission: owner */
-# define S_IRWXG 00007 /* read, write, execute: group */
-# define S_IRGRP 00004 /* read permission: group */
-# define S_IWGRP 00002 /* write permission: group */
-# define S_IXGRP 00001 /* execute permission: group */
-# define S_IRWXO 00007 /* read, write, execute: other */
-# define S_IROTH 00004 /* read permission: other */
-# define S_IWOTH 00002 /* write permission: other */
-# define S_IXOTH 00001 /* execute permission: other */
+# define S_IRWXU 00007 /* read, write, execute: owner */
+# define S_IRUSR 00004 /* read permission: owner */
+# define S_IWUSR 00002 /* write permission: owner */
+# define S_IXUSR 00001 /* execute permission: owner */
+# define S_IRWXG 00007 /* read, write, execute: group */
+# define S_IRGRP 00004 /* read permission: group */
+# define S_IWGRP 00002 /* write permission: group */
+# define S_IXGRP 00001 /* execute permission: group */
+# define S_IRWXO 00007 /* read, write, execute: other */
+# define S_IROTH 00004 /* read permission: other */
+# define S_IWOTH 00002 /* write permission: other */
+# define S_IXOTH 00001 /* execute permission: other */
# endif
-# define isatty(arg) 1
+# define isatty(arg) 1
/*
* Defines used by access function. This function is provided
* by Mac Tcl as the function TclpAccess.
*/
-# define F_OK 0 /* test for existence of file */
-# define X_OK 0x01 /* test for execute or search permission */
-# define W_OK 0x02 /* test for write permission */
-# define R_OK 0x04 /* test for read permission */
+# define F_OK 0 /* test for existence of file */
+# define X_OK 0x01 /* test for execute or search permission */
+# define W_OK 0x02 /* test for write permission */
+# define R_OK 0x04 /* test for read permission */
+
+#endif /* __MWERKS__ */
+
+/*
+ * Many signals are not supported on the Mac and are thus not defined in
+ * <signal.h>. They are defined here so that Tcl will compile with less
+ * modification.
+ */
+#ifndef SIGQUIT
+#define SIGQUIT 300
+#endif
+
+#ifndef SIGPIPE
+#define SIGPIPE 13
+#endif
+
+#ifndef SIGHUP
+#define SIGHUP 100
#endif
/*
@@ -107,16 +135,29 @@
* be defined in sys/wait.h on UNIX systems.
*/
-#define WNOHANG 1
-#define WIFSTOPPED(stat) (1)
-#define WIFSIGNALED(stat) (1)
-#define WIFEXITED(stat) (1)
-#define WIFSTOPSIG(stat) (1)
-#define WIFTERMSIG(stat) (1)
-#define WIFEXITSTATUS(stat) (1)
-#define WEXITSTATUS(stat) (1)
-#define WTERMSIG(status) (1)
-#define WSTOPSIG(status) (1)
+#define WAIT_STATUS_TYPE int
+#define WNOHANG 1
+#define WIFSTOPPED(stat) (1)
+#define WIFSIGNALED(stat) (1)
+#define WIFEXITED(stat) (1)
+#define WIFSTOPSIG(stat) (1)
+#define WIFTERMSIG(stat) (1)
+#define WIFEXITSTATUS(stat) (1)
+#define WEXITSTATUS(stat) (1)
+#define WTERMSIG(status) (1)
+#define WSTOPSIG(status) (1)
+
+/*
+ * Make sure that MAXPATHLEN is defined.
+ */
+
+#ifndef MAXPATHLEN
+# ifdef PATH_MAX
+# define MAXPATHLEN PATH_MAX
+# else
+# define MAXPATHLEN 2048
+# endif
+#endif
/*
* Define "NBBY" (number of bits per byte) if it's not already defined.
@@ -136,57 +177,57 @@
# define getpid() -1
#endif
-#define NO_SYS_ERRLIST
-#define WAIT_STATUS_TYPE int
-
/*
- * Make sure that MAXPATHLEN is defined.
+ * Variables provided by the C library.
*/
-
-#ifndef MAXPATHLEN
-# ifdef PATH_MAX
-# define MAXPATHLEN PATH_MAX
-# else
-# define MAXPATHLEN 2048
-# endif
-#endif
+
+extern char **environ;
/*
- * The following functions are declared in tclInt.h but don't do anything
- * on Macintosh systems.
+ *---------------------------------------------------------------------------
+ * The following macros and declarations represent the interface between
+ * generic and mac-specific parts of Tcl. Some of the macros may override
+ * functions declared in tclInt.h.
+ *---------------------------------------------------------------------------
*/
-#define TclSetSystemEnv(a,b)
-
/*
- * Many signals are not supported on the Mac and are thus not defined in
- * <signal.h>. They are defined here so that Tcl will compile with less
- * modification.
- */
-
-#ifndef SIGQUIT
-#define SIGQUIT 300
-#endif
-
-#ifndef SIGPIPE
-#define SIGPIPE 13
-#endif
-
-#ifndef SIGHUP
-#define SIGHUP 100
-#endif
+ * The default platform eol translation on Mac is TCL_TRANSLATE_CR:
+ */
-extern char **environ;
+#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CR
/*
- * Prototypes needed for compatability
+ * Declare dynamic loading extension macro.
*/
-EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
- CONST char *s2, size_t n));
+#define TCL_SHLIB_EXT ".shlb"
+/*
+ * The following define is bogus and needs to be fixed. It claims that
+ * struct tm has the timezone string in it, which is not true. However,
+ * the code that works around this fact does not compile on the Mac, since
+ * it relies on the fact that time.h has a "timezone" variable, which the
+ * Metrowerks time.h does not have...
+ *
+ * The Mac timezone stuff never worked (clock format 0 -format %Z returns "Z")
+ * so this just keeps the status quo. The real answer is to not use the
+ * MSL strftime, and provide the needed compat functions...
+ *
+ */
+
+#define HAVE_TM_ZONE
+
+/*
+ * The following macros have trivial definitions, allowing generic code to
+ * address platform-specific issues.
+ */
+
+#define TclpAsyncMark(async)
+#define TclpGetPid(pid) ((unsigned long) (pid))
+#define TclpGetUserHome(n, b) (NULL)
+#define TclSetSystemEnv(a,b)
#define tzset()
-#define TclpGetPid(pid) ((unsigned long) (pid))
/*
* The following defines replace the Macintosh version of the POSIX
@@ -202,12 +243,11 @@ EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
#endif
/*
- * Defines for Tcl internal commands that aren't really needed on
- * the Macintosh. They all act as no-ops.
+ * Prototypes needed for compatability
*/
-#define TclCreateCommandChannel(out, in, err, num, pidPtr) NULL
-#define TclClosePipeFile(x)
-#define TclpAsyncMark(async)
+
+EXTERN int strncasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2, size_t n));
/*
* These definitions force putenv & company to use the version
@@ -223,21 +263,21 @@ void TclUnsetEnv(CONST char *name);
#endif
/*
- * The default platform eol translation on Mac is TCL_TRANSLATE_CR:
- */
-
-#define TCL_PLATFORM_TRANSLATION TCL_TRANSLATE_CR
-
-/*
- * Declare dynamic loading extension macro.
- */
-
-#define TCL_SHLIB_EXT ".shlb"
-
-/*
- * TclpFinalize is a noop on the Mac.
+ * Platform specific mutex definition used by memory allocators.
+ * These are all no-ops on the Macintosh, since the threads are
+ * all cooperative.
*/
-#define TclpFinalize()
+#ifdef TCL_THREADS
+typedef int TclpMutex;
+#define TclpMutexInit(a)
+#define TclpMutexLock(a)
+#define TclpMutexUnlock(a)
+#else
+typedef int TclpMutex;
+#define TclpMutexInit(a)
+#define TclpMutexLock(a)
+#define TclpMutexUnlock(a)
+#endif /* TCL_THREADS */
#endif /* _MACPORT */
diff --git a/mac/tclMacResource.c b/mac/tclMacResource.c
index 77879b4..312ef42 100644
--- a/mac/tclMacResource.c
+++ b/mac/tclMacResource.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: tclMacResource.c,v 1.4 1998/11/10 06:49:44 jingham Exp $
+ * RCS: @(#) $Id: tclMacResource.c,v 1.5 1999/04/16 00:47:21 stanton Exp $
*/
#include <Errors.h>
@@ -134,8 +134,6 @@ Tcl_ResourceObjCmd(
int index, result;
long fileRef, rsrcId;
FSSpec fileSpec;
- Tcl_DString buffer;
- char *nativeName;
char *stringPtr;
char errbuf[16];
OpenResourceFork *resourceRef;
@@ -396,9 +394,9 @@ resourceRef? resourceType");
Handle pathHandle;
short pathLength;
Str255 fileName;
+ Tcl_DString dstr;
- if (strcmp(Tcl_GetStringFromObj(objv[2], NULL), "ROM Map")
- == 0) {
+ if (strcmp(Tcl_GetString(objv[2]), "ROM Map") == 0) {
Tcl_SetStringObj(resultPtr,"no file path for ROM Map", -1);
return TCL_ERROR;
}
@@ -429,9 +427,12 @@ resourceRef? resourceType");
}
HLock(pathHandle);
- Tcl_SetStringObj(resultPtr,*pathHandle,pathLength);
+ Tcl_ExternalToUtfDString(NULL, *pathHandle, pathLength, &dstr);
+
+ Tcl_SetStringObj(resultPtr, Tcl_DStringValue(&dstr), Tcl_DStringLength(&dstr));
HUnlock(pathHandle);
DisposeHandle(pathHandle);
+ Tcl_DStringFree(&dstr);
}
return TCL_OK;
case RESOURCE_LIST:
@@ -471,6 +472,7 @@ resourceRef? resourceType");
if (resource != NULL) {
GetResInfo(resource, &id, (ResType *) &rezType, theName);
if (theName[0] != 0) {
+
objPtr = Tcl_NewStringObj((char *) theName + 1,
theName[0]);
} else {
@@ -492,22 +494,27 @@ resourceRef? resourceType");
}
return TCL_OK;
- case RESOURCE_OPEN:
+ case RESOURCE_OPEN: {
+ Tcl_DString ds, buffer;
+ char *str, *native;
+ int length;
+
if (!((objc == 3) || (objc == 4))) {
Tcl_WrongNumArgs(interp, 2, objv, "fileName ?permissions?");
return TCL_ERROR;
}
- stringPtr = Tcl_GetStringFromObj(objv[2], &length);
- nativeName = Tcl_TranslateFileName(interp, stringPtr, &buffer);
- if (nativeName == NULL) {
- return TCL_ERROR;
+ str = Tcl_GetStringFromObj(objv[2], &length);
+ if (Tcl_TranslateFileName(interp, str, &buffer) == NULL) {
+ return TCL_ERROR;
}
- err = FSpLocationFromPath(strlen(nativeName), nativeName,
- &fileSpec) ;
+ native = Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer), &ds);
+ err = FSpLocationFromPath(Tcl_DStringLength(&ds), native, &fileSpec);
+ Tcl_DStringFree(&ds);
Tcl_DStringFree(&buffer);
+
if (!((err == noErr) || (err == fnfErr))) {
- Tcl_AppendStringsToObj(resultPtr,
- "invalid path", (char *) NULL);
+ Tcl_AppendStringsToObj(resultPtr, "invalid path", (char *) NULL);
return TCL_ERROR;
}
@@ -530,7 +537,7 @@ resourceRef? resourceType");
break;
case O_WRONLY:
case O_RDWR:
- macPermision = fsRdWrShPerm;
+ macPermision = fsRdWrPerm;
break;
default:
panic("Tcl_ResourceObjCmd: invalid mode value");
@@ -552,7 +559,7 @@ resourceRef? resourceType");
if (fileRef == -1) {
err = ResError();
if (((err == fnfErr) || (err == eofErr)) &&
- (macPermision == fsRdWrShPerm)) {
+ (macPermision == fsRdWrPerm)) {
/*
* No resource fork existed for this file. Since we are
* opening it for writing we will create the resource fork
@@ -600,8 +607,8 @@ resourceRef? resourceType");
CloseResFile(fileRef);
return TCL_ERROR;
}
-
return TCL_OK;
+ }
case RESOURCE_READ:
if (!((objc == 4) || (objc == 5))) {
Tcl_WrongNumArgs(interp, 2, objv,
@@ -629,7 +636,7 @@ resourceRef? resourceType");
if (resource != NULL) {
size = GetResourceSizeOnDisk(resource);
- Tcl_SetStringObj(resultPtr, *resource, size);
+ Tcl_SetByteArrayObj(resultPtr, (unsigned char *) *resource, size);
/*
* Don't release the resource unless WE loaded it...
@@ -740,7 +747,7 @@ resourceRef? resourceType");
if (Tcl_GetOSTypeFromObj(interp, objv[i], &rezType) != TCL_OK) {
return TCL_ERROR;
}
- stringPtr = Tcl_GetStringFromObj(objv[i+1], &length);
+ stringPtr = (char *) Tcl_GetByteArrayFromObj(objv[i+1], &length);
if (gotInt == false) {
rsrcId = UniqueID(rezType);
@@ -902,7 +909,7 @@ resourceRef? resourceType");
return result;
default:
- panic("Tcl_GetIndexFromObject returned unrecognized option");
+ panic("Tcl_GetIndexFromObj returned unrecognized option");
return TCL_ERROR; /* Should never be reached. */
}
}
@@ -947,7 +954,7 @@ Tcl_MacSourceObjCmd(
}
if (objc == 2) {
- string = TclGetStringFromObj(objv[1], &length);
+ string = Tcl_GetStringFromObj(objv[1], &length);
return Tcl_EvalFile(interp, string);
}
@@ -955,9 +962,9 @@ Tcl_MacSourceObjCmd(
* The following code supports a few older forms of this command
* for backward compatability.
*/
- string = TclGetStringFromObj(objv[1], &length);
+ string = Tcl_GetStringFromObj(objv[1], &length);
if (!strcmp(string, "-rsrc") || !strcmp(string, "-rsrcname")) {
- rsrcName = TclGetStringFromObj(objv[2], &length);
+ rsrcName = Tcl_GetStringFromObj(objv[2], &length);
} else if (!strcmp(string, "-rsrcid")) {
if (Tcl_GetLongFromObj(interp, objv[2], &rsrcID) != TCL_OK) {
return TCL_ERROR;
@@ -968,18 +975,16 @@ Tcl_MacSourceObjCmd(
}
if (objc == 4) {
- fileName = TclGetStringFromObj(objv[3], &length);
+ fileName = Tcl_GetStringFromObj(objv[3], &length);
}
return Tcl_MacEvalResource(interp, rsrcName, rsrcID, fileName);
sourceFmtErr:
Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), errStr, "should be \"",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " fileName\" or \"",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " -rsrc name ?fileName?\" or \"",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " -rsrcid id ?fileName?\"", (char *) NULL);
+ Tcl_GetString(objv[0]), " fileName\" or \"",
+ Tcl_GetString(objv[0]), " -rsrc name ?fileName?\" or \"",
+ Tcl_GetString(objv[0]), " -rsrcid id ?fileName?\"",
+ (char *) NULL);
return TCL_ERROR;
}
@@ -1102,8 +1107,7 @@ Tcl_BeepObjCmd(
} else {
Tcl_AppendStringsToObj(resultPtr, " \"", sndArg,
"\" is not a valid sound. (Try ",
- Tcl_GetStringFromObj(objv[0], (int *) NULL),
- " -list)", NULL);
+ Tcl_GetString(objv[0]), " -list)", NULL);
return TCL_ERROR;
}
}
@@ -1700,7 +1704,7 @@ SetOSTypeFromAny(
* Get the string representation. Make it up-to-date if necessary.
*/
- string = TclGetStringFromObj(objPtr, &length);
+ string = Tcl_GetStringFromObj(objPtr, &length);
if (length != 4) {
if (interp != NULL) {
@@ -1913,15 +1917,16 @@ TclMacRegisterResourceFork(
* to fix it here, OR because it is the ROM MAP, which has a
* fileRef, but can't be gotten to by PBGetFCBInfo.
*/
-
if ((err == noErr)
&& (newFileRec.ioFCBVRefNum == oldFileRec.ioFCBVRefNum)
&& (newFileRec.ioFCBFlNm == oldFileRec.ioFCBFlNm)) {
- /* In MacOS 8.1 it seems like we get different file refs even though
- * we pass the same file & permissions. This is not what Inside Mac
- * says should happen, but it does, so if it does, then close the new res
- * file and return the original one...
- */
+ /*
+ * In MacOS 8.1 it seems like we get different file refs even
+ * though we pass the same file & permissions. This is not
+ * what Inside Mac says should happen, but it does, so if it
+ * does, then close the new res file and return the original
+ * one...
+ */
if (filePermissionFlag == ((oldFileRec.ioFCBFlags >> 12) & 0x1)) {
CloseResFile(fileRef);
@@ -1929,8 +1934,7 @@ TclMacRegisterResourceFork(
break;
} else {
if (tokenPtr != NULL) {
- Tcl_SetStringObj(tokenPtr,
- "Resource already open with different permissions.", -1);
+ Tcl_SetStringObj(tokenPtr, "Resource already open with different permissions.", -1);
}
return TCL_ERROR;
}
diff --git a/mac/tclMacResource.r b/mac/tclMacResource.r
index f0671b9..f9376db 100644
--- a/mac/tclMacResource.r
+++ b/mac/tclMacResource.r
@@ -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: tclMacResource.r,v 1.2 1998/09/14 18:40:06 stanton Exp $
+ * RCS: @(#) $Id: tclMacResource.r,v 1.3 1999/04/16 00:47:21 stanton Exp $
*/
#include <Types.r>
@@ -67,9 +67,7 @@ resource 'vers' (2) {
* will load the TEXT resource named "Init".
*/
-read 'TEXT' (0, "Init", purgeable, preload) "::library:init.tcl";
-read 'TEXT' (1, "History", purgeable,preload) "::library:history.tcl";
-read 'TEXT' (2, "Word", purgeable,preload) "::library:word.tcl";
+#include "tclMacTclCode.r"
/*
* The following resource is used when creating the 'env' variable in
diff --git a/mac/tclMacShLib.exp b/mac/tclMacShLib.exp
index aea4acf..020380f 100644
--- a/mac/tclMacShLib.exp
+++ b/mac/tclMacShLib.exp
@@ -251,7 +251,6 @@ TclEmitForwardJump
TclExecuteByteCode
TclExpandCodeArray
TclExpandJumpFixupArray
-TclExpandParseValue
TclExprFloatError
TclFileAttrsCmd
TclFileCopyCmd
@@ -322,9 +321,6 @@ TclObjIndexForString
TclObjInterpProc
TclObjInvoke
TclObjInvokeGlobal
-TclParseBraces
-TclParseNestedCmd
-TclParseQuotes
TclPlatformExit
TclPlatformInit
TclPreventAliasLoop
@@ -530,7 +526,6 @@ Tcl_GlobalEvalObj
Tcl_GlobalObjCmd
Tcl_HashStats
Tcl_HideCommand
-Tcl_HistoryCmd
Tcl_IfCmd
Tcl_Import
Tcl_IncrCmd
diff --git a/mac/tclMacSock.c b/mac/tclMacSock.c
index 17436da..d387cb5 100644
--- a/mac/tclMacSock.c
+++ b/mac/tclMacSock.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: tclMacSock.c,v 1.3 1999/04/15 22:38:47 stanton Exp $
+ * RCS: @(#) $Id: tclMacSock.c,v 1.4 1999/04/16 00:47:21 stanton Exp $
*/
#include "tclInt.h"
@@ -82,9 +82,6 @@ typedef struct TcpState {
rdsEntry rdsarray[5+1]; /* Array used when cleaning out recieve
* buffers on a closing socket. */
Tcl_Channel channel; /* Channel associated with this socket. */
- int writeBufferSize; /* Size of buffer to hold data for
- * asynchronous writes. */
- void *writeBuffer; /* Buffer for async write data. */
struct TcpState *nextPtr; /* The next socket on the global socket
* list. */
} TcpState;
@@ -243,11 +240,15 @@ static PortInfo portServices[] = {
{NULL, 0},
};
-/*
- * Every open socket has an entry on the following list.
- */
+typedef struct ThreadSpecificData {
+ /*
+ * Every open socket has an entry on the following list.
+ */
+
+ TcpState *socketList;
+} ThreadSpecificData;
-static TcpState *socketList = NULL;
+static Tcl_ThreadDataKey dataKey;
/*
* Globals for holding information about OS support for sockets.
@@ -287,64 +288,77 @@ InitSockets()
ParamBlockRec pb;
OSErr err;
long response;
+ ThreadSpecificData *tsdPtr;
+
+ if (! initialized) {
+ /*
+ * Do process wide initialization.
+ */
- initialized = 1;
- Tcl_CreateExitHandler(SocketExitHandler, (ClientData) NULL);
-
- if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
- hasSockets = true;
- } else {
- hasSockets = false;
- }
-
- if (!hasSockets) {
- return;
- }
-
- /*
- * Load MacTcp driver and name server resolver.
- */
-
-
- pb.ioParam.ioCompletion = 0L;
- pb.ioParam.ioNamePtr = "\p.IPP";
- pb.ioParam.ioPermssn = fsCurPerm;
- err = PBOpenSync(&pb);
- if (err != noErr) {
- hasSockets = 0;
- return;
- }
- driverRefNum = pb.ioParam.ioRefNum;
-
- socketBufferSize = GetBufferSize();
- err = OpenResolver(NULL);
- if (err != noErr) {
- hasSockets = 0;
- return;
+ initialized = 1;
+
+ if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
+ hasSockets = true;
+ } else {
+ hasSockets = false;
+ }
+
+ if (!hasSockets) {
+ return;
+ }
+
+ /*
+ * Load MacTcp driver and name server resolver.
+ */
+
+
+ pb.ioParam.ioCompletion = 0L;
+ pb.ioParam.ioNamePtr = "\p.IPP";
+ pb.ioParam.ioPermssn = fsCurPerm;
+ err = PBOpenSync(&pb);
+ if (err != noErr) {
+ hasSockets = 0;
+ return;
+ }
+ driverRefNum = pb.ioParam.ioRefNum;
+
+ socketBufferSize = GetBufferSize();
+ err = OpenResolver(NULL);
+ if (err != noErr) {
+ hasSockets = 0;
+ return;
+ }
+
+ GetCurrentProcess(&applicationPSN);
+ /*
+ * Create UPP's for various callback routines.
+ */
+
+ resultUPP = NewResultProc(DNRCompletionRoutine);
+ completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
+ closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
+
+ /*
+ * Install an ExitToShell patch. We use this patch instead
+ * of the Tcl exit mechanism because we need to ensure that
+ * these routines are cleaned up even if we crash or are forced
+ * to quit. There are some circumstances when the Tcl exit
+ * handlers may not fire.
+ */
+
+ TclMacInstallExitToShellPatch(CleanUpExitProc);
}
- GetCurrentProcess(&applicationPSN);
- /*
- * Create UPP's for various callback routines.
- */
-
- resultUPP = NewResultProc(DNRCompletionRoutine);
- completeUPP = NewTCPIOCompletionProc(IOCompletionRoutine);
- closeUPP = NewTCPIOCompletionProc(CloseCompletionRoutine);
-
/*
- * Install an ExitToShell patch. We use this patch instead
- * of the Tcl exit mechanism because we need to ensure that
- * these routines are cleaned up even if we crash or are forced
- * to quit. There are some circumstances when the Tcl exit
- * handlers may not fire.
+ * Do per-thread initialization.
*/
- TclMacInstallExitToShellPatch(CleanUpExitProc);
-
- Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
-
- initialized = 1;
+ tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ if (tsdPtr == NULL) {
+ tsdPtr->socketList = NULL;
+ Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
+ Tcl_CreateThreadExitHandler(SocketExitHandler, (ClientData) NULL);
+ }
}
/*
@@ -373,13 +387,12 @@ SocketExitHandler(
/* CleanUpExitProc();
TclMacDeleteExitToShellPatch(CleanUpExitProc); */
}
- initialized = 0;
}
/*
*----------------------------------------------------------------------
*
- * TclHasSockets --
+ * TclpHasSockets --
*
* This function determines whether sockets are available on the
* current system and returns an error in interp if they are not.
@@ -396,12 +409,10 @@ SocketExitHandler(
*/
int
-TclHasSockets(
+TclpHasSockets(
Tcl_Interp *interp) /* Interp for error messages. */
{
- if (!initialized) {
- InitSockets();
- }
+ InitSockets();
if (hasSockets) {
return TCL_OK;
@@ -437,6 +448,7 @@ SocketSetupProc(
{
TcpState *statePtr;
Tcl_Time blockTime = { 0, 0 };
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -446,7 +458,7 @@ SocketSetupProc(
* Check to see if there is a ready socket. If so, poll.
*/
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
if (statePtr->flags & TCP_RELEASE) {
continue;
@@ -483,6 +495,7 @@ SocketCheckProc(
TcpState *statePtr;
SocketEvent *evPtr;
TcpState dummyState;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return;
@@ -494,7 +507,7 @@ SocketCheckProc(
* events).
*/
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
/*
* Check to see if this socket is dead and needs to be cleaned
@@ -1112,7 +1125,7 @@ TcpInput(
*
* TcpGetHandle --
*
- * Called from Tcl_GetChannelFile to retrieve handles from inside
+ * Called from Tcl_GetChannelHandle to retrieve handles from inside
* a file based channel.
*
* Results:
@@ -1213,26 +1226,8 @@ TcpOutput(
if (toWrite < amount) {
amount = toWrite;
}
-
- /* We need to copy the data, otherwise the caller may overwrite
- * the buffer in the middle of our asynchronous call
- */
-
- if (amount > statePtr->writeBufferSize) {
- /*
- * need to grow write buffer
- */
-
- if (statePtr->writeBuffer != (void *) NULL) {
- ckfree(statePtr->writeBuffer);
- }
- statePtr->writeBuffer = (void *) ckalloc(amount);
- statePtr->writeBufferSize = amount;
- }
- memcpy(statePtr->writeBuffer, buf, amount);
- statePtr->dataSegment[0].ptr = statePtr->writeBuffer;
-
statePtr->dataSegment[0].length = amount;
+ statePtr->dataSegment[0].ptr = buf;
statePtr->dataSegment[1].length = 0;
InitMacTCPParamBlock(&statePtr->pb, TCPSend);
statePtr->pb.ioCompletion = completeUPP;
@@ -1491,6 +1486,7 @@ NewSocketInfo(
StreamPtr tcpStream)
{
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
statePtr->tcpStream = tcpStream;
@@ -1500,10 +1496,8 @@ NewSocketInfo(
statePtr->watchMask = 0;
statePtr->acceptProc = (Tcl_TcpAcceptProc *) NULL;
statePtr->acceptProcData = (ClientData) NULL;
- statePtr->writeBuffer = (void *) NULL;
- statePtr->writeBufferSize = 0;
- statePtr->nextPtr = socketList;
- socketList = statePtr;
+ statePtr->nextPtr = tsdPtr->socketList;
+ tsdPtr->socketList = statePtr;
return statePtr;
}
@@ -1528,22 +1522,19 @@ static void
FreeSocketInfo(
TcpState *statePtr) /* The state pointer to free. */
{
- if (statePtr == socketList) {
- socketList = statePtr->nextPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (statePtr == tsdPtr->socketList) {
+ tsdPtr->socketList = statePtr->nextPtr;
} else {
TcpState *p;
- for (p = socketList; p != NULL; p = p->nextPtr) {
+ for (p = tsdPtr->socketList; p != NULL; p = p->nextPtr) {
if (p->nextPtr == statePtr) {
p->nextPtr = statePtr->nextPtr;
break;
}
}
}
-
- if (statePtr->writeBuffer != (void *) NULL) {
- ckfree(statePtr->writeBuffer);
- }
-
ckfree((char *) statePtr);
}
@@ -1570,7 +1561,7 @@ Tcl_MakeTcpClientChannel(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return NULL;
}
@@ -1797,7 +1788,7 @@ Tcl_OpenTcpClient(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1848,7 +1839,7 @@ Tcl_OpenTcpServer(
TcpState *statePtr;
char channelName[20];
- if (TclHasSockets(interp) != TCL_OK) {
+ if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
}
@@ -1903,6 +1894,7 @@ SocketEventProc(
TcpState *statePtr;
SocketEvent *eventPtr = (SocketEvent *) evPtr;
int mask = 0;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!(flags & TCL_FILE_EVENTS)) {
return 0;
@@ -1912,7 +1904,7 @@ SocketEventProc(
* Find the specified socket on the socket list.
*/
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
if ((statePtr == eventPtr->statePtr) &&
(statePtr->tcpStream == eventPtr->tcpStream)) {
@@ -2154,7 +2146,7 @@ Tcl_GetHostName()
return hostname;
}
- if (TclHasSockets(NULL) == TCL_OK) {
+ if (TclpHasSockets(NULL) == TCL_OK) {
err = GetLocalAddress(&ourAddress);
if (err == noErr) {
/*
@@ -2294,10 +2286,11 @@ CleanUpExitProc()
{
TCPiopb exitPB;
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- while (socketList != NULL) {
- statePtr = socketList;
- socketList = statePtr->nextPtr;
+ while (tsdPtr->socketList != NULL) {
+ statePtr = tsdPtr->socketList;
+ tsdPtr->socketList = statePtr->nextPtr;
/*
* Close and Release the connection.
@@ -2349,7 +2342,7 @@ GetHostFromString(
EventRecord dummy;
DNRState dnrState;
- if (TclHasSockets(NULL) != TCL_OK) {
+ if (TclpHasSockets(NULL) != TCL_OK) {
return 0;
}
@@ -2564,7 +2557,7 @@ GetBufferSize()
* Results:
* A standard Tcl result. On success, the port number is
* returned in portPtr. On failure, an error message is left in
- * interp->result.
+ * the interp's result.
*
* Side effects:
* None.
@@ -2632,8 +2625,9 @@ static void
ClearZombieSockets()
{
TcpState *statePtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- for (statePtr = socketList; statePtr != NULL;
+ for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
if (statePtr->flags & TCP_RELEASE) {
SocketFreeProc(statePtr);
diff --git a/mac/tclMacTclCode.r b/mac/tclMacTclCode.r
new file mode 100644
index 0000000..1a8f3ca
--- /dev/null
+++ b/mac/tclMacTclCode.r
@@ -0,0 +1,36 @@
+/*
+ * tclMacTclCode.r --
+ *
+ * This file creates resources from the Tcl code that is
+ * usually stored in the TCL_LiBRARY
+ *
+ * Copyright (c) 1996-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.
+ *
+ * SCCS: @(#) tclMacTclCode.r 1.1 98/01/21 22:22:38
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+#define TCL_LIBRARY_RESOURCES 2000
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * require some predetermined file structure - all needed Tcl "files"
+ * are located within the application. To source a file for the
+ * resource fork the source command has been modified to support
+ * sourcing from resources. In the below case "source -rsrc {Init}"
+ * will load the TEXT resource named "Init".
+ */
+
+read 'TEXT' (TCL_LIBRARY_RESOURCES, "Init", purgeable) "::library:init.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 1, "Auto", purgeable) "::library:auto.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 2, "Package", purgeable,preload) "::library:package.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 3, "History", purgeable) "::library:history.tcl";
+read 'TEXT' (TCL_LIBRARY_RESOURCES + 4, "Word", purgeable,preload) "::library:word.tcl";
diff --git a/mac/tclMacThrd.c b/mac/tclMacThrd.c
new file mode 100644
index 0000000..7790e5f
--- /dev/null
+++ b/mac/tclMacThrd.c
@@ -0,0 +1,795 @@
+/*
+ * tclMacThrd.c --
+ *
+ * This file implements the Mac-specific thread support.
+ *
+ * Copyright (c) 1991-1994 The Regents of the University of California.
+ * Copyright (c) 1994-1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacThrd.c 1.2 98/02/23 16:48:07
+ */
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMacInt.h"
+#include <Threads.h>
+#include <Gestalt.h>
+
+#define TCL_MAC_THRD_DEFAULT_STACK (256*1024)
+
+
+typedef struct TclMacThrdData {
+ ThreadID threadID;
+ VOID *data;
+ struct TclMacThrdData *next;
+} TclMacThrdData;
+
+/*
+ * This is an array of the Thread Data Keys. It is a process-wide table.
+ * Its size is originally set to 32, but it can grow if needed.
+ */
+
+static TclMacThrdData **tclMacDataKeyArray;
+#define TCL_MAC_INITIAL_KEYSIZE 32
+
+/*
+ * These two bits of data store the current maximum number of keys
+ * and the keyCounter (which is the number of occupied slots in the
+ * KeyData array.
+ *
+ */
+
+static int maxNumKeys = 0;
+static int keyCounter = 0;
+
+/*
+ * Prototypes for functions used only in this file
+ */
+
+TclMacThrdData *GetThreadDataStruct(Tcl_ThreadDataKey keyVal);
+TclMacThrdData *RemoveThreadDataStruct(Tcl_ThreadDataKey keyVal);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclMacHaveThreads --
+ *
+ * Do we have the Thread Manager?
+ *
+ * Results:
+ * 1 if the ThreadManager is present, 0 otherwise.
+ *
+ * Side effects:
+ * If this is the first time this is called, the return is cached.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclMacHaveThreads(void)
+{
+ static initialized = false;
+ static int tclMacHaveThreads = false;
+ long response = 0;
+ OSErr err = noErr;
+
+ if (!initialized) {
+ err = Gestalt(gestaltThreadMgrAttr, &response);
+ if (err == noErr) {
+ tclMacHaveThreads = response | (1 << gestaltThreadMgrPresent);
+ }
+ }
+
+ return tclMacHaveThreads;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadCreate --
+ *
+ * This procedure creates a new thread.
+ *
+ * Results:
+ * TCL_OK if the thread could be created. The thread ID is
+ * returned in a parameter.
+ *
+ * Side effects:
+ * A new thread is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclpThreadCreate(idPtr, proc, clientData)
+ Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
+ Tcl_ThreadCreateProc proc; /* Main() function of the thread */
+ ClientData clientData; /* The one argument to Main() */
+{
+
+ if (!TclMacHaveThreads()) {
+ return TCL_ERROR;
+ }
+
+#if TARGET_CPU_68K && TARGET_RT_MAC_CFM
+ {
+ ThreadEntryProcPtr entryProc;
+ entryProc = NewThreadEntryProc(proc);
+
+ NewThread(kCooperativeThread, entryProc, (void *) clientData,
+ TCL_MAC_THRD_DEFAULT_STACK, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
+ }
+#else
+ NewThread(kCooperativeThread, proc, (void *) clientData,
+ TCL_MAC_THRD_DEFAULT_STACK, kCreateIfNeeded, NULL, (ThreadID *) idPtr);
+#endif
+ if ((ThreadID) *idPtr == kNoThreadID) {
+ return TCL_ERROR;
+ } else {
+ return TCL_OK;
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadExit --
+ *
+ * This procedure terminates the current thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This procedure terminates the current thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadExit(status)
+ int status;
+{
+ ThreadID curThread;
+
+ if (!TclMacHaveThreads()) {
+ return;
+ }
+
+ GetCurrentThread(&curThread);
+ DisposeThread(curThread, NULL, false);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetCurrentThread --
+ *
+ * This procedure returns the ID of the currently running thread.
+ *
+ * Results:
+ * A thread ID.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ThreadId
+Tcl_GetCurrentThread()
+{
+#ifdef TCL_THREADS
+ ThreadID curThread;
+
+ if (!TclMacHaveThreads()) {
+ return (Tcl_ThreadId) 0;
+ } else {
+ GetCurrentThread(&curThread);
+ return (Tcl_ThreadId) curThread;
+ }
+#else
+ return (Tcl_ThreadId) 0;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitLock
+ *
+ * This procedure is used to grab a lock that serializes initialization
+ * and finalization of Tcl. On some platforms this may also initialize
+ * the mutex used to serialize creation of more mutexes and thread
+ * local storage keys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitLock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac. */;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpInitUnlock
+ *
+ * This procedure is used to release a lock that serializes initialization
+ * and finalization of Tcl.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the initialization mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpInitUnlock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac */;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterLock
+ *
+ * This procedure is used to grab a lock that serializes creation
+ * and finalization of serialization objects. This interface is
+ * only needed in finalization; it is hidden during
+ * creation of the objects.
+ *
+ * This lock must be different than the initLock because the
+ * initLock is held during creation of syncronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Acquire the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterLock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac */;
+#endif
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMasterUnlock
+ *
+ * This procedure is used to release a lock that serializes creation
+ * and finalization of synchronization objects.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Release the master mutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpMasterUnlock()
+{
+#ifdef TCL_THREADS
+ /* There is nothing to do on the Mac */
+#endif
+}
+
+#ifdef TCL_THREADS
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_MutexLock --
+ *
+ * This procedure is invoked to lock a mutex. This procedure
+ * handles initializing the mutex, if necessary. The caller
+ * can rely on the fact that Tcl_Mutex is an opaque pointer.
+ * This routine will change that pointer from NULL after first use.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May block the current thread. The mutex is aquired when
+ * this returns. Will allocate memory for a pthread_mutex_t
+ * and initialize this the first time this Tcl_Mutex is used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexLock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+{
+/* There is nothing to do on the Mac */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpMutexUnlock --
+ *
+ * This procedure is invoked to unlock a mutex. The mutex must
+ * have been locked by Tcl_MutexLock.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex is released when this returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_MutexUnlock(mutexPtr)
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+{
+/* There is nothing to do on the Mac */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeMutex --
+ *
+ * This procedure is invoked to clean up one mutex. This is only
+ * safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The mutex list is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeMutex(mutexPtr)
+ Tcl_Mutex *mutexPtr;
+{
+/* There is nothing to do on the Mac */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyInit --
+ *
+ * This procedure initializes a thread specific data block key.
+ * Each thread has table of pointers to thread specific data.
+ * all threads agree on which table entry is used by each module.
+ * this is remembered in a "data key", that is just an index into
+ * this table. To allow self initialization, the interface
+ * passes a pointer to this key and the first thread to use
+ * the key fills in the pointer to the key. The key should be
+ * a process-wide static.
+ *
+ * There is no system-wide support for thread specific data on the
+ * Mac. So we implement this as an array of pointers. The keys are
+ * allocated sequentially, and each key maps to a slot in the table.
+ * The table element points to a linked list of the instances of
+ * the data for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Will bump the key counter if this is the first time this key
+ * has been initialized. May grow the DataKeyArray if that is
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeyInit(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+
+ if (*keyPtr == NULL) {
+ keyCounter += 1;
+ *keyPtr = (Tcl_ThreadDataKey) keyCounter;
+ if (keyCounter > maxNumKeys) {
+ TclMacThrdData **newArray;
+ int i, oldMax = maxNumKeys;
+
+ maxNumKeys = maxNumKeys + TCL_MAC_INITIAL_KEYSIZE;
+
+ newArray = (TclMacThrdData **)
+ ckalloc(maxNumKeys * sizeof(TclMacThrdData *));
+
+ for (i = 0; i < oldMax; i++) {
+ newArray[i] = tclMacDataKeyArray[i];
+ }
+ for (i = oldMax; i < maxNumKeys; i++) {
+ newArray[i] = NULL;
+ }
+
+ if (tclMacDataKeyArray != NULL) {
+ ckfree((char *) tclMacDataKeyArray);
+ }
+ tclMacDataKeyArray = newArray;
+
+ }
+ /* TclRememberDataKey(keyPtr); */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeyGet --
+ *
+ * This procedure returns a pointer to a block of thread local storage.
+ *
+ * Results:
+ * A thread-specific pointer to the data structure, or NULL
+ * if the memory has not been assigned to this key for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+VOID *
+TclpThreadDataKeyGet(keyPtr)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+{
+ TclMacThrdData *dataPtr;
+
+ dataPtr = GetThreadDataStruct(*keyPtr);
+
+ if (dataPtr == NULL) {
+ return NULL;
+ } else {
+ return dataPtr->data;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpThreadDataKeySet --
+ *
+ * This procedure sets the pointer to a block of thread local storage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up the thread so future calls to TclpThreadDataKeyGet with
+ * this key will return the data pointer.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpThreadDataKeySet(keyPtr, data)
+ Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
+ * really (pthread_key_t **) */
+ VOID *data; /* Thread local storage */
+{
+ TclMacThrdData *dataPtr;
+ ThreadID curThread;
+
+ dataPtr = GetThreadDataStruct(*keyPtr);
+
+ /*
+ * Is it legal to reset the thread data like this?
+ * And if so, who owns the memory?
+ */
+
+ if (dataPtr != NULL) {
+ dataPtr->data = data;
+ } else {
+ dataPtr = (TclMacThrdData *) ckalloc(sizeof(TclMacThrdData));
+ GetCurrentThread(&curThread);
+ dataPtr->threadID = curThread;
+ dataPtr->data = data;
+ dataPtr->next = tclMacDataKeyArray[(int) *keyPtr - 1];
+ tclMacDataKeyArray[(int) *keyPtr - 1] = dataPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadData --
+ *
+ * This procedure cleans up the thread-local storage. This is
+ * called once for each thread.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up all thread local storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadData(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ TclMacThrdData *dataPtr;
+
+ if (*keyPtr != NULL) {
+ dataPtr = RemoveThreadDataStruct(*keyPtr);
+
+ if ((dataPtr != NULL) && (dataPtr->data != NULL)) {
+ ckfree((char *) dataPtr->data);
+ ckfree((char *) dataPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeThreadDataKey --
+ *
+ * This procedure is invoked to clean up one key. This is a
+ * process-wide storage identifier. The thread finalization code
+ * cleans up the thread local storage itself.
+ *
+ * On the Mac, there is really nothing to do here, since the key
+ * is just an array index. But we set the key to 0 just in case
+ * someone else is relying on that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The keyPtr value is set to 0.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeThreadDataKey(keyPtr)
+ Tcl_ThreadDataKey *keyPtr;
+{
+ ckfree((char *) tclMacDataKeyArray[(int) *keyPtr - 1]);
+ tclMacDataKeyArray[(int) *keyPtr - 1] = NULL;
+ *keyPtr = NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetThreadDataStruct --
+ *
+ * This procedure gets the data structure corresponding to
+ * keyVal for the current process.
+ *
+ * Results:
+ * The requested key data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclMacThrdData *
+GetThreadDataStruct(keyVal)
+ Tcl_ThreadDataKey keyVal;
+{
+ ThreadID curThread;
+ TclMacThrdData *dataPtr;
+
+ /*
+ * The keyPtr will only be greater than keyCounter is someone
+ * has passed us a key without getting the value from
+ * TclpInitDataKey.
+ */
+
+ if ((int) keyVal <= 0) {
+ return NULL;
+ } else if ((int) keyVal > keyCounter) {
+ panic("illegal data key value");
+ }
+
+ GetCurrentThread(&curThread);
+
+ for (dataPtr = tclMacDataKeyArray[(int) keyVal - 1]; dataPtr != NULL;
+ dataPtr = dataPtr->next) {
+ if (dataPtr->threadID == curThread) {
+ break;
+ }
+ }
+
+ return dataPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RemoveThreadDataStruct --
+ *
+ * This procedure removes the data structure corresponding to
+ * keyVal for the current process from the list kept for keyVal.
+ *
+ * Results:
+ * The requested key data is removed from the list, and a pointer
+ * to it is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclMacThrdData *
+RemoveThreadDataStruct(keyVal)
+ Tcl_ThreadDataKey keyVal;
+{
+ ThreadID curThread;
+ TclMacThrdData *dataPtr, *prevPtr;
+
+
+ if ((int) keyVal <= 0) {
+ return NULL;
+ } else if ((int) keyVal > keyCounter) {
+ panic("illegal data key value");
+ }
+
+ GetCurrentThread(&curThread);
+
+ for (dataPtr = tclMacDataKeyArray[(int) keyVal - 1], prevPtr = NULL;
+ dataPtr != NULL;
+ prevPtr = dataPtr, dataPtr = dataPtr->next) {
+ if (dataPtr->threadID == curThread) {
+ break;
+ }
+ }
+
+ if (dataPtr == NULL) {
+ /* No body */
+ } else if ( prevPtr == NULL) {
+ tclMacDataKeyArray[(int) keyVal - 1] = dataPtr->next;
+ } else {
+ prevPtr->next = dataPtr->next;
+ }
+
+ return dataPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionWait --
+ *
+ * This procedure is invoked to wait on a condition variable.
+ * On the Mac, mutexes are no-ops, and we just yield. After
+ * all, it is the application's job to loop till the condition
+ * variable is changed...
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Will block the current thread till someone else yields.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+ Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
+ Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
+ Tcl_Time *timePtr; /* Timeout on waiting period */
+{
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConditionNotify --
+ *
+ * This procedure is invoked to signal a condition variable.
+ *
+ * The mutex must be held during this call to avoid races,
+ * but this interface does not enforce that.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May unblock another thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConditionNotify(condPtr)
+ Tcl_Condition *condPtr;
+{
+ if (TclMacHaveThreads()) {
+ YieldToAnyThread();
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclpFinalizeCondition --
+ *
+ * This procedure is invoked to clean up a condition variable.
+ * This is only safe to call at the end of time.
+ *
+ * This assumes the Master Lock is held.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The condition variable is deallocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclpFinalizeCondition(condPtr)
+ Tcl_Condition *condPtr;
+{
+ /* Nothing to do on the Mac */
+}
+
+
+
+#endif /* TCL_THREADS */
+
diff --git a/mac/tclMacThrd.h b/mac/tclMacThrd.h
new file mode 100644
index 0000000..22f2c83
--- /dev/null
+++ b/mac/tclMacThrd.h
@@ -0,0 +1,20 @@
+/*
+ * tclUnixThrd.h --
+ *
+ * This header file defines things for thread support.
+ *
+ * Copyright (c) 1998 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#)
+ */
+
+#ifndef _TCLMACTHRD
+#define _TCLMACTHRD
+
+#ifdef TCL_THREADS
+
+#endif /* TCL_THREADS */
+#endif /* _TCLMACTHRD */
diff --git a/mac/tclMacUnix.c b/mac/tclMacUnix.c
index 8d99ee3..483780c 100644
--- a/mac/tclMacUnix.c
+++ b/mac/tclMacUnix.c
@@ -7,12 +7,12 @@
* Unix Tcl normally hands off to the Unix OS.
*
* Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
- * Copyright (c) 1994-1996 Sun Microsystems, Inc.
+ * Copyright (c) 1994-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: tclMacUnix.c,v 1.2 1998/09/14 18:40:07 stanton Exp $
+ * RCS: @(#) $Id: tclMacUnix.c,v 1.3 1999/04/16 00:47:22 stanton Exp $
*/
#include <Files.h>
@@ -51,60 +51,6 @@
#define noSourceErr 501
#define isDirErr 502
-/*
- * Static functions in this file.
- */
-
-static int GlobArgs _ANSI_ARGS_((Tcl_Interp *interp,
- int *argc, char ***argv));
-
-/*
- *----------------------------------------------------------------------
- *
- * GlobArgs --
- *
- * The following function was taken from Peter Keleher's Alpha
- * Editor. *argc should only count the end arguments that should
- * be globed. argv should be incremented to point to the first
- * arg to be globed.
- *
- * Results:
- * Returns 'true' if it worked & memory was allocated, else 'false'.
- *
- * Side effects:
- * argv will be alloced, the call will need to release the memory
- *
- *----------------------------------------------------------------------
- */
-
-static int
-GlobArgs(
- Tcl_Interp *interp, /* Tcl interpreter. */
- int *argc, /* Number of arguments. */
- char ***argv) /* Argument strings. */
-{
- int res, len;
- char *list;
-
- /*
- * Places the globbed args all into 'interp->result' as a list.
- */
- res = Tcl_GlobCmd(NULL, interp, *argc + 1, *argv - 1);
- if (res != TCL_OK) {
- return false;
- }
- len = strlen(interp->result);
- list = (char *) ckalloc(len + 1);
- strcpy(list, interp->result);
- Tcl_ResetResult(interp);
-
- res = Tcl_SplitList(interp, list, argc, argv);
- ckfree((char *) list);
- if (res != TCL_OK) {
- return false;
- }
- return true;
-}
/*
*----------------------------------------------------------------------
@@ -138,24 +84,24 @@ Tcl_EchoCmd(
return TCL_ERROR;
}
for (i = 1; i < argc; i++) {
- result = Tcl_Write(chan, argv[i], -1);
+ result = Tcl_WriteChars(chan, argv[i], -1);
if (result < 0) {
Tcl_AppendResult(interp, "echo: ", Tcl_GetChannelName(chan),
": ", Tcl_PosixError(interp), (char *) NULL);
return TCL_ERROR;
}
if (i < (argc - 1)) {
- Tcl_Write(chan, " ", -1);
+ Tcl_WriteChars(chan, " ", -1);
}
}
- Tcl_Write(chan, "\n", -1);
+ Tcl_WriteChars(chan, "\n", -1);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * Tcl_LsCmd --
+ * Tcl_LsObjCmd --
*
* This procedure is invoked to process the "ls" Tcl command.
* See the user documentation for details on what it does.
@@ -169,17 +115,16 @@ Tcl_EchoCmd(
*----------------------------------------------------------------------
*/
int
-Tcl_LsCmd(
+Tcl_LsObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument strings. */
{
#define STRING_LENGTH 80
#define CR '\n'
int i, j;
int fieldLength, len = 0, maxLen = 0, perLine;
- char **origArgv = argv;
OSErr err;
CInfoPBRec paramBlock;
HFileInfo *hpb = (HFileInfo *)&paramBlock;
@@ -188,24 +133,27 @@ Tcl_LsCmd(
char theLine[STRING_LENGTH + 2];
int fFlag = false, pFlag = false, aFlag = false, lFlag = false,
cFlag = false, hFlag = false;
+ char *argv;
+ Tcl_Obj *newObjv[2], *resultObjPtr;
/*
* Process command flags. End if argument doesn't start
* with a dash or is a dash by itself. The remaining arguments
* should be files.
*/
- for (i = 1; i < argc; i++) {
- if (argv[i][0] != '-') {
+ for (i = 1; i < objc; i++) {
+ argv = Tcl_GetString(objv[i]);
+ if (argv[0] != '-') {
break;
}
- if (!strcmp(argv[i], "-")) {
+ if (!strcmp(argv, "-")) {
i++;
break;
}
- for (j = 1 ; argv[i][j] ; ++j) {
- switch(argv[i][j]) {
+ for (j = 1 ; argv[j] ; ++j) {
+ switch(argv[j]) {
case 'a':
case 'A':
aFlag = true;
@@ -237,24 +185,34 @@ Tcl_LsCmd(
}
}
- argv += i;
- argc -= i;
+ objv += i;
+ objc -= i;
/*
* No file specifications means we search for all files.
* Glob will be doing most of the work.
*/
- if (!argc) {
- argc = 1;
- argv = origArgv;
- strcpy(argv[0], "*");
+ if (!objc) {
+ objc = 1;
+ newObjv[0] = Tcl_NewStringObj("*", -1);
+ newObjv[1] = NULL;
+ objv = newObjv;
+ }
+
+ if (Tcl_GlobObjCmd(NULL, interp, objc + 1, objv - 1) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ return TCL_ERROR;
}
- if (!GlobArgs(interp, &argc, &argv)) {
- Tcl_ResetResult(interp);
- return TCL_ERROR;
+ resultObjPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultObjPtr);
+ if (Tcl_ListObjGetElements(interp, resultObjPtr, &objc, &objv) != TCL_OK) {
+ Tcl_DecrRefCount(resultObjPtr);
+ return TCL_ERROR;
}
+ Tcl_ResetResult(interp);
+
/*
* There are two major methods for listing files: the long
* method and the normal method.
@@ -264,6 +222,9 @@ Tcl_LsCmd(
char lineTag;
long size;
unsigned short flags;
+ Tcl_Obj *objPtr;
+ char *string;
+ int length;
/*
* Print the header for long listing.
@@ -278,8 +239,8 @@ Tcl_LsCmd(
NULL);
}
- for (i = 0; i < argc; i++) {
- strcpy(theFile, argv[i]);
+ for (i = 0; i < objc; i++) {
+ strcpy(theFile, Tcl_GetString(objv[i]));
c2pstr(theFile);
hpb->ioCompletion = NULL;
@@ -347,11 +308,10 @@ Tcl_LsCmd(
}
- if ((interp->result != NULL) && (*(interp->result) != '\0')) {
- int slen = strlen(interp->result);
- if (interp->result[slen - 1] == '\n') {
- interp->result[slen - 1] = '\0';
- }
+ objPtr = Tcl_GetObjResult(interp);
+ string = Tcl_GetStringFromObj(objPtr, &length);
+ if ((length > 0) && (string[length - 1] == '\n')) {
+ Tcl_SetObjLength(objPtr, length - 1);
}
} else {
/*
@@ -369,8 +329,9 @@ Tcl_LsCmd(
perLine = 1;
fieldLength = STRING_LENGTH;
} else {
- for (i = 0; i < argc; i++) {
- len = strlen(argv[i]);
+ for (i = 0; i < objc; i++) {
+ argv = Tcl_GetString(objv[i]);
+ len = strlen(argv);
if (len > maxLen) {
maxLen = len;
}
@@ -382,8 +343,8 @@ Tcl_LsCmd(
argCount = 0;
linePos = 0;
memset(theLine, ' ', STRING_LENGTH);
- while (argCount < argc) {
- strcpy(theFile, argv[argCount]);
+ while (argCount < objc) {
+ strcpy(theFile, Tcl_GetString(objv[argCount]));
c2pstr(theFile);
hpb->ioCompletion = NULL;
@@ -457,8 +418,8 @@ Tcl_LsCmd(
}
}
}
-
- ckfree((char *) argv);
-
+
+ Tcl_DecrRefCount(resultObjPtr);
+
return TCL_OK;
}
generated by cgit v0.12 at 2024-11-01 18:41:58 (GMT)