tclwindde.c

这是leon3处理器的交叉编译链

			"request ?-binary? serviceName topicName value");
		return TCL_ERROR;
	    }
	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeReqOptions, "option", 0,
		    &argIndex) != TCL_OK) {
		if (objc != 5) {
		    Tcl_WrongNumArgs(interp, 1, objv,
			    "request ?-binary? serviceName topicName value");
		    return TCL_ERROR;
		}
		binary = 0;
		firstArg = 2;
	    } else {
		if (objc != 6) {
		    Tcl_WrongNumArgs(interp, 1, objv,
			    "request ?-binary? serviceName topicName value");
		    return TCL_ERROR;
		}
		binary = 1;
		firstArg = 3;
	    }
	    break;
	case DDE_SERVICES:
	    if (objc != 4) {
		Tcl_WrongNumArgs(interp, 1, objv,
			"services serviceName topicName");
		return TCL_ERROR;
	    }
	    firstArg = 2;
	    break;
	case DDE_EVAL:
	    if (objc < 4) {
		Tcl_WrongNumArgs(interp, 1, objv, 
			"eval ?-async? serviceName args");
		return TCL_ERROR;
	    }
	    if (Tcl_GetIndexFromObj(NULL, objv[2], ddeOptions, "option", 0,
		    &argIndex) != TCL_OK) {
		if (objc < 4) {
		    Tcl_WrongNumArgs(interp, 1, objv,
			    "eval ?-async? serviceName args");
		    return TCL_ERROR;
		}
		async = 0;
		firstArg = 2;
	    } else {
		if (objc < 5) {
		    Tcl_WrongNumArgs(interp, 1, objv,
			    "eval ?-async? serviceName args");
		    return TCL_ERROR;
		}
		async = 1;
		firstArg = 3;
	    }
	    break;
    }

    Initialize();

    if (firstArg != 1) {
	serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
    } else {
	length = 0;
    }

    if (length == 0) {
	serviceName = NULL;
    } else if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
	ddeService = DdeCreateStringHandle(ddeInstance, serviceName,
		CP_WINANSI);
    }

    if ((index != DDE_SERVERNAME) &&(index != DDE_EVAL)) {
	topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
	if (length == 0) {
	    topicName = NULL;
	} else {
	    ddeTopic = DdeCreateStringHandle(ddeInstance, 
		    topicName, CP_WINANSI);
	}
    }

    switch (index) {
	case DDE_SERVERNAME: {
	    serviceName = DdeSetServerName(interp, serviceName);
	    if (serviceName != NULL) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			serviceName, -1);
	    } else {
		Tcl_ResetResult(interp);
	    }
	    break;
	}
	case DDE_EXECUTE: {
	    dataString = Tcl_GetStringFromObj(objv[firstArg + 2], &dataLength);
	    if (dataLength == 0) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			"cannot execute null data", -1);
		result = TCL_ERROR;
		break;
	    }
	    hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	    DdeFreeStringHandle(ddeInstance, ddeService);
	    DdeFreeStringHandle(ddeInstance, ddeTopic);

	    if (hConv == NULL) {
		SetDdeError(interp);
		result = TCL_ERROR;
		break;
	    }

	    ddeData = DdeCreateDataHandle(ddeInstance, dataString,
		    dataLength+1, 0, 0, CF_TEXT, 0);
	    if (ddeData != NULL) {
		if (async) {
		    DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF, hConv, 0, 
			    CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		    DdeAbandonTransaction(ddeInstance, hConv, 
			    ddeResult);
		} else {
		    ddeReturn = DdeClientTransaction((LPBYTE) ddeData, 0xFFFFFFFF,
			    hConv, 0, CF_TEXT, XTYP_EXECUTE, 30000, NULL);
		    if (ddeReturn == 0) {
			SetDdeError(interp);
			result = TCL_ERROR;
		    }
		}
		DdeFreeDataHandle(ddeData);
	    } else {
		SetDdeError(interp);
		result = TCL_ERROR;
	    }
	    break;
	}
	case DDE_REQUEST: {
	    itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
	    if (length == 0) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			"cannot request value of null data", -1);
		return TCL_ERROR;
	    }
	    hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	    DdeFreeStringHandle(ddeInstance, ddeService);
	    DdeFreeStringHandle(ddeInstance, ddeTopic);
	    
	    if (hConv == NULL) {
		SetDdeError(interp);
		result = TCL_ERROR;
	    } else {
		Tcl_Obj *returnObjPtr;
		ddeItem = DdeCreateStringHandle(ddeInstance, 
                        itemString, CP_WINANSI);
		if (ddeItem != NULL) {
		    ddeData = DdeClientTransaction(NULL, 0, hConv, ddeItem,
			    CF_TEXT, XTYP_REQUEST, 5000, NULL);
		    if (ddeData == NULL) {
			SetDdeError(interp);
			result = TCL_ERROR;
		    } else {
			dataString = DdeAccessData(ddeData, &dataLength);
			if (binary) {
			    returnObjPtr = Tcl_NewByteArrayObj(dataString,
				    dataLength);
			} else {
			    returnObjPtr = Tcl_NewStringObj(dataString, -1);
			}
			DdeUnaccessData(ddeData);
			DdeFreeDataHandle(ddeData);
			Tcl_SetObjResult(interp, returnObjPtr);
		    }
		} else {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		}
	    }

	    break;
	}
	case DDE_POKE: {
	    itemString = Tcl_GetStringFromObj(objv[firstArg + 2], &length);
	    if (length == 0) {
		Tcl_SetStringObj(Tcl_GetObjResult(interp),
			"cannot have a null item", -1);
		return TCL_ERROR;
	    }
	    dataString = Tcl_GetStringFromObj(objv[firstArg + 3], &length);
	    
	    hConv = DdeConnect(ddeInstance, ddeService, ddeTopic, NULL);
	    DdeFreeStringHandle(ddeInstance, ddeService);
	    DdeFreeStringHandle(ddeInstance, ddeTopic);

	    if (hConv == NULL) {
		SetDdeError(interp);
		result = TCL_ERROR;
	    } else {
		ddeItem = DdeCreateStringHandle(ddeInstance, itemString,
			CP_WINANSI);
		if (ddeItem != NULL) {
		    ddeData = DdeClientTransaction(dataString,length+1,
			    hConv, ddeItem, CF_TEXT, XTYP_POKE, 5000, NULL);
		    if (ddeData == NULL) {
			SetDdeError(interp);
			result = TCL_ERROR;
		    }
		} else {
		    SetDdeError(interp);
		    result = TCL_ERROR;
		}
	    }
	    break;
	}

	case DDE_SERVICES: {
	    HCONVLIST hConvList;
	    CONVINFO convInfo;
	    Tcl_Obj *convListObjPtr, *elementObjPtr;
	    Tcl_DString dString;
	    char *name;
	    
	    convInfo.cb = sizeof(CONVINFO);
	    hConvList = DdeConnectList(ddeInstance, ddeService, 
                    ddeTopic, 0, NULL);
	    DdeFreeStringHandle(ddeInstance,ddeService);
	    DdeFreeStringHandle(ddeInstance, ddeTopic);
	    hConv = 0;
	    convListObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
	    Tcl_DStringInit(&dString);

	    while (hConv = DdeQueryNextServer(hConvList, hConv), hConv != 0) {
		elementObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
		DdeQueryConvInfo(hConv, QID_SYNC, &convInfo);
		length = DdeQueryString(ddeInstance, 
                        convInfo.hszSvcPartner, NULL, 0, CP_WINANSI);
		Tcl_DStringSetLength(&dString, length);
		name = Tcl_DStringValue(&dString);
		DdeQueryString(ddeInstance, convInfo.hszSvcPartner, 
                        name, length + 1, CP_WINANSI);
		Tcl_ListObjAppendElement(interp, elementObjPtr,
			Tcl_NewStringObj(name, length));
		length = DdeQueryString(ddeInstance, convInfo.hszTopic,
			NULL, 0, CP_WINANSI);
		Tcl_DStringSetLength(&dString, length);
		name = Tcl_DStringValue(&dString);
		DdeQueryString(ddeInstance, convInfo.hszTopic, name,
			length + 1, CP_WINANSI);
		Tcl_ListObjAppendElement(interp, elementObjPtr,
			Tcl_NewStringObj(name, length));
		Tcl_ListObjAppendElement(interp, convListObjPtr,
			elementObjPtr);
	    }
	    DdeDisconnectList(hConvList);
	    Tcl_SetObjResult(interp, convListObjPtr);
	    Tcl_DStringFree(&dString);
	    break;
	}
	case DDE_EVAL: {
	    objc -= (async + 3);
	    ((Tcl_Obj **) objv) += (async + 3);

            /*
	     * See if the target interpreter is local.  If so, execute
	     * the command directly without going through the DDE server.
	     * Don't exchange objects between interps.  The target interp could
	     * compile an object, producing a bytecode structure that refers to 
	     * other objects owned by the target interp.  If the target interp 
	     * is then deleted, the bytecode structure would be referring to 
	     * deallocated objects.
	     */
	    
	    for (riPtr = tsdPtr->interpListPtr; riPtr != NULL;
		 riPtr = riPtr->nextPtr) {
		if (stricmp(serviceName, riPtr->name) == 0) {
		    break;
		}
	    }

	    if (riPtr != NULL) {
		/*
		 * This command is to a local interp. No need to go through
		 * the server.
		 */
		
		Tcl_Preserve((ClientData) riPtr);
		sendInterp = riPtr->interp;
		Tcl_Preserve((ClientData) sendInterp);
		
		/*
		 * Don't exchange objects between interps.  The target interp
		 * would compile an object, producing a bytecode structure that
		 * refers to other objects owned by the target interp.  If the
		 * target interp is then deleted, the bytecode structure would
		 * be referring to deallocated objects.
		 */

		if (objc == 1) {
		    result = Tcl_EvalObjEx(sendInterp, objv[0],
			    TCL_EVAL_GLOBAL);
		} else {
		    objPtr = Tcl_ConcatObj(objc, objv);
		    Tcl_IncrRefCount(objPtr);
		    result = Tcl_EvalObjEx(sendInterp, objPtr,
			    TCL_EVAL_GLOBAL);
		    Tcl_DecrRefCount(objPtr);
		}
		if (interp != sendInterp) {
		    if (result == TCL_ERROR) {
			/*
			 * An error occurred, so transfer error information
			 * from the destination interpreter back to our
			 * interpreter.
			 */
			
			Tcl_ResetResult(interp);
			objPtr = Tcl_GetVar2Ex(sendInterp, "errorInfo", NULL, 
				TCL_GLOBAL_ONLY);
			string = Tcl_GetStringFromObj(objPtr, &length);
			Tcl_AddObjErrorInfo(interp, string, length);
			
			objPtr = Tcl_GetVar2Ex(sendInterp, "errorCode", NULL,
				TCL_GLOBAL_ONLY);
			Tcl_SetObjErrorCode(interp, objPtr);
		    }
		    Tcl_SetObjResult(interp, Tcl_GetObjResult(sendInterp));
		}
		Tcl_Release((ClientData) riPtr);
		Tcl_Release((ClientData) sendInterp);
	    } else {
		/*
		 * This is a non-local request. Send the script to the server
		 * and poll it for a result.
		 */
		
		if (MakeDdeConnection(interp, serviceName, &hConv) != TCL_OK) {
		    goto error;
		}
		
		objPtr = Tcl_ConcatObj(objc, objv);
		string = Tcl_GetStringFromObj(objPtr, &length);
		ddeItemData = DdeCreateDataHandle(ddeInstance, string,
			length+1, 0, 0, CF_TEXT, 0);
		
		if (async) {
		    ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
			    0xFFFFFFFF, hConv, 0,
			    CF_TEXT, XTYP_EXECUTE, TIMEOUT_ASYNC, &ddeResult);
		    DdeAbandonTransaction(ddeInstance, hConv, ddeResult);
		} else {
		    ddeData = DdeClientTransaction((LPBYTE) ddeItemData,
			    0xFFFFFFFF, hConv, 0,
			    CF_TEXT, XTYP_EXECUTE, 30000, NULL);
		    if (ddeData != 0) {
			
			ddeCookie = DdeCreateStringHandle(ddeInstance, 
				"$TCLEVAL$EXECUTE$RESULT", CP_WINANSI);
			ddeData = DdeClientTransaction(NULL, 0, hConv,
				ddeCookie, CF_TEXT, XTYP_REQUEST, 30000, NULL);
		    }
		}

		Tcl_DecrRefCount(objPtr);
		
		if (ddeData == 0) {
		    SetDdeError(interp);
		    goto errorNoResult;
		}
		
		if (async == 0) {
		    Tcl_Obj *resultPtr;
		    
		    /*
		     * The return handle has a two or four element list in
		     * it. The first element is the return code (TCL_OK,
		     * TCL_ERROR, etc.). The second is the result of the
		     * script. If the return code is TCL_ERROR, then the third
		     * element is the value of the variable "errorCode", and
		     * the fourth is the value of the variable "errorInfo".
		     */
		    
		    resultPtr = Tcl_NewObj();
		    length = DdeGetData(ddeData, NULL, 0, 0);
		    Tcl_SetObjLength(resultPtr, length);
		    string = Tcl_GetString(resultPtr);
		    DdeGetData(ddeData, string, length, 0);
		    Tcl_SetObjLength(resultPtr, strlen(string));
		    
		    if (Tcl_ListObjIndex(NULL, resultPtr, 0, &objPtr)
			    != TCL_OK) {
			Tcl_DecrRefCount(resultPtr);
			goto error;
		    }
		    if (Tcl_GetIntFromObj(NULL, objPtr, &result) != TCL_OK) {
			Tcl_DecrRefCount(resultPtr);
			goto error;
		    }
		    if (result == TCL_ERROR) {
			Tcl_ResetResult(interp);

			if (Tcl_ListObjIndex(NULL, resultPtr, 3, &objPtr)
				!= TCL_OK) {
			    Tcl_DecrRefCount(resultPtr);
			    goto error;
			}
			length = -1;
			string = Tcl_GetStringFromObj(objPtr, &length);
			Tcl_AddObjErrorInfo(interp, string, length);
			
			Tcl_ListObjIndex(NULL, resultPtr, 2, &objPtr);
			Tcl_SetObjErrorCode(interp, objPtr);
		    }
		    if (Tcl_ListObjIndex(NULL, resultPtr, 1, &objPtr)
			    != TCL_OK) {
			Tcl_DecrRefCount(resultPtr);
			goto error;
		    }
		    Tcl_SetObjResult(interp, objPtr);
		    Tcl_DecrRefCount(resultPtr);
		}
	    }
	}
    }
    if (ddeCookie != NULL) {
	DdeFreeStringHandle(ddeInstance, ddeCookie);
    }
    if (ddeItem != NULL) {
	DdeFreeStringHandle(ddeInstance, ddeItem);
    }
    if (ddeItemData != NULL) {
	DdeFreeDataHandle(ddeItemData);
    }
    if (ddeData != NULL) {
	DdeFreeDataHandle(ddeData);
    }
    if (hConv != NULL) {
	DdeDisconnect(hConv);
    }
    return result;

    error:
    Tcl_SetStringObj(Tcl_GetObjResult(interp),
	    "invalid data returned from server", -1);

    errorNoResult:
    if (ddeCookie != NULL) {
	DdeFreeStringHandle(ddeInstance, ddeCookie);
    }
    if (ddeItem != NULL) {
	DdeFreeStringHandle(ddeInstance, ddeItem);
    }
    if (ddeItemData != NULL) {
	DdeFreeDataHandle(ddeItemData);
    }
    if (ddeData != NULL) {
	DdeFreeDataHandle(ddeData);
    }
    if (hConv != NULL) {
	DdeDisconnect(hConv);
    }
    return TCL_ERROR;
}