📄 inscom.c
字号:
return;
theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(temp));
if ((theModule == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE)
{
ExpectedTypeError1(theEnv,"instance-address",1,"module name");
SetEvaluationError(theEnv,TRUE);
return;
}
if (theModule == NULL)
{
searchImports = TRUE;
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
}
else
searchImports = FALSE;
if (EnvArgTypeCheck(theEnv,"instance-address",2,INSTANCE_NAME,&temp)
== FALSE)
return;
ins = FindInstanceInModule(theEnv,(SYMBOL_HN *) temp.value,theModule,
((struct defmodule *) EnvGetCurrentModule(theEnv)),searchImports);
if (ins != NULL)
{
result->type = INSTANCE_ADDRESS;
result->value = (void *) ins;
}
else
NoInstanceError(theEnv,ValueToString(temp.value),"instance-address");
}
else if (EnvArgTypeCheck(theEnv,"instance-address",1,INSTANCE_OR_INSTANCE_NAME,&temp))
{
if (temp.type == INSTANCE_ADDRESS)
{
ins = (INSTANCE_TYPE *) temp.value;
if (ins->garbage == 0)
{
result->type = INSTANCE_ADDRESS;
result->value = temp.value;
}
else
{
StaleInstanceAddress(theEnv,"instance-address",0);
SetEvaluationError(theEnv,TRUE);
}
}
else
{
ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
if (ins != NULL)
{
result->type = INSTANCE_ADDRESS;
result->value = (void *) ins;
}
else
NoInstanceError(theEnv,ValueToString(temp.value),"instance-address");
}
}
}
/***************************************************************
NAME : InstanceNameCommand
DESCRIPTION : Gets the name of an INSTANCE
INPUTS : The address of the value buffer
RETURNS : The INSTANCE_NAME symbol
SIDE EFFECTS : None
NOTES : H/L Syntax : (instance-name <instance>)
***************************************************************/
globle void InstanceNameCommand(
void *theEnv,
DATA_OBJECT *result)
{
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
if (EnvArgTypeCheck(theEnv,"instance-name",1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE)
return;
if (temp.type == INSTANCE_ADDRESS)
{
ins = (INSTANCE_TYPE *) temp.value;
if (ins->garbage == 1)
{
StaleInstanceAddress(theEnv,"instance-name",0);
SetEvaluationError(theEnv,TRUE);
return;
}
}
else
{
ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
if (ins == NULL)
{
NoInstanceError(theEnv,ValueToString(temp.value),"instance-name");
return;
}
}
result->type = INSTANCE_NAME;
result->value = (void *) ins->name;
}
/**************************************************************
NAME : InstanceAddressPCommand
DESCRIPTION : Determines if a value is of type INSTANCE
INPUTS : None
RETURNS : TRUE if type INSTANCE_ADDRESS, FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (instance-addressp <arg>)
**************************************************************/
globle intBool InstanceAddressPCommand(
void *theEnv)
{
DATA_OBJECT temp;
EvaluateExpression(theEnv,GetFirstArgument(),&temp);
return((GetType(temp) == INSTANCE_ADDRESS) ? TRUE : FALSE);
}
/**************************************************************
NAME : InstanceNamePCommand
DESCRIPTION : Determines if a value is of type INSTANCE_NAME
INPUTS : None
RETURNS : TRUE if type INSTANCE_NAME, FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (instance-namep <arg>)
**************************************************************/
globle intBool InstanceNamePCommand(
void *theEnv)
{
DATA_OBJECT temp;
EvaluateExpression(theEnv,GetFirstArgument(),&temp);
return((GetType(temp) == INSTANCE_NAME) ? TRUE : FALSE);
}
/*****************************************************************
NAME : InstancePCommand
DESCRIPTION : Determines if a value is of type INSTANCE_ADDRESS
or INSTANCE_NAME
INPUTS : None
RETURNS : TRUE if type INSTANCE_NAME or INSTANCE_ADDRESS,
FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (instancep <arg>)
*****************************************************************/
globle intBool InstancePCommand(
void *theEnv)
{
DATA_OBJECT temp;
EvaluateExpression(theEnv,GetFirstArgument(),&temp);
if ((GetType(temp) == INSTANCE_NAME) || (GetType(temp) == INSTANCE_ADDRESS))
return(TRUE);
return(FALSE);
}
/********************************************************
NAME : InstanceExistPCommand
DESCRIPTION : Determines if an instance exists
INPUTS : None
RETURNS : TRUE if instance exists, FALSE otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (instance-existp <arg>)
********************************************************/
globle intBool InstanceExistPCommand(
void *theEnv)
{
DATA_OBJECT temp;
EvaluateExpression(theEnv,GetFirstArgument(),&temp);
if (temp.type == INSTANCE_ADDRESS)
return((((INSTANCE_TYPE *) temp.value)->garbage == 0) ? TRUE : FALSE);
if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL))
return((FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value) != NULL) ?
TRUE : FALSE);
ExpectedTypeError1(theEnv,"instance-existp",1,"instance name, instance address or symbol");
SetEvaluationError(theEnv,TRUE);
return(FALSE);
}
/* =========================================
*****************************************
INTERNALLY VISIBLE FUNCTIONS
=========================================
***************************************** */
#if DEBUGGING_FUNCTIONS
/***************************************************
NAME : ListInstancesInModule
DESCRIPTION : List instances of specified
class(es) in a module
INPUTS : 1) Traversal id to avoid multiple
passes over same class
2) Logical name of output
3) The name of the class
(NULL for all classes)
4) Flag indicating whether to
include instances of subclasses
5) A flag indicating whether to
indent because of module name
RETURNS : The number of instances listed
SIDE EFFECTS : Instances listed to logical output
NOTES : Assumes defclass scope flags
are up to date
***************************************************/
static long ListInstancesInModule(
void *theEnv,
int id,
char *logicalName,
char *className,
intBool inheritFlag,
intBool allModulesFlag)
{
void *theDefclass,*theInstance;
long count = 0L;
/* ===================================
For the specified module, print out
instances of all the classes
=================================== */
if (className == NULL)
{
/* ==============================================
If instances are being listed for all modules,
only list the instances of classes in this
module (to avoid listing instances twice)
============================================== */
if (allModulesFlag)
{
for (theDefclass = EnvGetNextDefclass(theEnv,NULL) ;
theDefclass != NULL ;
theDefclass = EnvGetNextDefclass(theEnv,theDefclass))
count += TabulateInstances(theEnv,id,logicalName,
(DEFCLASS *) theDefclass,FALSE,allModulesFlag);
}
/* ===================================================
If instances are only be listed for one module,
list all instances visible to the module (including
ones belonging to classes in other modules)
=================================================== */
else
{
theInstance = GetNextInstanceInScope(theEnv,NULL);
while (theInstance != NULL)
{
if (GetHaltExecution(theEnv) == TRUE)
{ return(count); }
count++;
PrintInstanceNameAndClass(theEnv,logicalName,(INSTANCE_TYPE *) theInstance,TRUE);
theInstance = GetNextInstanceInScope(theEnv,theInstance);
}
}
}
/* ===================================
For the specified module, print out
instances of the specified class
=================================== */
else
{
theDefclass = (void *) LookupDefclassAnywhere(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)),className);
if (theDefclass != NULL)
{
count += TabulateInstances(theEnv,id,logicalName,
(DEFCLASS *) theDefclass,inheritFlag,allModulesFlag);
}
else if (! allModulesFlag)
ClassExistError(theEnv,"instances",className);
}
return(count);
}
/******************************************************
NAME : TabulateInstances
DESCRIPTION : Displays all instances for a class
INPUTS : 1) The traversal id for the classes
2) The logical name of the output
3) The class address
4) A flag indicating whether to
print out instances of subclasses
or not.
5) A flag indicating whether to
indent because of module name
RETURNS : The number of instances (including
subclasses' instances)
SIDE EFFECTS : None
NOTES : None
******************************************************/
static long TabulateInstances(
void *theEnv,
int id,
char *logicalName,
DEFCLASS *cls,
intBool inheritFlag,
intBool allModulesFlag)
{
INSTANCE_TYPE *ins;
register unsigned i;
long count = 0;
if (TestTraversalID(cls->traversalRecord,id))
return(0L);
SetTraversalID(cls->traversalRecord,id);
for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass)
{
if (EvaluationData(theEnv)->HaltExecution)
return(count);
if (allModulesFlag)
EnvPrintRouter(theEnv,logicalName," ");
PrintInstanceNameAndClass(theEnv,logicalName,ins,TRUE);
count++;
}
if (inheritFlag)
{
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
if (EvaluationData(theEnv)->HaltExecution)
return(count);
count += TabulateInstances(theEnv,id,logicalName,
cls->directSubclasses.classArray[i],inheritFlag,allModulesFlag);
}
}
return(count);
}
#endif
/***************************************************
NAME : PrintInstance
DESCRIPTION : Displays an instance's slots
INPUTS : 1) Logical name for output
2) Instance address
3) String used to separate
slot printouts
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : Assumes instance is valid
***************************************************/
static void PrintInstance(
void *theEnv,
char *logicalName,
INSTANCE_TYPE *ins,
char *separator)
{
register unsigned i;
register INSTANCE_SLOT *sp;
PrintInstanceNameAndClass(theEnv,logicalName,ins,FALSE);
for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
{
EnvPrintRouter(theEnv,logicalName,separator);
sp = ins->slotAddresses[i];
EnvPrintRouter(theEnv,logicalName,"(");
EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name));
if (sp->type != MULTIFIELD)
{
EnvPrintRouter(theEnv,logicalName," ");
PrintAtom(theEnv,logicalName,(int) sp->type,sp->value);
}
else if (GetInstanceSlotLength(sp) != 0)
{
EnvPrintRouter(theEnv,logicalName," ");
PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0,
(long) (GetInstanceSlotLength(sp) - 1),FALSE);
}
EnvPrintRouter(theEnv,logicalName,")");
}
}
/***************************************************
NAME : FindISlotByName
DESCRIPTION : Looks up an instance slot by
instance name and slot name
INPUTS : 1) Instance address
2) Instance name-string
RETURNS : The instance slot address, NULL if
does not exist
SIDE EFFECTS : None
NOTES : None
***************************************************/
static INSTANCE_SLOT *FindISlotByName(
void *theEnv,
INSTANCE_TYPE *ins,
char *sname)
{
SYMBOL_HN *ssym;
ssym = FindSymbolHN(theEnv,sname);
if (ssym == NULL)
return(NULL);
return(FindInstanceSlot(theEnv,ins,ssym));
}
#endif
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -