globle void WriteNeededConstraints(
void *theEnv,
FILE *fp)
{
int i;
unsigned short theIndex = 0;
unsigned long int numberOfUsedConstraints = 0;
CONSTRAINT_RECORD *tmpPtr;
BSAVE_CONSTRAINT_RECORD bsaveConstraints;
/*================================*/
/* Get the number of constraints. */
/*================================*/
for (i = 0; i < SIZE_CONSTRAINT_HASH; i++)
{
for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
tmpPtr != NULL;
tmpPtr = tmpPtr->next)
{
tmpPtr->bsaveIndex = theIndex++;
numberOfUsedConstraints++;
}
}
/*=============================================*/
/* If dynamic constraint checking is disabled, */
/* then no constraints are saved. */
/*=============================================*/
if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfUsedConstraints != 0))
{
numberOfUsedConstraints = 0;
PrintWarningID(theEnv,"CSTRNBIN",1,FALSE);
EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a binary image\n");
EnvPrintRouter(theEnv,WWARNING," when dynamic constraint checking is disabled.\n");
}
/*============================================*/
/* Write out the number of constraints in the */
/* constraint table followed by each of the */
/* constraints in the constraint table. */
/*============================================*/
GenWrite(&numberOfUsedConstraints,(unsigned long) sizeof(unsigned long int),fp);
if (numberOfUsedConstraints == 0) return;
for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++)
{
for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
tmpPtr != NULL;
tmpPtr = tmpPtr->next)
{
CopyToBsaveConstraintRecord(theEnv,tmpPtr,&bsaveConstraints);
GenWrite(&bsaveConstraints,
(unsigned long) sizeof(BSAVE_CONSTRAINT_RECORD),fp);
}
}
}
/***************************************************
NAME : RemoveAllDeffunctions
DESCRIPTION : Removes all deffunctions
INPUTS : None
RETURNS : TRUE if all deffunctions
removed, FALSE otherwise
SIDE EFFECTS : Deffunctions removed
NOTES : None
***************************************************/
static intBool RemoveAllDeffunctions(
void *theEnv,
EXEC_STATUS)
{
DEFFUNCTION *dptr,*dtmp;
unsigned oldbusy;
intBool success = TRUE;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv,execStatus) == TRUE)
return(FALSE);
#endif
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
while (dptr != NULL)
{
if (dptr->executing > 0)
{
DeffunctionDeleteError(theEnv,execStatus,EnvGetDeffunctionName(theEnv,execStatus,(void *) dptr));
success = FALSE;
}
else
{
oldbusy = dptr->busy;
ExpressionDeinstall(theEnv,execStatus,dptr->code);
dptr->busy = oldbusy;
ReturnPackedExpression(theEnv,execStatus,dptr->code);
dptr->code = NULL;
}
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
}
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
while (dptr != NULL)
{
dtmp = dptr;
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
if (dtmp->executing == 0)
{
if (dtmp->busy > 0)
{
PrintWarningID(theEnv,execStatus,"DFFNXFUN",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WWARNING,"Deffunction ");
EnvPrintRouter(theEnv,execStatus,WWARNING,EnvGetDeffunctionName(theEnv,execStatus,(void *) dtmp));
EnvPrintRouter(theEnv,execStatus,WWARNING," only partially deleted due to usage by other constructs.\n");
SetDeffunctionPPForm((void *) dtmp,NULL);
success = FALSE;
}
else
{
RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) dtmp);
RemoveDeffunction(theEnv,execStatus,dtmp);
}
}
}
return(success);
}
static void UpdateHandler(
void *buf,
long obji)
{
HANDLER *hnd;
BSAVE_HANDLER *bhnd;
hnd = (HANDLER *) &handlerArray[obji];
bhnd = (BSAVE_HANDLER *) buf;
hnd->system = bhnd->system;
hnd->type = bhnd->type;
#if (! IMPERATIVE_MESSAGE_HANDLERS)
if (hnd->type == MAROUND)
{
PrintWarningID("OBJBIN",1,FALSE);
PrintRouter(WWARNING,"Around message-handlers are not\n");
PrintRouter(WWARNING," supported in this environment.");
}
#endif
#if (! AUXILIARY_MESSAGE_HANDLERS)
if ((hnd->type == MBEFORE) || (hnd->type == MAFTER))
{
PrintWarningID("OBJBIN",2,FALSE);
PrintRouter(WWARNING,"Before and after message-handlers are not\n");
PrintRouter(WWARNING," supported in this environment.");
}
#endif
hnd->minParams = bhnd->minParams;
hnd->maxParams = bhnd->maxParams;
hnd->localVarCount = bhnd->localVarCount;
hnd->cls = DefclassPointer(bhnd->cls);
hnd->name = SymbolPointer(bhnd->name);
IncrementSymbolCount(hnd->name);
hnd->actions = ExpressionPointer(bhnd->actions);
hnd->ppForm = NULL;
hnd->busy = 0;
hnd->mark = 0;
hnd->usrData = NULL;
#if DEBUGGING_FUNCTIONS
hnd->trace = WatchHandlers;
#endif
}
globle struct lhsParseNode *CreateInitialFactPattern(
void *theEnv)
{
struct lhsParseNode *topNode;
struct deftemplate *theDeftemplate;
int count;
/*==================================*/
/* If the initial-fact deftemplate */
/* doesn't exist, then create it. */
/*==================================*/
theDeftemplate = (struct deftemplate *)
FindImportedConstruct(theEnv,"deftemplate",NULL,"initial-fact",
&count,TRUE,NULL);
if (theDeftemplate == NULL)
{
PrintWarningID(theEnv,"FACTLHS",1,FALSE);
EnvPrintRouter(theEnv,WWARNING,"Creating implied initial-fact deftemplate in module ");
EnvPrintRouter(theEnv,WWARNING,EnvGetDefmoduleName(theEnv,EnvGetCurrentModule(theEnv)));
EnvPrintRouter(theEnv,WWARNING,".\n");
EnvPrintRouter(theEnv,WWARNING," You probably want to import this deftemplate from the MAIN module.\n");
CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE);
}
/*====================================*/
/* Create the (initial-fact) pattern. */
/*====================================*/
topNode = GetLHSParseNode(theEnv);
topNode->type = SF_WILDCARD;
topNode->index = 0;
topNode->slotNumber = 1;
topNode->bottom = GetLHSParseNode(theEnv);
topNode->bottom->type = SYMBOL;
topNode->bottom->value = (void *) EnvAddSymbol(theEnv,"initial-fact");
/*=====================*/
/* Return the pattern. */
/*=====================*/
return(topNode);
}
static void UpdateType(
void *buf,
long obji)
{
#if OBJECT_SYSTEM
typeArray[obji] = (void *) DefclassPointer(* (long *) buf);
#else
if ((* (long *) buf) > (long) INSTANCE_TYPE_CODE)
{
PrintWarningID("GENRCBIN",1,FALSE);
PrintRouter(WWARNING,"COOL not installed! User-defined class\n");
PrintRouter(WWARNING," in method restriction substituted with OBJECT.\n");
typeArray[obji] = (void *) AddLong((long) OBJECT_TYPE_CODE);
}
else
typeArray[obji] = (void *) AddLong(* (long *) buf);
IncrementIntegerCount((INTEGER_HN *) typeArray[obji]);
#endif
}
static void UpdateType(
void *theEnv,
void *buf,
long obji)
{
#if OBJECT_SYSTEM
DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) DefclassPointer(* (long *) buf);
#else
if ((* (long *) buf) > (long) INSTANCE_TYPE_CODE)
{
PrintWarningID(theEnv,(char*)"GENRCBIN",1,FALSE);
EnvPrintRouter(theEnv,WWARNING,(char*)"COOL not installed! User-defined class\n");
EnvPrintRouter(theEnv,WWARNING,(char*)" in method restriction substituted with OBJECT.\n");
DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,(long long) OBJECT_TYPE_CODE);
}
else
DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,* (long *) buf);
IncrementIntegerCount((INTEGER_HN *) DefgenericBinaryData(theEnv)->TypeArray[obji]);
#endif
}
void ArgumentOverUnderflowErrorMessage(
Environment *theEnv,
const char *functionName,
bool error)
{
if (error)
{
PrintErrorID(theEnv,"PRNTUTIL",17,false);
WriteString(theEnv,STDERR,"Over or underflow of long long integer in '");
WriteString(theEnv,STDERR,functionName);
WriteString(theEnv,STDERR,"' function.\n");
}
else
{
PrintWarningID(theEnv,"PRNTUTIL",17,false);
WriteString(theEnv,STDWRN,"Over or underflow of long long integer in '");
WriteString(theEnv,STDWRN,functionName);
WriteString(theEnv,STDWRN,"' function.\n");
}
}
globle int ConstraintsToCode(
void *theEnv,
char *fileName,
int fileID,
FILE *headerFP,
int imageID,
int maxIndices)
{
int i, j, count;
int newHeader = TRUE;
FILE *fp;
int version = 1;
int arrayVersion = 1;
unsigned short numberOfConstraints = 0;
CONSTRAINT_RECORD *tmpPtr;
/*===============================================*/
/* Count the total number of constraint records. */
/*===============================================*/
for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++)
{
for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
tmpPtr != NULL;
tmpPtr = tmpPtr->next)
{ tmpPtr->bsaveIndex = numberOfConstraints++; }
}
/*=====================================================*/
/* If dynamic constraint checking is disabled, then */
/* contraints won't be saved. If there are constraints */
/* which could be saved, then issue a warning message. */
/*=====================================================*/
if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfConstraints != 0))
{
numberOfConstraints = 0;
PrintWarningID(theEnv,"CSTRNCMP",1,FALSE);
EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a constructs-to-c image\n");
EnvPrintRouter(theEnv,WWARNING," when dynamic constraint checking is disabled.\n");
}
if (numberOfConstraints == 0) return(-1);
/*=================================================*/
/* Print the extern definition in the header file. */
/*=================================================*/
for (i = 1; i <= (numberOfConstraints / maxIndices) + 1 ; i++)
{ fprintf(headerFP,"extern CONSTRAINT_RECORD C%d_%d[];\n",imageID,i); }
/*==================*/
/* Create the file. */
/*==================*/
if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(-1);
/*===================*/
/* List the entries. */
/*===================*/
j = 0;
count = 0;
for (i = 0; i < SIZE_CONSTRAINT_HASH; i++)
{
for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
tmpPtr != NULL;
tmpPtr = tmpPtr->next)
{
if (newHeader)
{
fprintf(fp,"CONSTRAINT_RECORD C%d_%d[] = {\n",imageID,arrayVersion);
newHeader = FALSE;
}
fprintf(fp,"{%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d",
tmpPtr->anyAllowed,
tmpPtr->symbolsAllowed,
tmpPtr->stringsAllowed,
tmpPtr->floatsAllowed,
tmpPtr->integersAllowed,
tmpPtr->instanceNamesAllowed,
tmpPtr->instanceAddressesAllowed,
tmpPtr->externalAddressesAllowed,
tmpPtr->factAddressesAllowed,
0, /* void allowed */
tmpPtr->anyRestriction,
tmpPtr->symbolRestriction,
tmpPtr->stringRestriction,
tmpPtr->floatRestriction,
tmpPtr->integerRestriction,
tmpPtr->instanceNameRestriction,
tmpPtr->multifieldsAllowed,
tmpPtr->singlefieldsAllowed);
fprintf(fp,",0,"); /* bsaveIndex */
PrintHashedExpressionReference(theEnv,fp,tmpPtr->restrictionList,imageID,maxIndices);
fprintf(fp,",");
PrintHashedExpressionReference(theEnv,fp,tmpPtr->minValue,imageID,maxIndices);
fprintf(fp,",");
PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxValue,imageID,maxIndices);
fprintf(fp,",");
PrintHashedExpressionReference(theEnv,fp,tmpPtr->minFields,imageID,maxIndices);
fprintf(fp,",");
PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxFields,imageID,maxIndices);
/* multifield slot */
fprintf(fp,",NULL");
/* next slot */
if (tmpPtr->next == NULL)
{ fprintf(fp,",NULL,"); }
else
{
if ((j + 1) >= maxIndices)
{ fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion + 1,0); }
else
{ fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion,j + 1); }
}
fprintf(fp,"%d,%d",tmpPtr->bucket,tmpPtr->count + 1);
count++;
j++;
if ((count == numberOfConstraints) || (j >= maxIndices))
{
fprintf(fp,"}};\n");
GenClose(fp);
j = 0;
version++;
arrayVersion++;
if (count < numberOfConstraints)
{
if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0);
newHeader = TRUE;
}
}
else
{ fprintf(fp,"},\n"); }
}
}
return(version);
}
static intBool GetVariableDefinition(
void *theEnv,
char *readSource,
int *defglobalError,
int tokenRead,
struct token *theToken)
{
SYMBOL_HN *variableName;
struct expr *assignPtr;
DATA_OBJECT assignValue;
/*========================================*/
/* Get next token, which should either be */
/* a closing parenthesis or a variable. */
/*========================================*/
if (! tokenRead) GetToken(theEnv,readSource,theToken);
if (theToken->type == RPAREN) return(FALSE);
if (theToken->type == SF_VARIABLE)
{
SyntaxErrorMessage(theEnv,"defglobal");
*defglobalError = TRUE;
return(FALSE);
}
else if (theToken->type != GBL_VARIABLE)
{
SyntaxErrorMessage(theEnv,"defglobal");
*defglobalError = TRUE;
return(FALSE);
}
variableName = (SYMBOL_HN *) theToken->value;
SavePPBuffer(theEnv," ");
/*================================*/
/* Print out compilation message. */
/*================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") == ON) && GetPrintWhileLoading(theEnv))
{
if (QFindDefglobal(theEnv,variableName) != NULL)
{
PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
EnvPrintRouter(theEnv,WDIALOG,"Redefining defglobal: ");
}
else EnvPrintRouter(theEnv,WDIALOG,"Defining defglobal: ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(variableName));
EnvPrintRouter(theEnv,WDIALOG,"\n");
}
else
#endif
{ if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,":"); }
/*==================================================================*/
/* Check for import/export conflicts from the construct definition. */
/*==================================================================*/
#if DEFMODULE_CONSTRUCT
if (FindImportExportConflict(theEnv,"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName)))
{
ImportExportConflictMessage(theEnv,"defglobal",ValueToString(variableName),NULL,NULL);
*defglobalError = TRUE;
return(FALSE);
}
#endif
/*==============================*/
/* The next token must be an =. */
/*==============================*/
GetToken(theEnv,readSource,theToken);
if (strcmp(theToken->printForm,"=") != 0)
{
SyntaxErrorMessage(theEnv,"defglobal");
*defglobalError = TRUE;
return(FALSE);
}
SavePPBuffer(theEnv," ");
/*======================================================*/
/* Parse the expression to be assigned to the variable. */
/*======================================================*/
assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL);
if (assignPtr == NULL)
{
*defglobalError = TRUE;
return(FALSE);
}
/*==========================*/
/* Evaluate the expression. */
/*==========================*/
if (! ConstructData(theEnv)->CheckSyntaxMode)
{
SetEvaluationError(theEnv,FALSE);
if (EvaluateExpression(theEnv,assignPtr,&assignValue))
{
ReturnExpression(theEnv,assignPtr);
*defglobalError = TRUE;
return(FALSE);
}
}
else
{ ReturnExpression(theEnv,assignPtr); }
SavePPBuffer(theEnv,")");
/*======================================*/
/* Add the variable to the global list. */
/*======================================*/
if (! ConstructData(theEnv)->CheckSyntaxMode)
{ AddDefglobal(theEnv,variableName,&assignValue,assignPtr); }
/*==================================================*/
/* Return TRUE to indicate that the global variable */
/* definition was successfully parsed. */
/*==================================================*/
return(TRUE);
}
globle SYMBOL_HN *GetConstructNameAndComment(
void *theEnv,
char *readSource,
struct token *inputToken,
char *constructName,
void *(*findFunction)(void *,char *),
int (*deleteFunction)(void *,void *),
char *constructSymbol,
int fullMessageCR,
int getComment,
int moduleNameAllowed)
{
#if (MAC_MCW || WIN_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS)
#pragma unused(fullMessageCR)
#endif
SYMBOL_HN *name, *moduleName;
int redefining = FALSE;
void *theConstruct;
unsigned separatorPosition;
struct defmodule *theModule;
/*==========================*/
/* Next token should be the */
/* name of the construct. */
/*==========================*/
GetToken(theEnv,readSource,inputToken);
if (inputToken->type != SYMBOL)
{
PrintErrorID(theEnv,"CSTRCPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"Missing name for ");
EnvPrintRouter(theEnv,WERROR,constructName);
EnvPrintRouter(theEnv,WERROR," construct\n");
return(NULL);
}
name = (SYMBOL_HN *) inputToken->value;
/*===============================*/
/* Determine the current module. */
/*===============================*/
separatorPosition = FindModuleSeparator(ValueToString(name));
if (separatorPosition)
{
if (moduleNameAllowed == FALSE)
{
SyntaxErrorMessage(theEnv,"module specifier");
return(NULL);
}
moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name));
if (moduleName == NULL)
{
SyntaxErrorMessage(theEnv,"construct name");
return(NULL);
}
theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
if (theModule == NULL)
{
CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName));
return(NULL);
}
EnvSetCurrentModule(theEnv,(void *) theModule);
name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name));
if (name == NULL)
{
SyntaxErrorMessage(theEnv,"construct name");
return(NULL);
}
}
/*=====================================================*/
/* If the module was not specified, record the current */
/* module name as part of the pretty-print form. */
/*=====================================================*/
else
{
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
if (moduleNameAllowed)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule));
SavePPBuffer(theEnv,"::");
SavePPBuffer(theEnv,ValueToString(name));
}
}
/*==================================================================*/
/* Check for import/export conflicts from the construct definition. */
/*==================================================================*/
#if DEFMODULE_CONSTRUCT
if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name)))
{
ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL);
return(NULL);
}
#endif
/*========================================================*/
/* Remove the construct if it is already in the knowledge */
/* base and we're not just checking syntax. */
/*========================================================*/
if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
theConstruct = (*findFunction)(theEnv,ValueToString(name));
if (theConstruct != NULL)
{
redefining = TRUE;
if (deleteFunction != NULL)
{
if ((*deleteFunction)(theEnv,theConstruct) == FALSE)
{
PrintErrorID(theEnv,"CSTRCPSR",4,TRUE);
EnvPrintRouter(theEnv,WERROR,"Cannot redefine ");
EnvPrintRouter(theEnv,WERROR,constructName);
EnvPrintRouter(theEnv,WERROR," ");
EnvPrintRouter(theEnv,WERROR,ValueToString(name));
EnvPrintRouter(theEnv,WERROR," while it is in use.\n");
return(NULL);
}
}
}
}
/*=============================================*/
/* If compilations are being watched, indicate */
/* that a construct is being compiled. */
/*=============================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) &&
GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
if (redefining)
{
PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
EnvPrintRouter(theEnv,WDIALOG,"Redefining ");
}
else EnvPrintRouter(theEnv,WDIALOG,"Defining ");
EnvPrintRouter(theEnv,WDIALOG,constructName);
EnvPrintRouter(theEnv,WDIALOG,": ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(name));
if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n");
else EnvPrintRouter(theEnv,WDIALOG," ");
}
else
#endif
{
if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
{ EnvPrintRouter(theEnv,WDIALOG,constructSymbol); }
}
/*===============================*/
/* Get the comment if it exists. */
/*===============================*/
GetToken(theEnv,readSource,inputToken);
if ((inputToken->type == STRING) && getComment)
{
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,inputToken->printForm);
GetToken(theEnv,readSource,inputToken);
if (inputToken->type != RPAREN)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,"\n ");
SavePPBuffer(theEnv,inputToken->printForm);
}
}
else if (inputToken->type != RPAREN)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,"\n ");
SavePPBuffer(theEnv,inputToken->printForm);
}
/*===================================*/
/* Return the name of the construct. */
/*===================================*/
return(name);
}
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);
}
globle FILE *OpenFileIfNeeded(
FILE *theFile,
char *fileName,
int fileID,
int imageID,
int *fileCount,
int arrayVersion,
FILE *headerFP,
char *structureName,
char *structPrefix,
int reopenOldFile,
struct CodeGeneratorFile *codeFile)
{
char arrayName[80];
char *newName;
int newID, newVersion;
/*===========================================*/
/* If a file is being reopened, use the same */
/* version number, name, and ID as before. */
/*===========================================*/
if (reopenOldFile)
{
if (codeFile == NULL)
{
SystemError("CONSCOMP",5);
ExitRouter(EXIT_FAILURE);
}
newName = codeFile->filePrefix;
newID = codeFile->id;
newVersion = codeFile->version;
}
/*=====================================================*/
/* Otherwise, use the specified version number, name, */
/* and ID. If the appropriate argument is supplied, */
/* remember these values for later reopening the file. */
/*=====================================================*/
else
{
newName = fileName;
newVersion = *fileCount;
newID = fileID;
if (codeFile != NULL)
{
codeFile->version = newVersion;
codeFile->filePrefix = newName;
codeFile->id = newID;
}
}
/*=========================================*/
/* If the file is already open, return it. */
/*=========================================*/
if (theFile != NULL)
{
fprintf(theFile,",\n");
return(theFile);
}
/*================*/
/* Open the file. */
/*================*/
if ((theFile = NewCFile(newName,newID,newVersion,reopenOldFile)) == NULL)
{ return(NULL); }
/*=========================================*/
/* If this is the first time the file has */
/* been opened, write out the beginning of */
/* the array variable definition. */
/*=========================================*/
if (reopenOldFile == FALSE)
{
(*fileCount)++;
sprintf(arrayName,"%s%d_%d",structPrefix,imageID,arrayVersion);
#if SHORT_LINK_NAMES
if (strlen(arrayName) > 6)
{
PrintWarningID("CONSCOMP",2,FALSE);
PrintRouter(WWARNING,"Array name ");
PrintRouter(WWARNING,arrayName);
PrintRouter(WWARNING,"exceeds 6 characters in length.\n");
PrintRouter(WWARNING," This variable may be indistinguishable from another by the linker.\n");
}
#endif
fprintf(theFile,"%s %s[] = {\n",structureName,arrayName);
fprintf(headerFP,"extern %s %s[];\n",structureName,arrayName);
}
else
{ fprintf(theFile,",\n"); }
/*==================*/
/* Return the file. */
/*==================*/
return(theFile);
}