globle void IfFunction(
DATA_OBJECT_PTR returnValue)
{
int numArgs;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if ((numArgs = ArgRangeCheck("if",2,3)) == -1)
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return;
}
/*=========================*/
/* Evaluate the condition. */
/*=========================*/
RtnUnknown(1,returnValue);
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
{ return; }
/*=========================================*/
/* If the condition evaluated to FALSE and */
/* an "else" portion exists, evaluate it */
/* and return the value. */
/*=========================================*/
if ((returnValue->value == FalseSymbol) &&
(returnValue->type == SYMBOL) &&
(numArgs == 3))
{
RtnUnknown(3,returnValue);
return;
}
/*===================================================*/
/* Otherwise if the symbol evaluated to a non-FALSE */
/* value, evaluate the "then" portion and return it. */
/*===================================================*/
else if ((returnValue->value != FalseSymbol) ||
(returnValue->type != SYMBOL))
{
RtnUnknown(2,returnValue);
return;
}
/*=========================================*/
/* Return FALSE if the condition evaluated */
/* to FALSE and there is no "else" portion */
/* of the if statement. */
/*=========================================*/
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return;
}
globle long int StrCompareFunction()
{
int numArgs, length;
DATA_OBJECT arg1, arg2, arg3;
long returnValue;
/*=======================================================*/
/* Function str-compare expects either 2 or 3 arguments. */
/*=======================================================*/
if ((numArgs = ArgRangeCheck("str-compare",2,3)) == -1) return(0L);
/*=============================================================*/
/* The first two arguments should be of type symbol or string. */
/*=============================================================*/
if (ArgTypeCheck("str-compare",1,SYMBOL_OR_STRING,&arg1) == FALSE)
{ return(0L); }
if (ArgTypeCheck("str-compare",2,SYMBOL_OR_STRING,&arg2) == FALSE)
{ return(0L); }
/*===================================================*/
/* Compare the strings. Use the 3rd argument for the */
/* maximum length of comparison, if it is provided. */
/*===================================================*/
if (numArgs == 3)
{
if (ArgTypeCheck("str-compare",3,INTEGER,&arg3) == FALSE)
{ return(0L); }
length = CoerceToInteger(GetType(arg3),GetValue(arg3));
returnValue = strncmp(DOToString(arg1),DOToString(arg2),
(STD_SIZE) length);
}
else
{ returnValue = strcmp(DOToString(arg1),DOToString(arg2)); }
/*========================================================*/
/* Return Values are as follows: */
/* -1 is returned if <string-1> is less than <string-2>. */
/* 1 is return if <string-1> is greater than <string-2>. */
/* 0 is returned if <string-1> is equal to <string-2>. */
/*========================================================*/
if (returnValue < 0) returnValue = -1;
else if (returnValue > 0) returnValue = 1;
return(returnValue);
}
globle void ConstructsToCCommand()
{
char *fileName;
DATA_OBJECT theArg;
int argCount;
int id, max;
#if VAX_VMS || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC
int i;
#endif
/*============================================*/
/* Check for appropriate number of arguments. */
/*============================================*/
if ((argCount = ArgRangeCheck("constructs-to-c",2,3)) == -1) return;
/*====================================================*/
/* Get the name of the file in which to place C code. */
/*====================================================*/
if (ArgTypeCheck("constructs-to-c",1,SYMBOL_OR_STRING,&theArg) == FALSE)
{ return; }
fileName = DOToString(theArg);
/*================================*/
/* File names for the VAX and IBM */
/* PCs can't contain a period. */
/*================================*/
#if VAX_VMS || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC
for (i = 0 ; *(fileName+i) ; i++)
{
if (*(fileName+i) == '.')
{
PrintErrorID("CONSCOMP",1,FALSE);
PrintRouter(WERROR,"Invalid file name ");
PrintRouter(WERROR,fileName);
PrintRouter(WERROR," contains \'.\'\n");
return;
}
}
#endif
/*===========================================*/
/* If the base file name is greater than 3 */
/* characters, issue a warning that the file */
/* name lengths may exceed what is allowed */
/* under some operating systems. */
/*===========================================*/
if (((int) strlen(fileName)) > 3)
{
PrintWarningID("CONSCOMP",1,FALSE);
PrintRouter(WWARNING,"Base file name exceeds 3 characters.\n");
PrintRouter(WWARNING," This may cause files to be overwritten if file name length\n");
PrintRouter(WWARNING," is limited on your platform.\n");
}
/*====================================*/
/* Get the runtime image ID argument. */
/*====================================*/
if (ArgTypeCheck("constructs-to-c",2,INTEGER,&theArg) == FALSE)
{ return; }
id = DOToInteger(theArg);
if (id < 0)
{
ExpectedTypeError1("constructs-to-c",2,"positive integer");
return;
}
/*===========================================*/
/* Get the maximum number of data structures */
/* to store per file argument (if supplied). */
/*===========================================*/
if (argCount == 3)
{
if (ArgTypeCheck("constructs-to-c",3,INTEGER,&theArg) == FALSE)
{ return; }
max = DOToInteger(theArg);
if (max < 0)
{
ExpectedTypeError1("constructs-to-c",3,"positive integer");
return;
}
}
else
{ max = 10000; }
/*============================*/
/* Call the driver routine to */
/* generate the C code. */
/*============================*/
ConstructsToC(fileName,id,max);
}
