globle char *GetLogicalName(
void *theEnv,
int whichArgument,
char *defaultLogicalName)
{
char *logicalName;
DATA_OBJECT result;
EnvRtnUnknown(theEnv,whichArgument,&result);
if ((GetType(result) == SYMBOL) ||
(GetType(result) == STRING) ||
(GetType(result) == INSTANCE_NAME))
{
logicalName = ValueToString(result.value);
if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
{ logicalName = defaultLogicalName; }
}
else if (GetType(result) == FLOAT)
{
logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result))));
}
else if (GetType(result) == INTEGER)
{
logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result))));
}
else
{ logicalName = NULL; }
return(logicalName);
}
const char *GetLogicalName(
UDFContext *context,
const char *defaultLogicalName)
{
Environment *theEnv = context->environment;
const char *logicalName;
UDFValue theArg;
if (! UDFNextArgument(context,ANY_TYPE_BITS,&theArg))
{ return NULL; }
if (CVIsType(&theArg,LEXEME_BITS) ||
CVIsType(&theArg,INSTANCE_NAME_BIT))
{
logicalName = theArg.lexemeValue->contents;
if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
{ logicalName = defaultLogicalName; }
}
else if (CVIsType(&theArg,FLOAT_BIT))
{
logicalName = CreateSymbol(theEnv,FloatToString(theEnv,theArg.floatValue->contents))->contents;
}
else if (CVIsType(&theArg,INTEGER_BIT))
{
logicalName = CreateSymbol(theEnv,LongIntegerToString(theEnv,theArg.integerValue->contents))->contents;
}
else
{ logicalName = NULL; }
return(logicalName);
}
globle const char *DataObjectToString(
void *theEnv,
DATA_OBJECT *theDO)
{
void *thePtr;
const char *theString;
char *newString;
const char *prefix, *postfix;
size_t length;
struct externalAddressHashNode *theAddress;
char buffer[30];
switch (GetpType(theDO))
{
case MULTIFIELD:
prefix = "(";
theString = ValueToString(ImplodeMultifield(theEnv,theDO));
postfix = ")";
break;
case STRING:
prefix = "\"";
theString = DOPToString(theDO);
postfix = "\"";
break;
case INSTANCE_NAME:
prefix = "[";
theString = DOPToString(theDO);
postfix = "]";
break;
case SYMBOL:
return(DOPToString(theDO));
case FLOAT:
return(FloatToString(theEnv,DOPToDouble(theDO)));
case INTEGER:
return(LongIntegerToString(theEnv,DOPToLong(theDO)));
case RVOID:
return("");
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
thePtr = DOPToPointer(theDO);
if (thePtr == (void *) &InstanceData(theEnv)->DummyInstance)
{ return("<Dummy Instance>"); }
if (((struct instance *) thePtr)->garbage)
{
prefix = "<Stale Instance-";
theString = ValueToString(((struct instance *) thePtr)->name);
postfix = ">";
}
else
{
prefix = "<Instance-";
theString = ValueToString(GetFullInstanceName(theEnv,(INSTANCE_TYPE *) thePtr));
postfix = ">";
}
break;
#endif
case EXTERNAL_ADDRESS:
theAddress = (struct externalAddressHashNode *) DOPToPointer(theDO);
/* TBD Need specific routine for creating name string. */
gensprintf(buffer,"<Pointer-%d-%p>",(int) theAddress->type,DOPToExternalAddress(theDO));
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS:
if (DOPToPointer(theDO) == (void *) &FactData(theEnv)->DummyFact)
{ return("<Dummy Fact>"); }
thePtr = DOPToPointer(theDO);
gensprintf(buffer,"<Fact-%lld>",((struct fact *) thePtr)->factIndex);
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#endif
default:
return("UNK");
}
length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1;
newString = (char *) genalloc(theEnv,length);
newString[0] = '\0';
genstrcat(newString,prefix);
genstrcat(newString,theString);
genstrcat(newString,postfix);
thePtr = EnvAddSymbol(theEnv,newString);
genfree(theEnv,newString,length);
return(ValueToString(thePtr));
}
static void StrOrSymCatFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue,
unsigned short returnType)
{
DATA_OBJECT theArg;
int numArgs, i, total, j;
char *theString;
SYMBOL_HN **arrayOfStrings;
SYMBOL_HN *hashPtr;
char *functionName;
/*============================================*/
/* Determine the calling function name. */
/* Store the null string or the symbol nil as */
/* the return value in the event of an error. */
/*============================================*/
SetpType(returnValue,returnType);
if (returnType == STRING)
{
functionName = "str-cat";
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
}
else
{
functionName = "sym-cat";
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil"));
}
/*===============================================*/
/* Determine the number of arguments as create a */
/* string array which is large enough to store */
/* the string representation of each argument. */
/*===============================================*/
numArgs = EnvRtnArgCount(theEnv);
arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs);
for (i = 0; i < numArgs; i++)
{ arrayOfStrings[i] = NULL; }
/*=============================================*/
/* Evaluate each argument and store its string */
/* representation in the string array. */
/*=============================================*/
total = 1;
for (i = 1 ; i <= numArgs ; i++)
{
EnvRtnUnknown(theEnv,i,&theArg);
switch(GetType(theArg))
{
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
case SYMBOL:
hashPtr = (SYMBOL_HN *) GetValue(theArg);
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
case FLOAT:
hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg))));
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
case INTEGER:
hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg))));
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
default:
ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer");
SetEvaluationError(theEnv,TRUE);
break;
}
if (EvaluationData(theEnv)->EvaluationError)
{
for (i = 0; i < numArgs; i++)
{
if (arrayOfStrings[i] != NULL)
{ DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
}
rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
return;
}
total += (int) strlen(ValueToString(arrayOfStrings[i - 1]));
}
/*=========================================================*/
/* Allocate the memory to store the concatenated string or */
/* symbol, then copy the values in the string array to the */
/* memory just allocated. */
/*=========================================================*/
theString = (char *) gm2(theEnv,(sizeof(char) * total));
j = 0;
for (i = 0 ; i < numArgs ; i++)
{
sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i]));
j += (int) strlen(ValueToString(arrayOfStrings[i]));
}
/*=========================================*/
/* Return the concatenated value and clean */
/* up the temporary memory used. */
/*=========================================*/
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString));
rm(theEnv,theString,sizeof(char) * total);
for (i = 0; i < numArgs; i++)
{
if (arrayOfStrings[i] != NULL)
{ DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
}
rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
}
globle void *ImplodeMultifield(
void *theEnv,
DATA_OBJECT *value)
{
size_t strsize = 0;
long i, j;
const char *tmp_str;
char *ret_str;
void *rv;
struct multifield *theMultifield;
DATA_OBJECT tempDO;
/*===================================================*/
/* Determine the size of the string to be allocated. */
/*===================================================*/
theMultifield = (struct multifield *) GetpValue(value);
for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++)
{
if (GetMFType(theMultifield,i) == FLOAT)
{
tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
strsize += strlen(tmp_str) + 1;
}
else if (GetMFType(theMultifield,i) == INTEGER)
{
tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
strsize += strlen(tmp_str) + 1;
}
else if (GetMFType(theMultifield,i) == STRING)
{
strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3;
tmp_str = ValueToString(GetMFValue(theMultifield,i));
while(*tmp_str)
{
if (*tmp_str == '"')
{ strsize++; }
else if (*tmp_str == '\\') /* GDR 111599 #835 */
{ strsize++; } /* GDR 111599 #835 */
tmp_str++;
}
}
#if OBJECT_SYSTEM
else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
{ strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; }
else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
{ strsize += strlen(ValueToString(((INSTANCE_TYPE *)
GetMFValue(theMultifield,i))->name)) + 3; }
#endif
else
{
SetType(tempDO,GetMFType(theMultifield,i));
SetValue(tempDO,GetMFValue(theMultifield,i));
strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1;
}
}
/*=============================================*/
/* Allocate the string and copy all components */
/* of the MULTIFIELD variable to it. */
/*=============================================*/
if (strsize == 0) return(EnvAddSymbol(theEnv,""));
ret_str = (char *) gm2(theEnv,strsize);
for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++)
{
/*============================*/
/* Convert numbers to strings */
/*============================*/
if (GetMFType(theMultifield,i) == FLOAT)
{
tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
}
else if (GetMFType(theMultifield,i) == INTEGER)
{
tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
}
/*=======================================*/
/* Enclose strings in quotes and preceed */
/* imbedded quotes with a backslash */
/*=======================================*/
else if (GetMFType(theMultifield,i) == STRING)
{
tmp_str = ValueToString(GetMFValue(theMultifield,i));
*(ret_str+j) = '"';
j++;
while(*tmp_str)
{
if (*tmp_str == '"')
{
*(ret_str+j) = '\\';
j++;
}
else if (*tmp_str == '\\') /* GDR 111599 #835 */
{ /* GDR 111599 #835 */
*(ret_str+j) = '\\'; /* GDR 111599 #835 */
j++; /* GDR 111599 #835 */
} /* GDR 111599 #835 */
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
*(ret_str+j) = '"';
j++;
}
#if OBJECT_SYSTEM
else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
{
tmp_str = ValueToString(GetMFValue(theMultifield,i));
*(ret_str + j++) = '[';
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
*(ret_str + j++) = ']';
}
else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
{
tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name);
*(ret_str + j++) = '[';
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
*(ret_str + j++) = ']';
}
#endif
else
{
SetType(tempDO,GetMFType(theMultifield,i));
SetValue(tempDO,GetMFValue(theMultifield,i));
tmp_str = DataObjectToString(theEnv,&tempDO);
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
}
*(ret_str+j) = ' ';
j++;
}
*(ret_str+j-1) = '\0';
/*====================*/
/* Return the string. */
/*====================*/
rv = EnvAddSymbol(theEnv,ret_str);
rm(theEnv,ret_str,strsize);
return(rv);
}
const char *DataObjectToString(
Environment *theEnv,
UDFValue *theDO)
{
CLIPSLexeme *thePtr;
const char *theString;
char *newString;
const char *prefix, *postfix;
size_t length;
CLIPSExternalAddress *theAddress;
StringBuilder *theSB;
char buffer[30];
switch (theDO->header->type)
{
case MULTIFIELD_TYPE:
prefix = "(";
theString = ImplodeMultifield(theEnv,theDO)->contents;
postfix = ")";
break;
case STRING_TYPE:
prefix = "\"";
theString = theDO->lexemeValue->contents;
postfix = "\"";
break;
case INSTANCE_NAME_TYPE:
prefix = "[";
theString = theDO->lexemeValue->contents;
postfix = "]";
break;
case SYMBOL_TYPE:
return theDO->lexemeValue->contents;
case FLOAT_TYPE:
return(FloatToString(theEnv,theDO->floatValue->contents));
case INTEGER_TYPE:
return(LongIntegerToString(theEnv,theDO->integerValue->contents));
case VOID_TYPE:
return("");
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS_TYPE:
if (theDO->instanceValue == &InstanceData(theEnv)->DummyInstance)
{ return("<Dummy Instance>"); }
if (theDO->instanceValue->garbage)
{
prefix = "<Stale Instance-";
theString = theDO->instanceValue->name->contents;
postfix = ">";
}
else
{
prefix = "<Instance-";
theString = GetFullInstanceName(theEnv,theDO->instanceValue)->contents;
postfix = ">";
}
break;
#endif
case EXTERNAL_ADDRESS_TYPE:
theAddress = theDO->externalAddressValue;
theSB = CreateStringBuilder(theEnv,30);
OpenStringBuilderDestination(theEnv,"DOTS",theSB);
if ((EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type] != NULL) &&
(EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction != NULL))
{ (*EvaluationData(theEnv)->ExternalAddressTypes[theAddress->type]->longPrintFunction)(theEnv,"DOTS",theAddress); }
else
{
WriteString(theEnv,"DOTS","<Pointer-");
gensprintf(buffer,"%d-",theAddress->type);
WriteString(theEnv,"DOTS",buffer);
gensprintf(buffer,"%p",theAddress->contents);
WriteString(theEnv,"DOTS",buffer);
WriteString(theEnv,"DOTS",">");
}
thePtr = CreateString(theEnv,theSB->contents);
SBDispose(theSB);
CloseStringBuilderDestination(theEnv,"DOTS");
return thePtr->contents;
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS_TYPE:
if (theDO->factValue == &FactData(theEnv)->DummyFact)
{ return("<Dummy Fact>"); }
gensprintf(buffer,"<Fact-%lld>",theDO->factValue->factIndex);
thePtr = CreateString(theEnv,buffer);
return thePtr->contents;
#endif
default:
return("UNK");
}
length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1;
newString = (char *) genalloc(theEnv,length);
newString[0] = '\0';
genstrcat(newString,prefix);
genstrcat(newString,theString);
genstrcat(newString,postfix);
thePtr = CreateString(theEnv,newString);
genfree(theEnv,newString,length);
return thePtr->contents;
}
