Comments and formatting

1 files changed, 531 insertions, 392 deletions

diff --git a/generic/tclProcess.c b/generic/tclProcess.c
index bd3467b..8d98a23 100644
--- a/generic/tclProcess.c
+++ b/generic/tclProcess.c
@@ -2,7 +2,7 @@
  * tclProcess.c --
  *
  *	This file implements the "tcl::process" ensemble for subprocess 
- *      management as defined by TIP #462.
+ *	management as defined by TIP #462.
  *
  * Copyright (c) 2017 Frederic Bonnet.
  *
@@ -17,7 +17,7 @@
  * processes (see tclPipe.c).
  */
 
-static int autopurge = 1;		/* Autopurge flag. */
+static int autopurge = 1;	/* Autopurge flag. */
 
 /*
  * Hash tables that keeps track of all child process statuses. Keys are the 
@@ -25,13 +25,14 @@ static int autopurge = 1;		/* Autopurge flag. */
  */
 
 typedef struct ProcessInfo {
-    Tcl_Pid pid; /*FRED TODO*/
-    int resolvedPid; /*FRED TODO*/
-    int purge; /*FRED TODO*/
-    TclProcessWaitStatus status;
-    int code; /*FRED TODO*/
-    Tcl_Obj *msg; /*FRED TODO*/
-    Tcl_Obj *error; /*FRED TODO*/
+    Tcl_Pid pid;		/* Process id. */
+    int resolvedPid;		/* Resolved process id. */
+    int purge;			/* Purge eventualy. */
+    TclProcessWaitStatus status;/* Process status. */
+    int code;			/* Error code, exit status or signal 
+				   number. */
+    Tcl_Obj *msg;		/* Error message. */
+    Tcl_Obj *error;		/* Error code. */
 } ProcessInfo;
 static Tcl_HashTable infoTablePerPid;
 static Tcl_HashTable infoTablePerResolvedPid;
@@ -42,33 +43,48 @@ TCL_DECLARE_MUTEX(infoTablesMutex)
  * Prototypes for functions defined later in this file:
  */
 
-static void             InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
-                            int resolvedPid);
-static void             FreeProcessInfo(ProcessInfo *info);
-static int              RefreshProcessInfo(ProcessInfo *info, int options);
-static int              WaitProcessStatus(Tcl_Pid pid, int resolvedPid, 
+static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
+			    int resolvedPid);
+static void		FreeProcessInfo(ProcessInfo *info);
+static int		RefreshProcessInfo(ProcessInfo *info, int options);
+static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid, 
 			    int options, int *codePtr, Tcl_Obj **msgPtr,
-                            Tcl_Obj **errorObjPtr);
-static Tcl_Obj *        BuildProcessStatusObj(ProcessInfo *info);
-static int              ProcessListObjCmd(ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-                            Tcl_Obj *const objv[]);
-static int              ProcessStatusObjCmd(ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-                            Tcl_Obj *const objv[]);
-static int              ProcessPurgeObjCmd(ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-                            Tcl_Obj *const objv[]);
-static int              ProcessAutopurgeObjCmd(ClientData clientData,
-                            Tcl_Interp *interp, int objc,
-                            Tcl_Obj *const objv[]);
-
-/* FRED TODO */
+			    Tcl_Obj **errorObjPtr);
+static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
+static int		ProcessListObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		ProcessStatusObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		ProcessPurgeObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static int		ProcessAutopurgeObjCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitProcessInfo --
+ *
+ *	Initializes the ProcessInfo structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory written.
+ *
+ *----------------------------------------------------------------------
+ */
+
 void
 InitProcessInfo(
-    ProcessInfo *info,
-    Tcl_Pid pid,
-    int resolvedPid)
+    ProcessInfo *info,		/* Structure to initialize. */
+    Tcl_Pid pid,		/* Process id. */
+    int resolvedPid)		/* Resolved process id. */
 {
     info->pid = pid;
     info->resolvedPid = resolvedPid;
@@ -79,51 +95,115 @@ InitProcessInfo(
     info->error = NULL;
 }
 
-/* FRED TODO */
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeProcessInfo --
+ *
+ *	Free the ProcessInfo structure.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Memory deallocated, Tcl_Obj refcount decreased.
+ *
+ *----------------------------------------------------------------------
+ */
+
 void
 FreeProcessInfo(
-    ProcessInfo *info)
+    ProcessInfo *info)		/* Structure to free. */
 {
+    /*
+     * Free stored Tcl_Objs.
+     */
+
     if (info->msg) {
-        Tcl_DecrRefCount(info->msg);
+	Tcl_DecrRefCount(info->msg);
     }
     if (info->error) {
-        Tcl_DecrRefCount(info->error);
+	Tcl_DecrRefCount(info->error);
     }
+
+    /*
+     * Free allocated structure.
+     */
+
     ckfree(info);
 }
 
-/* FRED TODO */
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefreshProcessInfo --
+ *
+ *	Refresh process info.
+ *
+ * Results:
+ *	Nonzero if state changed, else zero.
+ *
+ * Side effects:
+ *	May call WaitProcessStatus, which can block if WNOHANG option is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
 int
 RefreshProcessInfo(
-    ProcessInfo *info,
-    int options
+    ProcessInfo *info,		/* Structure to refresh. */
+    int options			/* Options passed to WaitProcessStatus. */
 )
 {
     if (info->status == TCL_PROCESS_UNCHANGED) {
-        /*
-         * Refresh & store status.
-         */
-
-        info->status = WaitProcessStatus(info->pid, info->resolvedPid, 
-                options, &info->code, &info->msg, &info->error);
-        if (info->msg) Tcl_IncrRefCount(info->msg);
-        if (info->error) Tcl_IncrRefCount(info->error);
-        return (info->status != TCL_PROCESS_UNCHANGED);
+	/*
+	 * Refresh & store status.
+	 */
+
+	info->status = WaitProcessStatus(info->pid, info->resolvedPid, 
+		options, &info->code, &info->msg, &info->error);
+	if (info->msg) Tcl_IncrRefCount(info->msg);
+	if (info->error) Tcl_IncrRefCount(info->error);
+	return (info->status != TCL_PROCESS_UNCHANGED);
     } else {
-        return 0;
+	/*
+	 * No change.
+	 */
+
+	return 0;
     }
 }
 
