/*
*----------------------------------------------------------------------
*
* Nsf_PointerAdd --
*
* Add an entry to our locally maintained hash table and set its
* value to the provided valuePtr. The keys are generated based on
* the passed type and the counter obtained from the type
* registration.
*
* Results:
* Tcl result code
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Nsf_PointerAdd(Tcl_Interp *interp, char *buffer, size_t size, const char *typeName, void *valuePtr) {
int *counterPtr;
nonnull_assert(interp != NULL);
nonnull_assert(buffer != NULL);
nonnull_assert(typeName != NULL);
nonnull_assert(valuePtr != NULL);
counterPtr = Nsf_PointerTypeLookup(typeName);
if (counterPtr != NULL) {
Tcl_DString ds, *dsPtr = &ds;
Tcl_HashEntry *hPtr;
int isNew;
Tcl_DStringInit(dsPtr);
Tcl_DStringAppend(dsPtr, typeName, -1);
Tcl_DStringAppend(dsPtr, ":%d", 3);
NsfMutexLock(&pointerMutex);
snprintf(buffer, size, Tcl_DStringValue(dsPtr), (*counterPtr)++);
hPtr = Tcl_CreateHashEntry(pointerHashTablePtr, buffer, &isNew);
NsfMutexUnlock(&pointerMutex);
Tcl_SetHashValue(hPtr, valuePtr);
/*fprintf(stderr, "Nsf_PointerAdd key '%s' prefix '%s' => %p value %p\n", buffer, typeName, hPtr, valuePtr);*/
Tcl_DStringFree(dsPtr);
} else {
return NsfPrintError(interp, "no type converter for %s registered", typeName);
}
return TCL_OK;
}
/*
** The "p" argument points to a <select>. This routine scans all
** subsequent elements (up to the next </select>) looking for
** <option> tags. For each option tag, it appends three elements
** to the "str" DString:
**
** * 1 or 0 to indicated whether or not the element is
** selected.
**
** * The value returned if this element is selected.
**
** * The text displayed for this element.
*/
static void AddSelectOptions(
Tcl_DString *str, /* Add text here */
HtmlElement *p, /* The <SELECT> markup */
HtmlElement *pEnd /* The </SELECT> markup */
){
while( p && p!=pEnd && p->base.type!=Html_EndSELECT ){
if( p->base.type==Html_OPTION ){
char *zValue;
Tcl_DStringStartSublist(str);
if( HtmlMarkupArg(p, "selected", 0)==0 ){
Tcl_DStringAppend(str, "0 ", 2);
}else{
Tcl_DStringAppend(str, "1 ", 2);
}
zValue = HtmlMarkupArg(p, "value", "");
Tcl_DStringAppendElement(str, zValue);
Tcl_DStringStartSublist(str);
p = p->pNext;
while( p && p!=pEnd && p->base.type!=Html_EndOPTION
&& p->base.type!=Html_OPTION && p->base.type!=Html_EndSELECT ){
if( p->base.type==Html_Text ){
Tcl_DStringAppend(str, p->text.zText, -1);
}else if( p->base.type==Html_Space ){
Tcl_DStringAppend(str, " ", 1);
}
p = p->pNext;
}
Tcl_DStringEndSublist(str);
Tcl_DStringEndSublist(str);
}else{
p = p->pNext;
}
}
}
Tcl_PackageInitProc *
TclpFindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
CONST char *symbol)
{
Tcl_DString newName;
Tcl_PackageInitProc *proc = NULL;
shl_t handle = (shl_t)loadHandle;
/*
* Some versions of the HP system software still use "_" at the beginning
* of exported symbols while others don't; try both forms of each name.
*/
if (shl_findsym(&handle, symbol, (short) TYPE_PROCEDURE,
(void *) &proc) != 0) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
Tcl_DStringAppend(&newName, symbol, -1);
if (shl_findsym(&handle, Tcl_DStringValue(&newName),
(short) TYPE_PROCEDURE, (void *) &proc) != 0) {
proc = NULL;
}
Tcl_DStringFree(&newName);
}
return proc;
}
int NS(ProcCheck) (
Tcl_Interp * interp,
struct Tcl_Obj * cmdObj,
char const * const wrongNrStr
)
{
int ret,len;
Tcl_DString cmd;
if (!Tcl_GetCommandFromObj (interp, cmdObj)) {
Tcl_WrongNumArgs (interp, 0, NULL, wrongNrStr);
return TCL_ERROR;
}
Tcl_DStringInit(&cmd);
Tcl_DStringAppendElement(&cmd,"info");
Tcl_DStringAppendElement(&cmd,"args");
Tcl_DStringAppendElement(&cmd,Tcl_GetString(cmdObj));
ret = Tcl_EvalEx(interp, Tcl_DStringValue(&cmd), Tcl_DStringLength(&cmd), TCL_EVAL_GLOBAL);
Tcl_DStringFree(&cmd);
TclErrorCheck(ret);
TclErrorCheck(Tcl_ListObjLength(interp, Tcl_GetObjResult(interp), &len));
if (len != 1) {
Tcl_DString msg;
Tcl_DStringInit(&msg);
Tcl_DStringAppend(&msg,"wrong # args: ", -1);
if (len > 1) Tcl_DStringAppend(&msg,"only ", -1);
Tcl_DStringAppend(&msg,"one argument for procedure \"", -1);
Tcl_DStringAppend(&msg,Tcl_GetString(cmdObj), -1);
Tcl_DStringAppend(&msg,"\" is required", -1);
Tcl_DStringResult(interp, &msg);
Tcl_DStringFree(&msg);
return TCL_ERROR;
}
return TCL_OK;
}
static void StateSpecUpdateString(Tcl_Obj *objPtr)
{
unsigned int onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
unsigned int offbits = objPtr->internalRep.longValue & 0x0000FFFF;
unsigned int mask = onbits | offbits;
Tcl_DString result;
int i, len;
Tcl_DStringInit(&result);
for (i=0; stateNames[i] != NULL; ++i) {
if (mask & (1<<i)) {
if (offbits & (1<<i))
Tcl_DStringAppend(&result, "!", 1);
Tcl_DStringAppend(&result, stateNames[i], -1);
Tcl_DStringAppend(&result, " ", 1);
}
}
len = Tcl_DStringLength(&result);
if (len) {
/* 'len' includes extra trailing ' ' */
objPtr->bytes = Tcl_Alloc((unsigned)len);
objPtr->length = len-1;
strncpy(objPtr->bytes, Tcl_DStringValue(&result), (size_t)len-1);
objPtr->bytes[len-1] = '\0';
} else {
/* empty string */
objPtr->length = 0;
objPtr->bytes = Tcl_Alloc(1);
*objPtr->bytes = '\0';
}
Tcl_DStringFree(&result);
}
void
TnmSnmpDumpPDU(Tcl_Interp *interp, TnmSnmpPdu *pdu)
{
if (hexdump) {
int i, code, argc;
const char **argv;
char *name, *status;
char buffer[80];
Tcl_DString dst;
Tcl_Channel channel;
Tcl_DStringInit(&dst);
name = TnmGetTableValue(tnmSnmpPDUTable, (unsigned) pdu->type);
if (name == NULL) {
name = "(unknown PDU type)";
}
status = TnmGetTableValue(tnmSnmpErrorTable, (unsigned) pdu->errorStatus);
if (status == NULL) {
status = "(unknown error code)";
}
if (pdu->type == ASN1_SNMP_GETBULK) {
sprintf(buffer, "%s %d non-repeaters %d max-repetitions %d\n",
name, pdu->requestId,
pdu->errorStatus, pdu->errorIndex);
} else if (pdu->type == ASN1_SNMP_TRAP1) {
sprintf(buffer, "%s\n", name);
} else if (pdu->errorStatus == TNM_SNMP_NOERROR) {
sprintf(buffer, "%s %d %s\n", name, pdu->requestId, status);
} else {
sprintf(buffer, "%s %d %s at %d\n",
name, pdu->requestId, status, pdu->errorIndex);
}
Tcl_DStringAppend(&dst, buffer, -1);
code = Tcl_SplitList(interp, Tcl_DStringValue(&pdu->varbind),
&argc, &argv);
if (code == TCL_OK) {
for (i = 0; i < argc; i++) {
sprintf(buffer, "%4d.\t", i+1);
Tcl_DStringAppend(&dst, buffer, -1);
Tcl_DStringAppend(&dst, argv[i], -1);
Tcl_DStringAppend(&dst, "\n", -1);
}
ckfree((char *) argv);
}
Tcl_ResetResult(interp);
channel = Tcl_GetStdChannel(TCL_STDOUT);
if (channel) {
Tcl_Write(channel,
Tcl_DStringValue(&dst), Tcl_DStringLength(&dst));
}
Tcl_DStringFree(&dst);
}
}
Tcl_PackageInitProc *
TclpFindSymbol(
Tcl_Interp *interp, /* Place to put error messages. */
Tcl_LoadHandle loadHandle, /* Value from TcpDlopen(). */
const char *symbol) /* Symbol to look up. */
{
const char *native;
Tcl_DString newName, ds;
void *handle = (void *) loadHandle;
Tcl_PackageInitProc *proc;
/*
* Some platforms still add an underscore to the beginning of symbol
* names. If we can't find a name without an underscore, try again with
* the underscore.
*/
native = Tcl_UtfToExternalDString(NULL, symbol, -1, &ds);
proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
native);
if (proc == NULL) {
Tcl_DStringInit(&newName);
Tcl_DStringAppend(&newName, "_", 1);
native = Tcl_DStringAppend(&newName, native, -1);
proc = (Tcl_PackageInitProc *) dlsym(handle, /* INTL: Native. */
native);
Tcl_DStringFree(&newName);
}
Tcl_DStringFree(&ds);
return proc;
}
void
Ns_ThreadList(Tcl_DString *dsPtr, Ns_ThreadArgProc *proc)
{
Thread *thrPtr;
char buf[100];
Ns_MutexLock(&threadlock);
thrPtr = firstThreadPtr;
while (thrPtr != NULL) {
Tcl_DStringStartSublist(dsPtr);
Tcl_DStringAppendElement(dsPtr, thrPtr->name);
Tcl_DStringAppendElement(dsPtr, thrPtr->parent);
sprintf(buf, " %d %d %ld", thrPtr->tid,
(thrPtr->flags & FLAG_DETACHED) ? NS_THREAD_DETACHED : 0,
thrPtr->ctime.sec);
Tcl_DStringAppend(dsPtr, buf, -1);
if (proc != NULL) {
(*proc)(dsPtr, (void *) thrPtr->proc, thrPtr->arg);
} else {
sprintf(buf, " %p %p", thrPtr->proc, thrPtr->arg);
Tcl_DStringAppend(dsPtr, buf, -1);
}
Tcl_DStringEndSublist(dsPtr);
thrPtr = thrPtr->nextPtr;
}
Ns_MutexUnlock(&threadlock);
}
Tcl_PackageInitProc *
TclpFindSymbol(
Tcl_Interp *interp,
Tcl_LoadHandle loadHandle,
const char *symbol)
{
Tcl_PackageInitProc *proc = NULL;
HINSTANCE handle = (HINSTANCE)loadHandle;
/*
* For each symbol, check for both Symbol and _Symbol, since Borland
* generates C symbols with a leading '_' by default.
*/
proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
if (proc == NULL) {
Tcl_DString ds;
Tcl_DStringInit(&ds);
Tcl_DStringAppend(&ds, "_", 1);
symbol = Tcl_DStringAppend(&ds, symbol, -1);
proc = (Tcl_PackageInitProc *) GetProcAddress(handle, symbol);
Tcl_DStringFree(&ds);
}
return proc;
}
/*
** Append to the given DString, an encoded version of the given
** text.
*/
static void EncodeText(Tcl_DString *str, char *z){
int i;
while( *z ){
for(i=0; z[i] && !NeedToEscape(z[i]); i++){ TestPoint(0); }
if( i>0 ){ TestPoint(0); Tcl_DStringAppend(str, z, i); }
z += i;
while( *z && NeedToEscape(*z) ){
if( *z==' ' ){
Tcl_DStringAppend(str,"+",1);
TestPoint(0);
}else if( *z=='\n' ){
Tcl_DStringAppend(str, "%0D%0A", 6);
TestPoint(0);
}else if( *z=='\r' ){
/* Ignore it... */
TestPoint(0);
}else{
char zBuf[5];
sprintf(zBuf,"%%%02X",0xff & *z);
Tcl_DStringAppend(str, zBuf, 3);
TestPoint(0);
}
z++;
}
}
}
const int processOneZoneInOneFile(Tcl_DString* const dsptr, const char* const catalogFullName, const int offset, const int numberOfLines,
const searchZoneWfibc* const mySearchZoneWfibc) {
int lineNumber;
char oneLine[1024];
int raDeg, raMin, decDeg, decMin;
double raSec, decSec, ra, dec, errRa, errDec;
double pmRa, pmDec, errPmRa, errPmDec, jd;
double magR, errMagR;
FILE* const inputStream = fopen(catalogFullName,"rt");
if(inputStream == NULL) {
sprintf(outputLogChar,"File %s not found\n",catalogFullName);
return(1);
}
if(fseek(inputStream,offset,SEEK_SET)) {
sprintf(outputLogChar,"Can not move by %d in %s\n",offset,catalogFullName);
return(1);
}
//printf("Process %s\n",catalogFullName);
/* Read numberOfLines and output those satisfying the search box */
for(lineNumber = 0; lineNumber < numberOfLines; lineNumber++) {
if(fgets(oneLine,1024,inputStream) == NULL) {
sprintf(outputLogChar,"Can not read line from %s\n",catalogFullName);
return(1);
}
//printf("oneLine = %s\n",oneLine);
sscanf(oneLine,CATALOG_LINE_FORMAT,&raDeg, &raMin, &raSec, &decDeg, &decMin, &decSec, &errRa, &errDec,
&jd, &pmRa, &pmDec, &errPmRa, &errPmDec, &magR, &errMagR);
ra = 15. * (raDeg + raMin / 60. + raSec / 3600.);
if(decDeg < 0) {
dec = decDeg - decMin / 60. - decSec / 3600.;
} else {
dec = decDeg + decMin / 60. + decSec / 3600.;
}
if(
((mySearchZoneWfibc->subSearchZone.isArroundZeroRa && ((ra >= mySearchZoneWfibc->subSearchZone.raStartInDeg) || (ra <= mySearchZoneWfibc->subSearchZone.raEndInDeg))) ||
(!mySearchZoneWfibc->subSearchZone.isArroundZeroRa && ((ra >= mySearchZoneWfibc->subSearchZone.raStartInDeg) && (ra <= mySearchZoneWfibc->subSearchZone.raEndInDeg)))) &&
(dec >= mySearchZoneWfibc->subSearchZone.decStartInDeg) &&
(dec <= mySearchZoneWfibc->subSearchZone.decEndInDeg) &&
(magR >= mySearchZoneWfibc->magnitudeBox.magnitudeStartInMag) &&
(magR <= mySearchZoneWfibc->magnitudeBox.magnitudeEndInMag)) {
Tcl_DStringAppend(dsptr,"{ { WFIBC { } {",-1);
sprintf(outputLogChar,"%.6f %.6f %.3f %.3f %.8f %.3f %.3f %.3f %.3f %.3f %.3f", ra, dec, errRa, errDec, jd, pmRa, pmDec, errPmRa, errPmDec, magR, errMagR);
Tcl_DStringAppend(dsptr,outputLogChar,-1);
Tcl_DStringAppend(dsptr,"} } } ",-1);
}
}
fclose(inputStream);
return(0);
}
/* Append all text and space tokens between pStart and pEnd to
** the given Tcl_DString.
*/
static void HtmlAppendText(
Tcl_DString *str, /* Append the text here */
HtmlElement *pFirst, /* The first token */
HtmlElement *pEnd /* The last token */
){
while( pFirst && pFirst!=pEnd ){
switch( pFirst->base.type ){
case Html_Text: {
Tcl_DStringAppend(str, pFirst->text.zText, -1);
break;
}
case Html_Space: {
if( pFirst->base.flags & HTML_NewLine ){
Tcl_DStringAppend(str, "\n", 1);
}else{
int cnt;
static char zSpaces[] = " ";
cnt = pFirst->base.count;
while( cnt>sizeof(zSpaces)-1 ){
Tcl_DStringAppend(str, zSpaces, sizeof(zSpaces)-1);
cnt -= sizeof(zSpaces)-1;
}
if( cnt>0 ){
Tcl_DStringAppend(str, zSpaces, cnt);
}
}
break;
}
default:
/* Do nothing */
break;
}
pFirst = pFirst->pNext;
}
}
const char *
TkpGetString(
TkWindow *winPtr, /* Window where event occurred: needed to get
* input context. */
XEvent *eventPtr, /* X keyboard event. */
Tcl_DString *dsPtr) /* Uninitialized or empty string to hold
* result. */
{
XKeyEvent *keyEv = &eventPtr->xkey;
Tcl_DStringInit(dsPtr);
if (keyEv->send_event == -1) {
if (keyEv->nbytes > 0) {
Tcl_ExternalToUtfDString(TkWinGetKeyInputEncoding(),
keyEv->trans_chars, keyEv->nbytes, dsPtr);
}
} else if (keyEv->send_event == -2) {
/*
* Special case for win2000 multi-lingal IME input. xkey.trans_chars[]
* already contains a UNICODE char.
*/
int unichar;
char buf[TCL_UTF_MAX];
int len;
unichar = keyEv->trans_chars[1] & 0xff;
unichar <<= 8;
unichar |= keyEv->trans_chars[0] & 0xff;
len = Tcl_UniCharToUtf((Tcl_UniChar) unichar, buf);
Tcl_DStringAppend(dsPtr, buf, len);
} else if (keyEv->send_event == -3) {
/*
* Special case for WM_UNICHAR. xkey.trans_chars[] already contains a
* UTF-8 char.
*/
Tcl_DStringAppend(dsPtr, keyEv->trans_chars, keyEv->nbytes);
} else {
/*
* This is an event generated from generic code. It has no nchars or
* trans_chars members.
*/
KeySym keysym = KeycodeToKeysym(keyEv->keycode, keyEv->state, 0);
if (((keysym != NoSymbol) && (keysym > 0) && (keysym < 256))
|| (keysym == XK_Return) || (keysym == XK_Tab)) {
char buf[TCL_UTF_MAX];
int len;
len = Tcl_UniCharToUtf((Tcl_UniChar) (keysym & 255), buf);
Tcl_DStringAppend(dsPtr, buf, len);
}
}
return Tcl_DStringValue(dsPtr);
}
static HRESULT
RegisterInterp(
const char *name,
RegisteredInterp *riPtr)
{
HRESULT hr = S_OK;
LPRUNNINGOBJECTTABLE pROT = NULL;
LPMONIKER pmk = NULL;
int i, offset;
const char *actualName = name;
Tcl_DString dString;
Tcl_DStringInit(&dString);
hr = GetRunningObjectTable(0, &pROT);
if (SUCCEEDED(hr)) {
offset = 0;
for (i = 1; SUCCEEDED(hr); i++) {
if (i > 1) {
if (i == 2) {
Tcl_DStringInit(&dString);
Tcl_DStringAppend(&dString, name, -1);
Tcl_DStringAppend(&dString, " #", 2);
offset = Tcl_DStringLength(&dString);
Tcl_DStringSetLength(&dString, offset+TCL_INTEGER_SPACE);
actualName = Tcl_DStringValue(&dString);
}
sprintf(Tcl_DStringValue(&dString) + offset, "%d", i);
}
hr = BuildMoniker(actualName, &pmk);
if (SUCCEEDED(hr)) {
hr = pROT->lpVtbl->Register(pROT,
ROTFLAGS_REGISTRATIONKEEPSALIVE,
riPtr->obj, pmk, &riPtr->cookie);
pmk->lpVtbl->Release(pmk);
}
if (hr == MK_S_MONIKERALREADYREGISTERED) {
pROT->lpVtbl->Revoke(pROT, riPtr->cookie);
} else if (hr == S_OK) {
break;
}
}
pROT->lpVtbl->Release(pROT);
}
if (SUCCEEDED(hr)) {
riPtr->name = strdup(actualName);
}
Tcl_DStringFree(&dString);
return hr;
}
static char *
MakeFolderEnvVar(
char * prefixTag, /* Prefix added before result. */
long whichFolder) /* Constant for FSpFindFolder. */
{
char * thePath = NULL;
char * result = NULL;
OSErr theErr = noErr;
Handle theString = NULL;
FSSpec theFolder;
int size;
Tcl_DString pathStr;
Tcl_DString tagPathStr;
Tcl_DStringInit(&pathStr);
theErr = FSpFindFolder(kOnSystemDisk, whichFolder,
kDontCreateFolder, &theFolder);
if (theErr == noErr) {
theErr = FSpPathFromLocation(&theFolder, &size, &theString);
HLock(theString);
tclPlatform = TCL_PLATFORM_MAC;
Tcl_DStringAppend(&pathStr, *theString, -1);
HUnlock(theString);
DisposeHandle(theString);
Tcl_DStringInit(&tagPathStr);
Tcl_DStringAppend(&tagPathStr, prefixTag, strlen(prefixTag));
Tcl_DStringAppend(&tagPathStr, pathStr.string, pathStr.length);
Tcl_DStringFree(&pathStr);
/*
* Make sure the path ends with a ':'
*/
if (tagPathStr.string[tagPathStr.length - 1] != ':') {
Tcl_DStringAppend(&tagPathStr, ":", 1);
}
/*
* Don't free tagPathStr - rather make sure it's allocated
* and return it as the result.
*/
if (tagPathStr.string == tagPathStr.staticSpace) {
result = (char *) ckalloc(tagPathStr.length + 1);
strcpy(result, tagPathStr.string);
} else {
result = tagPathStr.string;
}
} else {
result = (char *) ckalloc(strlen(prefixTag) + 1);
strcpy(result, prefixTag);
}
return result;
}
int lexinput_tktext(char *buf, int max_size, int buf_size, void *index1, void *index2)
{
int length, nbytes;
Tcl_DString internal, temp;
static int first = 1;
static Tcl_DString external;
static Tcl_Encoding encoding;
if(first) {
/* The lexers require ASCII encoding. */
encoding = Tcl_GetEncoding(NULL, "ascii");
if(encoding == NULL) {
/* No ASCII encoding available. */
return 0;
}
Tcl_DStringInit(&external);
first = 0;
}
Tcl_DStringInit(&internal);
if(Tcl_DStringLength(&external) == 0) {
/* Translate the text to `external'. */
if(tk_text_buffer(&internal, buf_size, index1, index2) > 0) {
Tcl_UtfToExternalDString(encoding, Tcl_DStringValue(&internal), Tcl_DStringLength(&internal), &external);
} else {
return 0;
}
}
/* Fill up the user-provided buffer as much as possible. */
length = Tcl_DStringLength(&external);
nbytes = (length > max_size) ? max_size : length;
memcpy(buf, Tcl_DStringValue(&external), nbytes);
/* I wish DStrings had a copy constructor. In fact, sometimes I wish
Tcl was written in C++. */
if(length > nbytes) {
Tcl_DStringInit(&temp);
Tcl_DStringAppend(&temp, Tcl_DStringValue(&external) + nbytes, length - nbytes);
Tcl_DStringFree(&external);
Tcl_DStringInit(&external);
Tcl_DStringAppend(&external, Tcl_DStringValue(&temp), Tcl_DStringLength(&temp));
Tcl_DStringFree(&temp);
} else {
Tcl_DStringFree(&external);
Tcl_DStringInit(&external);
}
/* Clean up. */
Tcl_DStringFree(&internal);
return nbytes;
}
int ScriptTcl::Tcl_print(ClientData,
Tcl_Interp *, int argc, char *argv[]) {
Tcl_DString msg;
Tcl_DStringInit(&msg);
for ( int i = 1; i < argc; ++i ) {
Tcl_DStringAppend(&msg," ",-1);
Tcl_DStringAppend(&msg,argv[i],-1);
}
CkPrintf("TCL:%s\n",Tcl_DStringValue(&msg));
Tcl_DStringFree(&msg);
return TCL_OK;
}
/* Provide mechanism for simulator to report which instructions are in
which stages */
void report_pc(unsigned fpc, unsigned char fpcv,
unsigned dpc, unsigned char dpcv,
unsigned epc, unsigned char epcv,
unsigned mpc, unsigned char mpcv,
unsigned wpc, unsigned char wpcv)
{
int status;
char addr[10];
char code[12];
Tcl_DString cmd;
Tcl_DStringInit(&cmd);
Tcl_DStringAppend(&cmd, "simLabel ", -1);
Tcl_DStringStartSublist(&cmd);
if (fpcv) {
sprintf(addr, "%u", fpc);
Tcl_DStringAppendElement(&cmd, addr);
}
if (dpcv) {
sprintf(addr, "%u", dpc);
Tcl_DStringAppendElement(&cmd, addr);
}
if (epcv) {
sprintf(addr, "%u", epc);
Tcl_DStringAppendElement(&cmd, addr);
}
if (mpcv) {
sprintf(addr, "%u", mpc);
Tcl_DStringAppendElement(&cmd, addr);
}
if (wpcv) {
sprintf(addr, "%u", wpc);
Tcl_DStringAppendElement(&cmd, addr);
}
Tcl_DStringEndSublist(&cmd);
Tcl_DStringStartSublist(&cmd);
sprintf(code, "%s %s %s %s %s",
fpcv ? "F" : "",
dpcv ? "D" : "",
epcv ? "E" : "",
mpcv ? "M" : "",
wpcv ? "W" : "");
Tcl_DStringAppend(&cmd, code, -1);
Tcl_DStringEndSublist(&cmd);
/* Debug
fprintf(stderr, "Code '%s'\n", Tcl_DStringValue(&cmd));
*/
status = Tcl_Eval(sim_interp, Tcl_DStringValue(&cmd));
if (status != TCL_OK) {
fprintf(stderr, "Failed to report pipe code '%s'\n", code);
fprintf(stderr, "Error Message was '%s'\n", sim_interp->result);
}
}
int ScriptTcl::Tcl_abort(ClientData,
Tcl_Interp *, int argc, char *argv[]) {
Tcl_DString msg;
Tcl_DStringInit(&msg);
Tcl_DStringAppend(&msg,"TCL:",-1);
for ( int i = 1; i < argc; ++i ) {
Tcl_DStringAppend(&msg," ",-1);
Tcl_DStringAppend(&msg,argv[i],-1);
}
NAMD_die(Tcl_DStringValue(&msg));
Tcl_DStringFree(&msg);
return TCL_OK;
}
int Blt_TextLayoutValue( TextLayout *textPtr, Tcl_DString *dStr) {
register TextFragment *fragPtr;
register int i;
fragPtr = textPtr->fragArr;
for (i = 0; i < textPtr->nFrags; i++, fragPtr++) {
if (i) {
Tcl_DStringAppend(dStr, "\n", -1);
}
Tcl_DStringAppend(dStr, fragPtr->text, fragPtr->count);
}
return i;
}
/*-----------------------------------------------------------------------------
* FormatTrapCode --
* Format the signal name into the signal trap command. Replacing %S with
* the signal name.
*
* Parameters:
* o interp (I/O) - The interpreter to return errors in.
* o signalNum - The signal number of the signal that occured.
* o command - The resulting command adter the formatting.
*-----------------------------------------------------------------------------
*/
static int
FormatTrapCode (Tcl_Interp *interp, int signalNum, Tcl_DString *command)
{
char *copyPtr, *scanPtr;
Tcl_DStringInit (command);
copyPtr = scanPtr = signalTrapCmds [signalNum];
while (*scanPtr != '\0') {
if (*scanPtr != '%') {
scanPtr++;
continue;
}
if (scanPtr [1] == '%') {
scanPtr += 2;
continue;
}
Tcl_DStringAppend (command, copyPtr, (scanPtr - copyPtr));
switch (scanPtr [1]) {
case 'S': {
Tcl_DStringAppend (command, GetSignalName (signalNum), -1);
break;
}
default:
goto badSpec;
}
scanPtr += 2;
copyPtr = scanPtr;
}
Tcl_DStringAppend (command, copyPtr, copyPtr - scanPtr);
return TCL_OK;
/*
* Handle bad % specification currently pointed to by scanPtr.
*/
badSpec:
{
char badSpec [2];
badSpec [0] = scanPtr [1];
badSpec [1] = '\0';
TclX_AppendObjResult (interp, "bad signal trap command formatting ",
"specification \"%", badSpec,
"\", expected one of \"%%\" or \"%S\"",
(char *) NULL);
return TCL_ERROR;
}
}
/* warnings are not processed in TCL */
static void
TifWarning(const char *routine, const char *fmt, va_list ap)
{
char string[BUFSIZ+4];
int length;
length = vsnprintf(string, BUFSIZ, fmt, ap);
if (length > BUFSIZ) {
strcat(string, "...");
}
Tcl_DStringAppend(&tifMessagePtr->warnings, string, -1);
Tcl_DStringAppend(&tifMessagePtr->warnings, "\n", -1);
tifMessagePtr->nWarnings++;
}
static void expandPercentsEval(Tcl_Interp * interp, /* interpreter context */
register char *before, /* Command with percent expressions */
char *r, /* vgpaneHandle string to substitute for "%r" */
int npts, /* number of coordinates */
point * ppos /* Cordinates to substitute for %t */
)
{
register char *string;
Tcl_DString scripts;
Tcl_DStringInit(&scripts);
while (1) {
/*
* Find everything up to the next % character and append it to the
* result string.
*/
for (string = before; (*string != 0) && (*string != '%'); string++) {
/* Empty loop body. */
}
if (string != before) {
Tcl_DStringAppend(&scripts, before, string - before);
before = string;
}
if (*before == 0) {
break;
}
/*
* There's a percent sequence here. Process it.
*/
switch (before[1]) {
case 'r':
Tcl_DStringAppend(&scripts, r, strlen(r)); /* vgcanvasHandle */
break;
case 't':
dgsprintxy(&scripts, npts, ppos);
break;
default:
Tcl_DStringAppend(&scripts, before + 1, 1);
break;
}
before += 2;
}
if (Tcl_GlobalEval(interp, Tcl_DStringValue(&scripts)) != TCL_OK)
fprintf(stderr, "%s while in binding: %s\n\n",
Tcl_GetStringResult(interp), Tcl_DStringValue(&scripts));
Tcl_DStringFree(&scripts);
}
const char *
TclGetEnv(
const char *name, /* Name of environment variable to find
* (UTF-8). */
Tcl_DString *valuePtr) /* Uninitialized or free DString in which the
* value of the environment variable is
* stored. */
{
int length, index;
const char *result;
Tcl_MutexLock(&envMutex);
index = TclpFindVariable(name, &length);
result = NULL;
if (index != -1) {
Tcl_DString envStr;
result = Tcl_ExternalToUtfDString(NULL, environ[index], -1, &envStr);
result += length;
if (*result == '=') {
result++;
Tcl_DStringInit(valuePtr);
Tcl_DStringAppend(valuePtr, result, -1);
result = Tcl_DStringValue(valuePtr);
} else {
result = NULL;
}
Tcl_DStringFree(&envStr);
}
Tcl_MutexUnlock(&envMutex);
return result;
}
int ScriptTcl::Tcl_replicaSendrecv(ClientData, Tcl_Interp *interp, int argc, char **argv) {
if ( argc < 3 || argc > 4 ) {
Tcl_SetResult(interp,"args: data dest ?source?",TCL_VOLATILE);
return TCL_ERROR;
}
Tcl_DString recvstr;
Tcl_DStringInit(&recvstr);
int sendcount = strlen(argv[1]);
int recvcount = 0;
int dest = atoi(argv[2]);
int source = -1;
if ( argc > 3 ) source = atoi(argv[3]);
#if CMK_HAS_PARTITION
if (dest == CmiMyPartition()) {
Tcl_DStringSetLength(&recvstr,sendcount);
memcpy(Tcl_DStringValue(&recvstr),argv[1],sendcount);
} else {
DataMessage *recvMsg = NULL;
replica_sendRecv(argv[1], sendcount, dest, CkMyPe(), &recvMsg, source, CkMyPe());
CmiAssert(recvMsg != NULL);
Tcl_DStringAppend(&recvstr, recvMsg->data, recvMsg->size);
CmiFree(recvMsg);
}
#endif
Tcl_DStringResult(interp, &recvstr);
Tcl_DStringFree(&recvstr);
return TCL_OK;
}
static void
DumpPercents(
QE_ExpandArgs *args, /* %-substitution args. */
QE_ExpandProc proc, /* Function to return value for a given
* %-char. */
CONST char *chars /* NULL-terminated list of %-chars. */
)
{
char which = args->which;
char buf[2];
int i;
buf[1] = '\0';
Tcl_DStringStartSublist(args->result);
for (i = 0; chars[i]; i++) {
args->which = chars[i];
buf[0] = chars[i];
Tcl_DStringAppendElement(args->result, buf);
Tcl_DStringAppend(args->result, " ", 1);
(*proc)(args);
}
Tcl_DStringEndSublist(args->result);
args->which = which;
}
static int
TraversalDelete(
char *src, /* Source pathname. */
char *ignore, /* Destination pathname (not used). */
DWORD srcAttr, /* File attributes for src (not used). */
int type, /* Reason for call - see TraverseWinTree(). */
Tcl_DString *errorPtr) /* If non-NULL, initialized DString for
* error return. */
{
switch (type) {
case DOTREE_F:
if (TclpDeleteFile(src) == TCL_OK) {
return TCL_OK;
}
break;
case DOTREE_PRED:
return TCL_OK;
case DOTREE_POSTD:
if (TclpRemoveDirectory(src, 0, NULL) == TCL_OK) {
return TCL_OK;
}
break;
}
if (errorPtr != NULL) {
Tcl_DStringAppend(errorPtr, src, -1);
}
return TCL_ERROR;
}
void
AppendObj (Tcl_DString * const dsPtr, Tcl_Obj * const objPtr)
{
int length;
char const *bytes = Tcl_GetStringFromObj (objPtr, &length);
Tcl_DStringAppend (dsPtr, bytes, length);
}
/*
** Return all tokens between the two elements as a Text.
*/
void HtmlTclizeAscii(Tcl_Interp *interp, HtmlIndex *s, HtmlIndex *e){
int j, nsub=0;
HtmlElement* p=s->p;
Tcl_DString str;
if (p && p->base.type==Html_Text) {
nsub=s->i;
}
Tcl_DStringInit(&str);
while( p) {
switch( p->base.type ){
case Html_Block:
break;
case Html_Text:
j=strlen(p->text.zText);
if (j<nsub) nsub=j;
if (p==e->p) {
j= (e->i-nsub+1);
}
Tcl_DStringAppend(&str, p->text.zText+nsub,j-nsub);
nsub=0;
break;
case Html_Space:
for (j=0; j< p->base.count; j++) {
if (nsub-->0) continue;
Tcl_DStringAppend(&str, " ", 1);
}
if ((p->base.flags & HTML_NewLine)!=0)
Tcl_DStringAppend(&str, "\n",1);
nsub=0;
break;
case Html_P:
case Html_BR:
Tcl_DStringAppend(&str, "\n",1);
break;
case Html_Unknown:
break;
default:
break;
}
if (p==e->p) break;
p = p->pNext;
}
Tcl_DStringResult(interp, &str);
}
static void tout_update_stream(int fd, const char *buf, int header,
const char *tag) {
char * win;
char tag_list[1024];
if (!win_init) {
#ifdef _WIN32
/* WINNT will not have stdout/err defined unless running in console mode
* so use a message box
*/
if( fileno(stdout) == -1 || fileno(stderr) == -1 ){
MessageBox(NULL,buf,"Error",MB_OK|MB_ICONERROR|MB_TASKMODAL);
return;
}
#endif
fprintf(fd == 1 ? stdout : stderr, "%s", buf);
fflush(fd == 1 ? stdout : stderr);
return;
}
win = fd == 1 ? stdout_win : stderr_win;
/* Add to the redirection streams */
if (fd == 1 && stdout_fp) {
fprintf(stdout_fp, "%s", buf);
fflush(stdout_fp);
} else if (fd == 2 && stderr_fp) {
fprintf(stderr_fp, "%s", buf);
fflush(stderr_fp);
}
if (info_win) {
Tcl_DStringAppend(&message, buf, strlen(buf));
}
if (tag) {
sprintf(tag_list, "{%s%s %s}",
cur_tag, header ? "_h" : "_t",
tag);
} else {
sprintf(tag_list, "%s%s", cur_tag, header ? "_h" : "_t");
}
/* Add to the text widget */
if (win_init) {
Tcl_SetVar(_interp, "TEMP", buf, 0);
Tcl_VarEval(_interp, win, " insert end ", "\"$TEMP\" ",
tag_list, NULL);
if (fd == 1 ? stdout_scroll : stderr_scroll) {
/* scroll to bottom of output window */
Tcl_VarEval(_interp, win, " see end", NULL);
}
}
}
