/*******************************************************************************
Name: PrintChangedFocus
Description: Update the Focus window
Arguments: None
Returns:
*******************************************************************************/
int PrintChangedFocus()
{
void *theEnv = GetCurrentEnvironment();
void *FocusPtr;
int n;
char *buffer;
/* Clear the old contents */
n = 0;
XtSetArg(TheArgs[n],XtNstring,"");n++;
XtSetValues(focus_text,TheArgs,n);
XawAsciiSourceFreeString(XawTextGetSource(focus_text));
/* Print the new focus list */
FocusPtr = EnvGetNextFocus(theEnv,NULL);
while(FocusPtr != NULL)
{
buffer = EnvGetDefmoduleName(theEnv,((struct focus*)FocusPtr)->theModule);
EnvPrintRouter(theEnv,"xfocus",buffer);
EnvPrintRouter(theEnv,"xfocus","\n");
FocusPtr = EnvGetNextFocus(theEnv,FocusPtr);
}
return 0;
}
static void GetFocusPPForm(
void *theEnv,
char *buffer,
size_t bufferLength,
void *vTheFocus)
{
struct focus *theFocus = (struct focus *) vTheFocus;
strncpy(buffer,EnvGetDefmoduleName(theEnv,theFocus->theModule),bufferLength);
}
static intBool DeleteDefmodule(
void *theEnv,
void *theConstruct)
{
if (strcmp(EnvGetDefmoduleName(theEnv,theConstruct),"MAIN") == 0)
{ return(DefmoduleData(theEnv)->MainModuleRedefinable); }
return(FALSE);
}
/*******************************************************************************
Name: PrintChangedAgenda
Description: Update the agenda window
Arguments: None
Returns:
*******************************************************************************/
int PrintChangedAgenda()
{
void *theEnv = GetCurrentEnvironment();
void *rule_ptr;
char buffer[MAX_CHAR_IN_BUF];
char *name, labelBuffer[MAX_CHAR_IN_BUF];
Window AgendaWin;
Display *theDisplay;
struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
/*======================================================*/
/* Change the name of the window to the current module. */
/*======================================================*/
AgendaWin = XtWindow(agenda);
theDisplay = XtDisplay(agenda);
if (theModule != NULL)
{
name = EnvGetDefmoduleName(theEnv,theModule);
strcpy(labelBuffer,"Agenda Window(");
strcat(labelBuffer,name);
strcat(labelBuffer,")");
}
else
{
strcpy(labelBuffer,"Agenda Window");
}
XStoreName(theDisplay,AgendaWin,labelBuffer);
/*============================*/
/* Wipe out the old contents. */
/*============================*/
XtSetArg(TheArgs[0], XtNstring, "");
XtSetValues(agenda_text, TheArgs, 1);
XawAsciiSourceFreeString(XawTextGetSource(agenda_text));
/*============================*/
/* Print the new agenda list. */
/*============================*/
rule_ptr = EnvGetNextActivation(theEnv,NULL);
while (rule_ptr != NULL)
{
EnvGetActivationPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,rule_ptr);
EnvPrintRouter(theEnv,"xagenda",buffer);
EnvPrintRouter(theEnv,"xagenda", "\n");
rule_ptr = EnvGetNextActivation(theEnv,rule_ptr);
}
return 0;
}
/******************************************************
NAME : PrintGenericName
DESCRIPTION : Prints the name of a gneric function
(including the module name if the
generic is not in the current module)
INPUTS : 1) The logical name of the output
2) The generic functions
RETURNS : Nothing useful
SIDE EFFECTS : Generic name printed
NOTES : None
******************************************************/
globle void PrintGenericName(
void *theEnv,
char *logName,
DEFGENERIC *gfunc)
{
if (gfunc->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{
EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *)
gfunc->header.whichModule->theModule));
EnvPrintRouter(theEnv,logName,(char*)"::");
}
EnvPrintRouter(theEnv,logName,ValueToString((void *) gfunc->header.name));
}
globle void EnvListFocusStack(
void *theEnv,
char *logicalName)
{
struct focus *theFocus;
for (theFocus = EngineData(theEnv)->CurrentFocus;
theFocus != NULL;
theFocus = theFocus->next)
{
EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theFocus->theModule));
EnvPrintRouter(theEnv,logicalName,"\n");
}
}
/*******************************************************************************
Name: PrintChangedGlobals
Description: Update the global window
Arguments: None
Returns:
*******************************************************************************/
int PrintChangedGlobals()
{
void *theEnv = GetCurrentEnvironment();
void *dgPtr;
int n;
char *buffer;
char *name,labelBuffer[MAX_CHAR_IN_BUF];
Window GlobalWin;
Display *theDisplay;
struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
/* Change the name of the window to the current module */
GlobalWin = XtWindow(globals);
theDisplay = XtDisplay(globals);
if (theModule != NULL)
{
name = EnvGetDefmoduleName(theEnv,theModule);
strcpy(labelBuffer,"Globals Window(");
strcat(labelBuffer,name);
strcat(labelBuffer,")");
}
else
{
strcpy(labelBuffer,"Globals Window");
}
XStoreName(theDisplay,GlobalWin,labelBuffer);
/* Clear the old contents */
n = 0;
XtSetArg(TheArgs[n],XtNstring,"");n++;
XtSetValues(globals_text,TheArgs,n);
XawAsciiSourceFreeString(XawTextGetSource(globals_text));
/* Print the new defglobal list */
dgPtr = EnvGetNextDefglobal(theEnv,NULL);
while (dgPtr != NULL)
{
buffer = (char *) EnvGetDefglobalPPForm(theEnv,(struct constructHeader *) dgPtr);
EnvPrintRouter(theEnv,"xglobals",buffer);
EnvPrintRouter(theEnv,"xglobals","\n");
dgPtr = EnvGetNextDefglobal(theEnv,dgPtr);
}
return 0;
}
static void UpdateStatusWndTitle(
HWND hwnd)
{
void *theEnv = GlobalEnv;
struct statusWindowData *theData;
struct defmodule *theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
char buffer[255];
theData = (struct statusWindowData *) GetWindowLongPtr(hwnd,GWLP_USERDATA);
if (theData == NULL) return;
sprintf(buffer,"%s (%s)",theData->baseName,EnvGetDefmoduleName(theEnv,theModule));
SetWindowText(hwnd,buffer);
}
/*******************************************************************************
Name: PrintChangedFacts
Description: Update the fact window
Arguments: None
Returns:
*******************************************************************************/
int PrintChangedFacts()
{
void *theEnv = GetCurrentEnvironment();
void *fact_ptr;
char buffer[MAX_CHAR_IN_BUF];
char *name,labelBuffer[MAX_CHAR_IN_BUF];
Window FactWin;
Display *theDisplay;
struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
/* Change the name of the window to the current module */
FactWin = XtWindow(facts);
theDisplay = XtDisplay(facts);
if(theModule != NULL)
{
name = EnvGetDefmoduleName(theEnv,theModule);
strcpy(labelBuffer,"Fact Window(");
strcat(labelBuffer,name);
strcat(labelBuffer,")");
}
else
{
strcpy(labelBuffer,"Fact Window");
}
XStoreName(theDisplay,FactWin,labelBuffer);
/* Clear the old contents */
XtSetArg(TheArgs[0], XtNstring, "");
XtSetValues(facts_text, TheArgs, 1);
XawAsciiSourceFreeString(XawTextGetSource(facts_text));
/* Print the new fact list */
fact_ptr = EnvGetNextFact(theEnv,NULL);
while (fact_ptr != NULL)
{
EnvGetFactPPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,fact_ptr);
EnvPrintRouter(theEnv,"xfacts",buffer);
EnvPrintRouter(theEnv,"xfacts", "\n");
fact_ptr = EnvGetNextFact(theEnv,fact_ptr);
}
return 0;
}
/******************************************************
NAME : PrintClassName
DESCRIPTION : Displays a class's name
INPUTS : 1) Logical name of output
2) The class
3) Flag indicating whether to
print carriage-return at end
RETURNS : Nothing useful
SIDE EFFECTS : Class name printed (and module name
too if class is not in current module)
NOTES : None
******************************************************/
globle void PrintClassName(
void *theEnv,
char *logicalName,
DEFCLASS *theDefclass,
intBool linefeedFlag)
{
if ((theDefclass->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv))) &&
(theDefclass->system == 0))
{
EnvPrintRouter(theEnv,logicalName,
EnvGetDefmoduleName(theEnv,theDefclass->header.whichModule->theModule));
EnvPrintRouter(theEnv,logicalName,"::");
}
EnvPrintRouter(theEnv,logicalName,ValueToString(theDefclass->header.name));
if (linefeedFlag)
EnvPrintRouter(theEnv,logicalName,"\n");
}
/*******************************************************************************
Name: PrintChangedInstances
Description: Update the instances window
Arguments: None
Returns:
*******************************************************************************/
int PrintChangedInstances()
{
void *theEnv = GetCurrentEnvironment();
int n = 0;
void *instancePtr;
char buffer[MAX_CHAR_IN_BUF];
char *name, labelBuffer[MAX_CHAR_IN_BUF];
Window InstanceWin;
Display *theDisplay;
struct defmodule* theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
/* Change the name of the window to the current module */
InstanceWin = XtWindow(instances);
theDisplay = XtDisplay(instances);
if (theModule != NULL)
{
name = EnvGetDefmoduleName(theEnv,theModule);
strcpy(labelBuffer,"Instances Window(");
strcat(labelBuffer,name);
strcat(labelBuffer,")");
}
else
{
strcpy(labelBuffer,"Instances Window");
}
XStoreName(theDisplay,InstanceWin,labelBuffer);
/* Clear the old contents */
XtSetArg(TheArgs[n],XtNstring,"");n++;
XtSetValues(instances_text,TheArgs,n);
XawAsciiSourceFreeString(XawTextGetSource(instances_text));
/* Print the new instance list */
instancePtr = (void *) EnvGetNextInstance(theEnv,NULL);
while (instancePtr != NULL)
{
EnvGetInstancePPForm(theEnv,buffer,MAX_CHAR_IN_BUF - 1,instancePtr);
EnvPrintRouter(theEnv,"xinstances",buffer);
EnvPrintRouter(theEnv,"xinstances","\n");
instancePtr = (void *) EnvGetNextInstance(theEnv,instancePtr);
}
return 0;
}
/***************************************************
NAME : WatchDeffunction
DESCRIPTION : Displays a message indicating when
a deffunction began and ended
execution
INPUTS : The beginning or end trace string
to print when deffunction starts
or finishes respectively
RETURNS : Nothing useful
SIDE EFFECTS : Watch message printed
NOTES : None
***************************************************/
static void WatchDeffunction(
void *theEnv,
char *tstring)
{
EnvPrintRouter(theEnv,WTRACE,"DFN ");
EnvPrintRouter(theEnv,WTRACE,tstring);
if (DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{
EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *)
DeffunctionData(theEnv)->ExecutingDeffunction->header.whichModule->theModule));
EnvPrintRouter(theEnv,WTRACE,"::");
}
EnvPrintRouter(theEnv,WTRACE,ValueToString(DeffunctionData(theEnv)->ExecutingDeffunction->header.name));
EnvPrintRouter(theEnv,WTRACE," ED:");
PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth);
PrintProcParamArray(theEnv,WTRACE);
}
void EnvGetDefmoduleList(
void *theEnv,
CLIPSValue *returnValue)
{
void *theConstruct;
unsigned long count = 0;
struct multifield *theList;
/*====================================*/
/* Determine the number of constructs */
/* of the specified type. */
/*====================================*/
for (theConstruct = EnvGetNextDefmodule(theEnv,NULL);
theConstruct != NULL;
theConstruct = EnvGetNextDefmodule(theEnv,theConstruct))
{ count++; }
/*===========================*/
/* Create a multifield large */
/* enough to store the list. */
/*===========================*/
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,(long) count);
theList = (struct multifield *) EnvCreateMultifield(theEnv,count);
SetpValue(returnValue,(void *) theList);
/*====================================*/
/* Store the names in the multifield. */
/*====================================*/
for (theConstruct = EnvGetNextDefmodule(theEnv,NULL), count = 1;
theConstruct != NULL;
theConstruct = EnvGetNextDefmodule(theEnv,theConstruct), count++)
{
if (EvaluationData(theEnv)->HaltExecution == true)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
return;
}
SetMFType(theList,count,SYMBOL);
SetMFValue(theList,count,EnvAddSymbol(theEnv,EnvGetDefmoduleName(theEnv,theConstruct)));
}
}
globle void EnvListDefmodules(
void *theEnv,
char *logicalName)
{
void *theModule;
int count = 0;
for (theModule = EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = EnvGetNextDefmodule(theEnv,theModule))
{
EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule));
EnvPrintRouter(theEnv,logicalName,"\n");
count++;
}
PrintTally(theEnv,logicalName,count,"defmodule","defmodules");
}
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);
}
/**********************************************************************
NAME : WatchGeneric
DESCRIPTION : Prints out a trace of the beginning or end
of the execution of a generic function
INPUTS : A string to indicate beginning or end of execution
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : Uses the globals CurrentGeneric, ProcParamArraySize and
ProcParamArray for other trace info
**********************************************************************/
static void WatchGeneric(
void *theEnv,
const char *tstring)
{
EnvPrintRouter(theEnv,WTRACE,"GNC ");
EnvPrintRouter(theEnv,WTRACE,tstring);
EnvPrintRouter(theEnv,WTRACE," ");
if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{
EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *)
DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule));
EnvPrintRouter(theEnv,WTRACE,"::");
}
EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name));
EnvPrintRouter(theEnv,WTRACE," ");
EnvPrintRouter(theEnv,WTRACE," ED:");
PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth);
PrintProcParamArray(theEnv,WTRACE);
}
/************************************************************
NAME : ValidDeffunctionName
DESCRIPTION : Determines if a new deffunction of the given
name can be defined in the current module
INPUTS : The new deffunction name
RETURNS : TRUE if OK, FALSE otherwise
SIDE EFFECTS : Error message printed if not OK
NOTES : GetConstructNameAndComment() (called before
this function) ensures that the deffunction
name does not conflict with one from
another module
************************************************************/
static BOOLEAN ValidDeffunctionName(
void *theEnv,
char *theDeffunctionName)
{
struct constructHeader *theDeffunction;
#if DEFGENERIC_CONSTRUCT
struct defmodule *theModule;
struct constructHeader *theDefgeneric;
#endif
/* ============================================
A deffunction cannot be named the same as a
construct type, e.g, defclass, defrule, etc.
============================================ */
if (FindConstruct(theEnv,theDeffunctionName) != NULL)
{
PrintErrorID(theEnv,"DFFNXPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace constructs.\n");
return(FALSE);
}
/* ============================================
A deffunction cannot be named the same as a
pre-defined system function, e.g, watch,
list-defrules, etc.
============================================ */
if (FindFunction(theEnv,theDeffunctionName) != NULL)
{
PrintErrorID(theEnv,"DFFNXPSR",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace external functions.\n");
return(FALSE);
}
#if DEFGENERIC_CONSTRUCT
/* ============================================
A deffunction cannot be named the same as a
generic function (either in this module or
imported from another)
============================================ */
theDefgeneric =
(struct constructHeader *) LookupDefgenericInScope(theEnv,theDeffunctionName);
if (theDefgeneric != NULL)
{
theModule = GetConstructModuleItem(theDefgeneric)->theModule;
if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{
PrintErrorID(theEnv,"DFFNXPSR",5,FALSE);
EnvPrintRouter(theEnv,WERROR,"Defgeneric ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) theDefgeneric));
EnvPrintRouter(theEnv,WERROR," imported from module ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));
EnvPrintRouter(theEnv,WERROR," conflicts with this deffunction.\n");
return(FALSE);
}
else
{
PrintErrorID(theEnv,"DFFNXPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunctions are not allowed to replace generic functions.\n");
}
return(FALSE);
}
#endif
theDeffunction = (struct constructHeader *) EnvFindDeffunction(theEnv,theDeffunctionName);
if (theDeffunction != NULL)
{
/* ===========================================
And a deffunction in the current module can
only be redefined if it is not executing.
=========================================== */
if (((DEFFUNCTION *) theDeffunction)->executing)
{
PrintErrorID(theEnv,"DFNXPSR",4,FALSE);
EnvPrintRouter(theEnv,WERROR,"Deffunction ");
EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));
EnvPrintRouter(theEnv,WERROR," may not be redefined while it is executing.\n");
return(FALSE);
}
}
return(TRUE);
}
/*******************************************************
NAME : DefmessageHandlerWatchSupport
DESCRIPTION : Sets or displays handlers specified
INPUTS : 1) The calling function name
2) The logical output name for displays
(can be NULL)
4) The new set state (can be -1)
5) The print function (can be NULL)
6) The trace function (can be NULL)
7) The handlers expression list
RETURNS : TRUE if all OK,
FALSE otherwise
SIDE EFFECTS : Handler trace flags set or displayed
NOTES : None
*******************************************************/
static unsigned DefmessageHandlerWatchSupport(
void *theEnv,
const char *funcName,
const char *logName,
int newState,
void (*printFunc)(void *,const char *,void *,int),
void (*traceFunc)(void *,int,void *,int),
EXPRESSION *argExprs)
{
struct defmodule *theModule;
void *theClass;
const char *theHandlerStr;
int theType;
int argIndex = 2;
DATA_OBJECT tmpData;
/* ===============================
If no handlers are specified,
show the trace for all handlers
in all handlers
=============================== */
if (argExprs == NULL)
{
SaveCurrentModule(theEnv);
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
while (theModule != NULL)
{
EnvSetCurrentModule(theEnv,(void *) theModule);
if (traceFunc == NULL)
{
EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule));
EnvPrintRouter(theEnv,logName,":\n");
}
theClass = EnvGetNextDefclass(theEnv,NULL);
while (theClass != NULL)
{
if (WatchClassHandlers(theEnv,theClass,NULL,-1,logName,newState,
TRUE,printFunc,traceFunc) == FALSE)
return(FALSE);
theClass = EnvGetNextDefclass(theEnv,theClass);
}
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule);
}
RestoreCurrentModule(theEnv);
return(TRUE);
}
/* ================================================
Set or show the traces for the specified handler
================================================ */
while (argExprs != NULL)
{
if (EvaluateExpression(theEnv,argExprs,&tmpData))
return(FALSE);
if (tmpData.type != SYMBOL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
return(FALSE);
}
theClass = (void *) LookupDefclassByMdlOrScope(theEnv,DOToString(tmpData));
if (theClass == NULL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"class name");
return(FALSE);
}
if (GetNextArgument(argExprs) != NULL)
{
argExprs = GetNextArgument(argExprs);
argIndex++;
if (EvaluateExpression(theEnv,argExprs,&tmpData))
return(FALSE);
if (tmpData.type != SYMBOL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"handler name");
return(FALSE);
}
theHandlerStr = DOToString(tmpData);
if (GetNextArgument(argExprs) != NULL)
{
argExprs = GetNextArgument(argExprs);
argIndex++;
if (EvaluateExpression(theEnv,argExprs,&tmpData))
return(FALSE);
if (tmpData.type != SYMBOL)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"handler type");
return(FALSE);
}
if ((theType = (int) HandlerType(theEnv,funcName,DOToString(tmpData))) == MERROR)
return(FALSE);
}
else
theType = -1;
}
else
{
theHandlerStr = NULL;
theType = -1;
}
if (WatchClassHandlers(theEnv,theClass,theHandlerStr,theType,logName,
newState,FALSE,printFunc,traceFunc) == FALSE)
{
ExpectedTypeError1(theEnv,funcName,argIndex,"handler");
return(FALSE);
}
argIndex++;
argExprs = GetNextArgument(argExprs);
}
return(TRUE);
}
globle intBool ParseDefglobal(
void *theEnv,
char *readSource)
{
int defglobalError = FALSE;
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,readSource)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
struct token theToken;
int tokenRead = TRUE;
struct defmodule *theModule;
/*=====================================*/
/* Pretty print buffer initialization. */
/*=====================================*/
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defglobal ");
/*=================================================*/
/* Individual defglobal constructs can't be parsed */
/* while a binary load is in effect. */
/*=================================================*/
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defglobal");
return(TRUE);
}
#endif
/*===========================*/
/* Look for the module name. */
/*===========================*/
GetToken(theEnv,readSource,&theToken);
if (theToken.type == SYMBOL)
{
/*=================================================*/
/* The optional module name can't contain a module */
/* separator like other constructs. For example, */
/* (defrule X::foo is OK for rules, but the right */
/* syntax for defglobals is (defglobal X ?*foo*. */
/*=================================================*/
tokenRead = FALSE;
if (FindModuleSeparator(ValueToString(theToken.value)))
{
SyntaxErrorMessage(theEnv,"defglobal");
return(TRUE);
}
/*=================================*/
/* Determine if the module exists. */
/*=================================*/
theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value));
if (theModule == NULL)
{
CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value));
return(TRUE);
}
/*=========================================*/
/* If the module name was OK, then set the */
/* current module to the specified module. */
/*=========================================*/
SavePPBuffer(theEnv," ");
EnvSetCurrentModule(theEnv,(void *) theModule);
}
/*===========================================*/
/* If the module name wasn't specified, then */
/* use the current module's name in the */
/* defglobal's pretty print representation. */
/*===========================================*/
else
{
PPBackup(theEnv);
SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,theToken.printForm);
}
/*======================*/
/* Parse the variables. */
/*======================*/
while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken))
{
tokenRead = FALSE;
FlushPPBuffer(theEnv);
SavePPBuffer(theEnv,"(defglobal ");
SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
SavePPBuffer(theEnv," ");
}
#endif
/*==================================*/
/* Return the parsing error status. */
/*==================================*/
return(defglobalError);
}
globle void ListItemsDriver(
void *theEnv,
EXEC_STATUS,
char *logicalName,
struct defmodule *theModule,
char *singleName,
char *pluralName,
void *(*nextFunction)(void *,EXEC_STATUS,void *),
char *(*nameFunction)(void *,EXEC_STATUS),
void (*printFunction)(void *,EXEC_STATUS,char *,void *),
int (*doItFunction)(void *,EXEC_STATUS,void *))
{
void *constructPtr;
char *constructName;
long count = 0;
int allModules = FALSE;
int doIt;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv,execStatus);
/*======================*/
/* Print out the items. */
/*======================*/
if (theModule == NULL)
{
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
allModules = TRUE;
}
while (theModule != NULL)
{
if (allModules)
{
EnvPrintRouter(theEnv,execStatus,logicalName,EnvGetDefmoduleName(theEnv,execStatus,theModule));
EnvPrintRouter(theEnv,execStatus,logicalName,":\n");
}
EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
constructPtr = (*nextFunction)(theEnv,execStatus,NULL);
while (constructPtr != NULL)
{
if (execStatus->HaltExecution == TRUE) return;
if (doItFunction == NULL) doIt = TRUE;
else doIt = (*doItFunction)(theEnv,execStatus,constructPtr);
if (! doIt) {}
else if (nameFunction != NULL)
{
constructName = (*nameFunction)(constructPtr,execStatus);
if (constructName != NULL)
{
if (allModules) EnvPrintRouter(theEnv,execStatus,logicalName," ");
EnvPrintRouter(theEnv,execStatus,logicalName,constructName);
EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
}
}
else if (printFunction != NULL)
{
if (allModules) EnvPrintRouter(theEnv,execStatus,logicalName," ");
(*printFunction)(theEnv,execStatus,logicalName,constructPtr);
EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
}
constructPtr = (*nextFunction)(theEnv,execStatus,constructPtr);
count++;
}
if (allModules) theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule);
else theModule = NULL;
}
/*=================================================*/
/* Print the tally and restore the current module. */
/*=================================================*/
if (singleName != NULL) PrintTally(theEnv,execStatus,logicalName,count,singleName,pluralName);
RestoreCurrentModule(theEnv,execStatus);
}
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);
}
static int ParseImportSpec(
void *theEnv,
char *readSource,
struct token *theToken,
struct defmodule *newModule)
{
struct defmodule *theModule;
struct portItem *thePort, *oldImportSpec;
int found, count;
/*===========================*/
/* Look for the module name. */
/*===========================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,theToken);
if (theToken->type != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmodule import specification");
return(TRUE);
}
/*=====================================*/
/* Verify the existence of the module. */
/*=====================================*/
if ((theModule = (struct defmodule *)
EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL)
{
CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value));
return(TRUE);
}
/*========================================*/
/* If the specified module doesn't export */
/* any constructs, then the import */
/* specification is meaningless. */
/*========================================*/
if (theModule->exportList == NULL)
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL);
return(TRUE);
}
/*==============================================*/
/* Parse the remaining portion of the import */
/* specification and return if an error occurs. */
/*==============================================*/
oldImportSpec = newModule->importList;
if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE);
/*========================================================*/
/* If the ?NONE keyword was used with the import spec, */
/* then no constructs were actually imported and the */
/* import spec does not need to be checked for conflicts. */
/*========================================================*/
if (newModule->importList == oldImportSpec) return(FALSE);
/*======================================================*/
/* Check to see if the construct being imported can be */
/* by the specified module. This check exported doesn't */
/* guarantee that a specific named construct actually */
/* exists. It just checks that it could be exported if */
/* it does exists. */
/*======================================================*/
if (newModule->importList->constructType != NULL)
{
/*=============================*/
/* Look for the construct in */
/* the module that exports it. */
/*=============================*/
found = FALSE;
for (thePort = theModule->exportList;
(thePort != NULL) && (! found);
thePort = thePort->next)
{
if (thePort->constructType == NULL) found = TRUE;
else if (thePort->constructType == newModule->importList->constructType)
{
if (newModule->importList->constructName == NULL) found = TRUE;
else if (thePort->constructName == NULL) found = TRUE;
else if (thePort->constructName == newModule->importList->constructName)
{ found = TRUE; }
}
}
/*=======================================*/
/* If it's not exported by the specified */
/* module, print an error message. */
/*=======================================*/
if (! found)
{
if (newModule->importList->constructName == NULL)
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
ValueToString(newModule->importList->constructType),
NULL);
}
else
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
ValueToString(newModule->importList->constructType),
ValueToString(newModule->importList->constructName));
}
return(TRUE);
}
}
/*======================================================*/
/* Verify that specific named constructs actually exist */
/* and can be seen from the module importing them. */
/*======================================================*/
SaveCurrentModule(theEnv);
EnvSetCurrentModule(theEnv,(void *) newModule);
for (thePort = newModule->importList;
thePort != NULL;
thePort = thePort->next)
{
if ((thePort->constructType == NULL) || (thePort->constructName == NULL))
{ continue; }
theModule = (struct defmodule *)
EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName));
EnvSetCurrentModule(theEnv,theModule);
if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL,
ValueToString(thePort->constructName),&count,
TRUE,FALSE) == NULL)
{
NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
ValueToString(thePort->constructType),
ValueToString(thePort->constructName));
RestoreCurrentModule(theEnv);
return(TRUE);
}
}
RestoreCurrentModule(theEnv);
/*===============================================*/
/* The import list has been successfully parsed. */
/*===============================================*/
return(FALSE);
}
static int FindMultiImportConflict(
void *theEnv,
struct defmodule *theModule)
{
struct defmodule *testModule;
int count;
struct portConstructItem *thePCItem;
struct construct *theConstruct;
void *theCItem;
/*==========================*/
/* Save the current module. */
/*==========================*/
SaveCurrentModule(theEnv);
/*============================*/
/* Loop through every module. */
/*============================*/
for (testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
testModule != NULL;
testModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,testModule))
{
/*========================================*/
/* Loop through every construct type that */
/* can be imported/exported by a module. */
/*========================================*/
for (thePCItem = DefmoduleData(theEnv)->ListOfPortConstructItems;
thePCItem != NULL;
thePCItem = thePCItem->next)
{
EnvSetCurrentModule(theEnv,(void *) testModule);
/*=====================================================*/
/* Loop through every construct of the specified type. */
/*=====================================================*/
theConstruct = FindConstruct(theEnv,thePCItem->constructName);
for (theCItem = (*theConstruct->getNextItemFunction)(theEnv,NULL);
theCItem != NULL;
theCItem = (*theConstruct->getNextItemFunction)(theEnv,theCItem))
{
/*===============================================*/
/* Check to see if the specific construct in the */
/* module can be imported with more than one */
/* reference into the module we're examining for */
/* ambiguous import specifications. */
/*===============================================*/
EnvSetCurrentModule(theEnv,(void *) theModule);
FindImportedConstruct(theEnv,thePCItem->constructName,NULL,
ValueToString((*theConstruct->getConstructNameFunction)
((struct constructHeader *) theCItem)),
&count,FALSE,NULL);
if (count > 1)
{
ImportExportConflictMessage(theEnv,"defmodule",EnvGetDefmoduleName(theEnv,theModule),
thePCItem->constructName,
ValueToString((*theConstruct->getConstructNameFunction)
((struct constructHeader *) theCItem)));
RestoreCurrentModule(theEnv);
return(TRUE);
}
EnvSetCurrentModule(theEnv,(void *) testModule);
}
}
}
/*=============================*/
/* Restore the current module. */
/*=============================*/
RestoreCurrentModule(theEnv);
/*=======================================*/
/* Return FALSE to indicate no ambiguous */
/* references were found. */
/*=======================================*/
return(FALSE);
}
globle void EnvShowDefglobals(
void *theEnv,
char *logicalName,
void *vTheModule)
{
struct defmodule *theModule = (struct defmodule *) vTheModule;
struct constructHeader *constructPtr;
int allModules = FALSE;
struct defmoduleItemHeader *theModuleItem;
/*=======================================*/
/* If the module specified is NULL, then */
/* list all constructs in all modules. */
/*=======================================*/
if (theModule == NULL)
{
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
allModules = TRUE;
}
/*======================================================*/
/* Print out the constructs in the specified module(s). */
/*======================================================*/
for (;
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule))
{
/*===========================================*/
/* Print the module name before every group */
/* of defglobals listed if we're listing the */
/* defglobals from every module. */
/*===========================================*/
if (allModules)
{
EnvPrintRouter(theEnv,logicalName,EnvGetDefmoduleName(theEnv,theModule));
EnvPrintRouter(theEnv,logicalName,":\n");
}
/*=====================================*/
/* Print every defglobal in the module */
/* currently being examined. */
/*=====================================*/
theModuleItem = (struct defmoduleItemHeader *) GetModuleItem(theEnv,theModule,DefglobalData(theEnv)->DefglobalModuleIndex);
for (constructPtr = theModuleItem->firstItem;
constructPtr != NULL;
constructPtr = constructPtr->next)
{
if (EvaluationData(theEnv)->HaltExecution == TRUE) return;
if (allModules) EnvPrintRouter(theEnv,logicalName," ");
PrintDefglobalValueForm(theEnv,logicalName,(void *) constructPtr);
EnvPrintRouter(theEnv,logicalName,"\n");
}
/*===================================*/
/* If we're only listing the globals */
/* for one module, then return. */
/*===================================*/
if (! allModules) return;
}
}