-/* FRED TODO */
-int
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitProcessStatus --
+ *
+ *	Wait for process status to change.
+ *
+ * Results:
+ *	TclProcessWaitStatus enum value.
+ *
+ * Side effects:
+ *	May call WaitProcessStatus, which can block if WNOHANG option is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclProcessWaitStatus
 WaitProcessStatus(
-    Tcl_Pid pid,
-    int resolvedPid,
-    int options,
-    int *codePtr, 
-    Tcl_Obj **msgObjPtr,
-    Tcl_Obj **errorObjPtr)
+    Tcl_Pid pid,		/* Process id. */
+    int resolvedPid,		/* Resolved process id. */
+    int options,		/* Options passed to Tcl_WaitPid. */
+    int *codePtr,		/* If non-NULL, will receive either:
+				 *  - 0 for normal exit.
+				 *  - errno in case of error.
+				 *  - non-zero exit code for abormal exit.
+				 *  - signal number if killed or suspended.
+				 *  - Tcl_WaitPid status in all other cases.
+				 */
+    Tcl_Obj **msgObjPtr,	/* If non-NULL, will receive error message. */
+    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
 {
     int waitStatus;
     Tcl_Obj *errorStrings[5];
@@ -131,11 +211,11 @@ WaitProcessStatus(
 
     pid = Tcl_WaitPid(pid, &waitStatus, options);
     if ((pid == 0)) {
-        /*
-         * No change.
-         */
-        
-        return TCL_PROCESS_UNCHANGED;
+	/*
+	 * No change.
+	 */
+	
+	return TCL_PROCESS_UNCHANGED;
     }
 
     /*
@@ -143,117 +223,136 @@ WaitProcessStatus(
      */
 
     if (pid == (Tcl_Pid) -1) {
-        /*
-         * POSIX errName msg
-         */
-
-        msg = Tcl_ErrnoMsg(errno);
-        if (errno == ECHILD) {
-            /*
-             * This changeup in message suggested by Mark Diekhans to
-             * remind people that ECHILD errors can occur on some
-             * systems if SIGCHLD isn't in its default state.
-             */
-
-            msg = "child process lost (is SIGCHLD ignored or trapped?)";
-        }
-        if (codePtr) *codePtr = errno;
-        if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
-                "error waiting for process to exit: %s", msg);
-        if (errorObjPtr) {
-            errorStrings[0] = Tcl_NewStringObj("POSIX", -1);
-            errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
-            errorStrings[2] = Tcl_NewStringObj(msg, -1);
-            *errorObjPtr = Tcl_NewListObj(3, errorStrings);
-        }
-        return TCL_PROCESS_ERROR;
+	/*
+	 * POSIX errName msg
+	 */
+
+	msg = Tcl_ErrnoMsg(errno);
+	if (errno == ECHILD) {
+	    /*
+	     * This changeup in message suggested by Mark Diekhans to
+	     * remind people that ECHILD errors can occur on some
+	     * systems if SIGCHLD isn't in its default state.
+	     */
+
+	    msg = "child process lost (is SIGCHLD ignored or trapped?)";
+	}
+	if (codePtr) *codePtr = errno;
+	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
+		"error waiting for process to exit: %s", msg);
+	if (errorObjPtr) {
+	    errorStrings[0] = Tcl_NewStringObj("POSIX", -1);
+	    errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
+	    errorStrings[2] = Tcl_NewStringObj(msg, -1);
+	    *errorObjPtr = Tcl_NewListObj(3, errorStrings);
+	}
+	return TCL_PROCESS_ERROR;
     } else if (WIFEXITED(waitStatus)) {
-        if (codePtr) *codePtr = WEXITSTATUS(waitStatus);
-        if (!WEXITSTATUS(waitStatus)) {
-            /*
-             * Normal exit.
-             */
-
-            if (msgObjPtr) *msgObjPtr = NULL;
-            if (errorObjPtr) *errorObjPtr = NULL;
-        } else {
-            /*
-             * CHILDSTATUS pid code
-             *
-             * Child exited with a non-zero exit status.
-             */
-
-            if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
-	            "child process exited abnormally", -1);
-            if (errorObjPtr) {
-                errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
-                errorStrings[1] = Tcl_NewIntObj(resolvedPid);
-                errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus));
-                *errorObjPtr = Tcl_NewListObj(3, errorStrings);
-            }
-        }
-        return TCL_PROCESS_EXITED;
+	if (codePtr) *codePtr = WEXITSTATUS(waitStatus);
+	if (!WEXITSTATUS(waitStatus)) {
+	    /*
+	     * Normal exit.
+	     */
+
+	    if (msgObjPtr) *msgObjPtr = NULL;
+	    if (errorObjPtr) *errorObjPtr = NULL;
+	} else {
+	    /*
+	     * CHILDSTATUS pid code
+	     *
+	     * Child exited with a non-zero exit status.
+	     */
+
+	    if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
+		    "child process exited abnormally", -1);
+	    if (errorObjPtr) {
+		errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
+		errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+		errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus));
+		*errorObjPtr = Tcl_NewListObj(3, errorStrings);
+	    }
+	}
+	return TCL_PROCESS_EXITED;
     } else if (WIFSIGNALED(waitStatus)) {
-        /*
-         * CHILDKILLED pid sigName msg
-         *
-         * Child killed because of a signal.
-         */
-
-        msg = Tcl_SignalMsg(WTERMSIG(waitStatus));
-        if (codePtr) *codePtr = WTERMSIG(waitStatus);
-        if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
-                "child killed: %s", msg);
-        if (errorObjPtr) {
-            errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
-            errorStrings[1] = Tcl_NewIntObj(resolvedPid);
-            errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
-            errorStrings[3] = Tcl_NewStringObj(msg, -1);
-            *errorObjPtr = Tcl_NewListObj(4, errorStrings);
-        }
-        return TCL_PROCESS_SIGNALED;
+	/*
+	 * CHILDKILLED pid sigName msg
+	 *
+	 * Child killed because of a signal.
+	 */
+
+	msg = Tcl_SignalMsg(WTERMSIG(waitStatus));
+	if (codePtr) *codePtr = WTERMSIG(waitStatus);
+	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
+		"child killed: %s", msg);
+	if (errorObjPtr) {
+	    errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
+	    errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+	    errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
+	    errorStrings[3] = Tcl_NewStringObj(msg, -1);
+	    *errorObjPtr = Tcl_NewListObj(4, errorStrings);
+	}
+	return TCL_PROCESS_SIGNALED;
     } else if (WIFSTOPPED(waitStatus)) {
-        /*
-         * CHILDSUSP pid sigName msg
-         *
-         * Child suspended because of a signal.
-         */
-
-        msg = Tcl_SignalMsg(WSTOPSIG(waitStatus));
-        if (codePtr) *codePtr = WSTOPSIG(waitStatus);
-        if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
-                "child suspended: %s", msg);
-        if (errorObjPtr) {
-            errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
-            errorStrings[1] = Tcl_NewIntObj(resolvedPid);
-            errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
-            errorStrings[3] = Tcl_NewStringObj(msg, -1);
-            *errorObjPtr = Tcl_NewListObj(4, errorStrings);
-        }
-        return TCL_PROCESS_STOPPED;
+	/*
+	 * CHILDSUSP pid sigName msg
+	 *
+	 * Child suspended because of a signal.
+	 */
+
+	msg = Tcl_SignalMsg(WSTOPSIG(waitStatus));
+	if (codePtr) *codePtr = WSTOPSIG(waitStatus);
+	if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
+		"child suspended: %s", msg);
+	if (errorObjPtr) {
+	    errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
+	    errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+	    errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
+	    errorStrings[3] = Tcl_NewStringObj(msg, -1);
+	    *errorObjPtr = Tcl_NewListObj(4, errorStrings);
+	}
+	return TCL_PROCESS_STOPPED;
     } else {
-        /*
-         * TCL OPERATION EXEC ODDWAITRESULT
-         *
-         * Child wait status didn't make sense.
-         */
-
-        if (codePtr) *codePtr = waitStatus;
-        if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
-	        "child wait status didn't make sense\n", -1);
-        if (errorObjPtr) {
-            errorStrings[0] = Tcl_NewStringObj("TCL", -1);
-            errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
-            errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
-            errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
-            errorStrings[4] = Tcl_NewIntObj(resolvedPid);
-            *errorObjPtr = Tcl_NewListObj(5, errorStrings);
-        }
-        return TCL_PROCESS_UNKNOWN_STATUS;
+	/*
+	 * TCL OPERATION EXEC ODDWAITRESULT
+	 *
+	 * Child wait status didn't make sense.
+	 */
+
+	if (codePtr) *codePtr = waitStatus;
+	if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
+		"child wait status didn't make sense\n", -1);
+	if (errorObjPtr) {
+	    errorStrings[0] = Tcl_NewStringObj("TCL", -1);
+	    errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
+	    errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
+	    errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
+	    errorStrings[4] = Tcl_NewIntObj(resolvedPid);
+	    *errorObjPtr = Tcl_NewListObj(5, errorStrings);
+	}
+	return TCL_PROCESS_UNKNOWN_STATUS;
     }
 }
 
-/* FRED TODO */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildProcessStatusObj --
+ *
+ *	Build a list object with process status. The first element is always
+ *	a standard Tcl return value, which can be either TCL_OK or TCL_ERROR.
+ *	In the latter case, the second element is the error message and the
+ *	third element is a Tcl error code (see tclvars).
+ *
+ * Results:
+ *	A list object.
+ *
+ * Side effects:
+ *	Tcl_Objs are created.
+ *
+ *----------------------------------------------------------------------
+ */
+
 Tcl_Obj *
 BuildProcessStatusObj(
     ProcessInfo *info)
@@ -261,18 +360,18 @@ BuildProcessStatusObj(
     Tcl_Obj *resultObjs[3];
 
     if (info->status == TCL_PROCESS_UNCHANGED) {
-        /*
-         * Process still running, return empty obj.
-         */
+	/*
+	 * Process still running, return empty obj.
+	 */
 
-        return Tcl_NewObj();
+	return Tcl_NewObj();
     }
     if (info->status == TCL_PROCESS_EXITED && info->code == 0) {
-        /*
-         * Normal exit, return TCL_OK.
-         */
-        
-        return Tcl_NewIntObj(TCL_OK);
+	/*
+	 * Normal exit, return TCL_OK.
+	 */
+	
+	return Tcl_NewIntObj(TCL_OK);
     }
 
     /*
@@ -290,13 +389,13 @@ BuildProcessStatusObj(
  * ProcessListObjCmd --
  *
  *	This function implements the 'tcl::process list' Tcl command. 
- *      Refer to the user documentation for details on what it does.
+ *	Refer to the user documentation for details on what it does.
  *
  * Results:
  *	Returns a standard Tcl result.
  *
  * Side effects:
- *	None.FRED TODO
+ *	Access to the internal structures is protected by infoTablesMutex.
  *
  *----------------------------------------------------------------------
  */
@@ -325,10 +424,10 @@ ProcessListObjCmd(
     list = Tcl_NewListObj(0, NULL);
     Tcl_MutexLock(&infoTablesMutex);
     for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
-            entry != NULL; entry = Tcl_NextHashEntry(&search)) {
-        info = (ProcessInfo *) Tcl_GetHashValue(entry);
-        Tcl_ListObjAppendElement(interp, list, 
-                Tcl_NewIntObj(info->resolvedPid));
+	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+	info = (ProcessInfo *) Tcl_GetHashValue(entry);
+	Tcl_ListObjAppendElement(interp, list, 
+		Tcl_NewIntObj(info->resolvedPid));
     }
     Tcl_MutexUnlock(&infoTablesMutex);
     Tcl_SetObjResult(interp, list);
@@ -340,13 +439,14 @@ ProcessListObjCmd(
  * ProcessStatusObjCmd --
  *
  *	This function implements the 'tcl::process status' Tcl command. 
- *      Refer to the user documentation for details on what it does.
+ *	Refer to the user documentation for details on what it does.
  *
  * Results:
  *	Returns a standard Tcl result.
  *
  * Side effects:
- *	None.FRED TODO
+ *	Access to the internal structures is protected by infoTablesMutex.
+ *	Calls RefreshProcessInfo, which can block if -wait switch is given.
  *
  *----------------------------------------------------------------------
  */
@@ -375,7 +475,7 @@ ProcessStatusObjCmd(
     enum switches {
 	STATUS_WAIT, STATUS_LAST
     };
-    
+
     while (objc > 1) {
 	if (TclGetString(objv[1])[0] != '-') {
 	    break;
@@ -391,93 +491,93 @@ ProcessStatusObjCmd(
 	    break;
 	}
     }
-    
+
     if (objc != 1 && objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?");
 	return TCL_ERROR;
     }
 
     if (objc == 1) {
-        /*
-        * Return a dict with all child process statuses.
-        */
-
-        dict = Tcl_NewDictObj();
-        Tcl_MutexLock(&infoTablesMutex);
-        for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
-                entry != NULL; entry = Tcl_NextHashEntry(&search)) {
-            info = (ProcessInfo *) Tcl_GetHashValue(entry);
-            RefreshProcessInfo(info, options);
-
-            if (info->purge && autopurge) {
-                /*
-                 * Purge entry.
-                 */
-                
-                Tcl_DeleteHashEntry(entry);
-                entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
-                Tcl_DeleteHashEntry(entry);
-                FreeProcessInfo(info);
-            } else {
-                /*
-                 * Add to result.
-                 */
-
-                Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), 
-                        BuildProcessStatusObj(info));
-            }
-        }
-        Tcl_MutexUnlock(&infoTablesMutex);
+	/*
+	* Return a dict with all child process statuses.
+	*/
+
+	dict = Tcl_NewDictObj();
+	Tcl_MutexLock(&infoTablesMutex);
+	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
+		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
+	    RefreshProcessInfo(info, options);
+
+	    if (info->purge && autopurge) {
+		/*
+		 * Purge entry.
+		 */
+		
+		Tcl_DeleteHashEntry(entry);
+		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+		Tcl_DeleteHashEntry(entry);
+		FreeProcessInfo(info);
+	    } else {
+		/*
+		 * Add to result.
+		 */
+
+		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), 
+			BuildProcessStatusObj(info));
+	    }
+	}
+	Tcl_MutexUnlock(&infoTablesMutex);
     } else {
-        /*
-         * Only return statuses of provided processes.
-         */
-        
-        result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
-        if (result != TCL_OK) {
-            return result;
-        }
-        dict = Tcl_NewDictObj();
-        Tcl_MutexLock(&infoTablesMutex);
-        for (i = 0; i < numPids; i++) {
-            result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
-            if (result != TCL_OK) {
-                Tcl_MutexUnlock(&infoTablesMutex);
-                Tcl_DecrRefCount(dict);
-                return result;
-            }
-
-            entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
-            if (!entry) {
-                /*
-                 * Skip unknown process.
-                 */
-                
-                continue;
-            }
-            
-            info = (ProcessInfo *) Tcl_GetHashValue(entry);
-            RefreshProcessInfo(info, options);
-
-            if (info->purge && autopurge) {
-                /*
-                 * Purge entry.
-                 */
-                
-                Tcl_DeleteHashEntry(entry);
-                entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
-                Tcl_DeleteHashEntry(entry);
-                FreeProcessInfo(info);
-            } else {
-                /*
-                 * Add to result.
-                 */
-
-                Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), 
-                        BuildProcessStatusObj(info));
-            }
-        }
-        Tcl_MutexUnlock(&infoTablesMutex);
+	/*
+	 * Only return statuses of provided processes.
+	 */
+	
+	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	dict = Tcl_NewDictObj();
+	Tcl_MutexLock(&infoTablesMutex);
+	for (i = 0; i < numPids; i++) {
+	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
+	    if (result != TCL_OK) {
+		Tcl_MutexUnlock(&infoTablesMutex);
+		Tcl_DecrRefCount(dict);
+		return result;
+	    }
+
+	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
+	    if (!entry) {
+		/*
+		 * Skip unknown process.
+		 */
+		
+		continue;
+	    }
+	    
+	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
+	    RefreshProcessInfo(info, options);
+
+	    if (info->purge && autopurge) {
+		/*
+		 * Purge entry.
+		 */
+		
+		Tcl_DeleteHashEntry(entry);
+		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+		Tcl_DeleteHashEntry(entry);
+		FreeProcessInfo(info);
+	    } else {
+		/*
+		 * Add to result.
+		 */
+
+		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), 
+			BuildProcessStatusObj(info));
+	    }
+	}
+	Tcl_MutexUnlock(&infoTablesMutex);
     }
     Tcl_SetObjResult(interp, dict);
     return TCL_OK;
@@ -488,13 +588,13 @@ ProcessStatusObjCmd(
  * ProcessPurgeObjCmd --
  *
  *	This function implements the 'tcl::process purge' Tcl command. 
- *      Refer to the user documentation for details on what it does.
+ *	Refer to the user documentation for details on what it does.
  *
  * Results:
  *	Returns a standard Tcl result.
  *
  * Side effects:
- *	None.FRED TODO
+ *	Frees all ProcessInfo structures with their purge flag set.
  *
  *----------------------------------------------------------------------
  */
@@ -525,61 +625,61 @@ ProcessPurgeObjCmd(
      */
 
     Tcl_ReapDetachedProcs();
-    
+
     if (objc == 1) {
-        /*
-         * Purge all terminated processes.
-         */
-
-        Tcl_MutexLock(&infoTablesMutex);
-        for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
-                entry != NULL; entry = Tcl_NextHashEntry(&search)) {
-            info = (ProcessInfo *) Tcl_GetHashValue(entry);
-            if (info->purge) {
-                Tcl_DeleteHashEntry(entry);
-                entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
-                Tcl_DeleteHashEntry(entry);
-                FreeProcessInfo(info);
-            }
-        }
-        Tcl_MutexUnlock(&infoTablesMutex);
+	/*
+	 * Purge all terminated processes.
+	 */
+
+	Tcl_MutexLock(&infoTablesMutex);
+	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
+		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
+	    if (info->purge) {
+		Tcl_DeleteHashEntry(entry);
+		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+		Tcl_DeleteHashEntry(entry);
+		FreeProcessInfo(info);
+	    }
+	}
+	Tcl_MutexUnlock(&infoTablesMutex);
     } else {
-        /*
-         * Purge only provided processes.
-         */
-        
-        result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
-        if (result != TCL_OK) {
-            return result;
-        }
-        Tcl_MutexLock(&infoTablesMutex);
-        for (i = 0; i < numPids; i++) {
-            result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
-            if (result != TCL_OK) {
-                Tcl_MutexUnlock(&infoTablesMutex);
-                return result;
-            }
-
-            entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
-            if (!entry) {
-                /*
-                 * Skip unknown process.
-                 */
-                
-                continue;
-            }
-
-            info = (ProcessInfo *) Tcl_GetHashValue(entry);
-            if (info->purge) {
-                Tcl_DeleteHashEntry(entry);
-                entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
-                Tcl_DeleteHashEntry(entry);
-                FreeProcessInfo(info);
-            }
-        }
-        Tcl_MutexUnlock(&infoTablesMutex);
+	/*
+	 * Purge only provided processes.
+	 */
+	
+	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	Tcl_MutexLock(&infoTablesMutex);
+	for (i = 0; i < numPids; i++) {
+	    result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
+	    if (result != TCL_OK) {
+		Tcl_MutexUnlock(&infoTablesMutex);
+		return result;
+	    }
+
+	    entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
+	    if (!entry) {
+		/*
+		 * Skip unknown process.
+		 */
+		
+		continue;
+	    }
+
+	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
+	    if (info->purge) {
+		Tcl_DeleteHashEntry(entry);
+		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+		Tcl_DeleteHashEntry(entry);
+		FreeProcessInfo(info);
+	    }
+	}
+	Tcl_MutexUnlock(&infoTablesMutex);
     }
-    
+
     return TCL_OK;
 }
 
@@ -588,7 +688,7 @@ ProcessPurgeObjCmd(
  * ProcessAutopurgeObjCmd --
  *
  *	This function implements the 'tcl::process autopurge' Tcl command. 
- *      Refer to the user documentation for details on what it does.
+ *	Refer to the user documentation for details on what it does.
  *
  * Results:
  *	Returns a standard Tcl result.
@@ -612,17 +712,17 @@ ProcessAutopurgeObjCmd(
     }
 
     if (objc == 2) {
-        /*
-         * Set given value.
-         */
-        
-        int flag;
-        int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
-        if (result != TCL_OK) {
-            return result;
-        }
-
-        autopurge = !!flag;
+	/*
+	 * Set given value.
+	 */
+	
+	int flag;
+	int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
+	if (result != TCL_OK) {
+	    return result;
+	}
+
+	autopurge = !!flag;
     }
 
     /* 
@@ -655,11 +755,11 @@ TclInitProcessCmd(
     Tcl_Interp *interp)		/* Current interpreter. */
 {
     static const EnsembleImplMap processImplMap[] = {
-        {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
-        {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
-        {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
-        {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
-        {NULL, NULL, NULL, NULL, NULL, 0}
+	{"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
+	{"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
+	{"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
+	{"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
+	{NULL, NULL, NULL, NULL, NULL, 0}
     };
     Tcl_Command processCmd;
 
@@ -672,20 +772,35 @@ TclInitProcessCmd(
 	}
 	Tcl_MutexUnlock(&infoTablesMutex);
     }
-    
+
     processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap);
     Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
-            "process", 0);
+	    "process", 0);
     return processCmd;
 }
 
-/* FRED TODO */
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcessCreated --
+ *
+ *	Called when a child process has been created by Tcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Internal structures are updated with a new ProcessInfo.
+ *
+ *----------------------------------------------------------------------
+ */
+
 void
 TclProcessCreated(
-    Tcl_Pid pid)
+    Tcl_Pid pid)		/* Process id. */
 {
     int resolvedPid;
-    Tcl_HashEntry *entry;
+    Tcl_HashEntry *entry, *entry2;
     int isNew;
     ProcessInfo *info;
 
@@ -694,7 +809,7 @@ TclProcessCreated(
      */
 
     resolvedPid = TclpGetPid(pid);
-     
+
     Tcl_MutexLock(&infoTablesMutex);
 
     /*
@@ -703,12 +818,15 @@ TclProcessCreated(
 
     entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew);
     if (!isNew) {
-        /*
-         * Pid was reused, free old info and reuse structure.
-         */
-        
-        info = (ProcessInfo *) Tcl_GetHashValue(entry);
-        FreeProcessInfo(info);
+	/*
+	 * Pid was reused, free old info and reuse structure.
+	 */
+	
+	info = (ProcessInfo *) Tcl_GetHashValue(entry);
+	entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid, 
+		INT2PTR(resolvedPid));
+	if (entry2) Tcl_DeleteHashEntry(entry2);
+	FreeProcessInfo(info);
     }
 
     /*
@@ -717,32 +835,53 @@ TclProcessCreated(
 
     info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo));
     InitProcessInfo(info, pid, resolvedPid);
-    
+
     /*
      * Add entry to tables.
      */
 
     Tcl_SetHashValue(entry, info);
     entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid),
-            &isNew);
+	    &isNew);
     Tcl_SetHashValue(entry, info);
-    
+
     Tcl_MutexUnlock(&infoTablesMutex);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcessWait --
+ *
+ *	Wait for process status to change.
+ *
+ * Results:
+ *	TclProcessWaitStatus enum value.
+ *
+ * Side effects:
+ *	Completed process info structures are purged immediately (autopurge on)
+ *	or eventually (autopurge off).
+ *
+ *----------------------------------------------------------------------
+ */
 
-/* FRED TODO */
 TclProcessWaitStatus
 TclProcessWait(
-    Tcl_Pid pid,
-    int options,
-    int *codePtr,
-    Tcl_Obj **msgObjPtr,
-    Tcl_Obj **errorObjPtr)
+    Tcl_Pid pid,		/* Process id. */
+    int options,		/* Options passed to WaitProcessStatus. */
+    int *codePtr,		/* If non-NULL, will receive either:
+				 *  - 0 for normal exit.
+				 *  - errno in case of error.
+				 *  - non-zero exit code for abormal exit.
+				 *  - signal number if killed or suspended.
+				 *  - Tcl_WaitPid status in all other cases.
+				 */
+    Tcl_Obj **msgObjPtr,	/* If non-NULL, will receive error message. */
+    Tcl_Obj **errorObjPtr)	/* If non-NULL, will receive error code. */
 {
     Tcl_HashEntry *entry;
     ProcessInfo *info;
-    int result;
+    TclProcessWaitStatus result;
 
     /*
      * First search for pid in table.
@@ -750,34 +889,34 @@ TclProcessWait(
 
     entry = Tcl_FindHashEntry(&infoTablePerPid, pid);
     if (!entry) {
-        /*
-         * Unknown process, just call WaitProcessStatus and return.
-         */
-        
-        result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, 
-                msgObjPtr, errorObjPtr);
-        if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
-        if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
-        return result;
+	/*
+	 * Unknown process, just call WaitProcessStatus and return.
+	 */
+	
+	result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, 
+		msgObjPtr, errorObjPtr);
+	if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
+	if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
+	return result;
     }
 
     info = (ProcessInfo *) Tcl_GetHashValue(entry);
     if (info->purge) {
-        /*
-         * Process has completed but TclProcessWait has already been called,
-         * so report no change.
-         */
-        
-        return TCL_PROCESS_UNCHANGED;
+	/*
+	 * Process has completed but TclProcessWait has already been called,
+	 * so report no change.
+	 */
+	
+	return TCL_PROCESS_UNCHANGED;
     }
 
     RefreshProcessInfo(info, options);
     if (info->status == TCL_PROCESS_UNCHANGED) {
-        /*
-         * No change, stop there.
-         */
-        
-        return TCL_PROCESS_UNCHANGED;
+	/*
+	 * No change, stop there.
+	 */
+	
+	return TCL_PROCESS_UNCHANGED;
     }
 
     /*
@@ -792,22 +931,22 @@ TclProcessWait(
     if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
 
     if (autopurge) {
-        /*
-         * Purge now.
-         */
-
-        Tcl_DeleteHashEntry(entry);
-        entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, 
-                INT2PTR(info->resolvedPid));
-        Tcl_DeleteHashEntry(entry);
-        FreeProcessInfo(info);
+	/*
+	 * Purge now.
+	 */
+
+	Tcl_DeleteHashEntry(entry);
+	entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, 
+		INT2PTR(info->resolvedPid));
+	Tcl_DeleteHashEntry(entry);
+	FreeProcessInfo(info);
     } else {
-        /*
-         * Eventually purge. Subsequent calls will return
-         * TCL_PROCESS_UNCHANGED.
-         */
+	/*
+	 * Eventually purge. Subsequent calls will return
+	 * TCL_PROCESS_UNCHANGED.
+	 */
 
-        info->purge = 1;
+	info->purge = 1;
     }
     return result;
 }