📄 classfun.c
字号:
for (i = 0 ; i < cls->slotCount ; i++)
{
slot = &cls->slots[i];
DecrementSymbolCount(theEnv,slot->overrideMessage);
if (slot->defaultValue != NULL)
{
if (slot->dynamicDefault)
ExpressionDeinstall(theEnv,(EXPRESSION *) slot->defaultValue);
else
ValueDeinstall(theEnv,(DATA_OBJECT *) slot->defaultValue);
}
}
for (i = 0 ; i < cls->handlerCount ; i++)
{
hnd = &cls->handlers[i];
DecrementSymbolCount(theEnv,hnd->name);
if (hnd->actions != NULL)
ExpressionDeinstall(theEnv,hnd->actions);
}
}
else
{
cls->installed = 1;
IncrementSymbolCount(cls->header.name);
}
}
#endif
#if (! BLOAD_ONLY) && (! RUN_TIME)
/***************************************************
NAME : IsClassBeingUsed
DESCRIPTION : Checks the busy flag of a class
and ALL classes that inherit from
it to make sure that it is not
in use before deletion
INPUTS : The class
RETURNS : TRUE if in use, FALSE otherwise
SIDE EFFECTS : None
NOTES : Recursively examines all subclasses
***************************************************/
globle int IsClassBeingUsed(
DEFCLASS *cls)
{
register unsigned i;
if (cls->busy > 0)
return(TRUE);
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
if (IsClassBeingUsed(cls->directSubclasses.classArray[i]))
return(TRUE);
return(FALSE);
}
/***************************************************
NAME : RemoveAllUserClasses
DESCRIPTION : Removes all classes
INPUTS : None
RETURNS : TRUE if succesful, FALSE otherwise
SIDE EFFECTS : The class hash table is cleared
NOTES : None
***************************************************/
globle int RemoveAllUserClasses(
void *theEnv)
{
void *userClasses,*ctmp;
int success = TRUE;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv))
return(FALSE);
#endif
/* ====================================================
Don't delete built-in system classes at head of list
==================================================== */
userClasses = EnvGetNextDefclass(theEnv,NULL);
while (userClasses != NULL)
{
if (((DEFCLASS *) userClasses)->system == 0)
break;
userClasses = EnvGetNextDefclass(theEnv,userClasses);
}
while (userClasses != NULL)
{
ctmp = userClasses;
userClasses = EnvGetNextDefclass(theEnv,userClasses);
if (EnvIsDefclassDeletable(theEnv,ctmp))
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) ctmp);
RemoveDefclass(theEnv,ctmp);
}
else
{
success = FALSE;
CantDeleteItemErrorMessage(theEnv,"defclass",EnvGetDefclassName(theEnv,ctmp));
}
}
return(success);
}
/****************************************************
NAME : DeleteClassUAG
DESCRIPTION : Deallocates a class and all its
subclasses
INPUTS : The address of the class
RETURNS : 1 if successful, 0 otherwise
SIDE EFFECTS : Removes the class from each of
its superclasses' subclass lists
NOTES : None
****************************************************/
globle int DeleteClassUAG(
void *theEnv,
DEFCLASS *cls)
{
unsigned subCount;
while (cls->directSubclasses.classCount != 0)
{
subCount = cls->directSubclasses.classCount;
DeleteClassUAG(theEnv,cls->directSubclasses.classArray[0]);
if (cls->directSubclasses.classCount == subCount)
return(FALSE);
}
if (EnvIsDefclassDeletable(theEnv,(void *) cls))
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) cls);
RemoveDefclass(theEnv,(void *) cls);
return(TRUE);
}
return(FALSE);
}
/*********************************************************
NAME : MarkBitMapSubclasses
DESCRIPTION : Recursively marks the ids of a class
and all its subclasses in a bitmap
INPUTS : 1) The bitmap
2) The class
3) A code indicating whether to set
or clear the bits of the map
corresponding to the class ids
RETURNS : Nothing useful
SIDE EFFECTS : BitMap marked
NOTES : IMPORTANT!!!! Assumes the bitmap is
large enough to hold all ids encountered!
*********************************************************/
globle void MarkBitMapSubclasses(
char *map,
DEFCLASS *cls,
int set)
{
register unsigned i;
if (set)
SetBitMap(map,cls->id);
else
ClearBitMap(map,cls->id);
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
MarkBitMapSubclasses(map,cls->directSubclasses.classArray[i],set);
}
#endif
/***************************************************
NAME : FindSlotNameID
DESCRIPTION : Finds the id of a slot name
INPUTS : The slot name
RETURNS : The slot name id (-1 if not found)
SIDE EFFECTS : None
NOTES : A slot name always has the same
id regardless of what class uses
it. In this way, a slot can
be referred to by index independent
of class. Each class stores a
map showing which slot name indices
go to which slot. This provides
for immediate lookup of slots
given the index (object pattern
matching uses this).
***************************************************/
globle short FindSlotNameID(
void *theEnv,
SYMBOL_HN *slotName)
{
SLOT_NAME *snp;
snp = DefclassData(theEnv)->SlotNameTable[HashSlotName(slotName)];
while ((snp != NULL) ? (snp->name != slotName) : FALSE)
snp = snp->nxt;
return((snp != NULL) ? (short) snp->id : (short) -1);
}
/***************************************************
NAME : FindIDSlotName
DESCRIPTION : Finds the slot anme for an id
INPUTS : The id
RETURNS : The slot name (NULL if not found)
SIDE EFFECTS : None
NOTES : None
***************************************************/
globle SYMBOL_HN *FindIDSlotName(
void *theEnv,
unsigned id)
{
SLOT_NAME *snp;
snp = FindIDSlotNameHash(theEnv,id);
return((snp != NULL) ? snp->name : NULL);
}
/***************************************************
NAME : FindIDSlotNameHash
DESCRIPTION : Finds the slot anme for an id
INPUTS : The id
RETURNS : The slot name (NULL if not found)
SIDE EFFECTS : None
NOTES : None
***************************************************/
globle SLOT_NAME *FindIDSlotNameHash(
void *theEnv,
unsigned id)
{
register int i;
SLOT_NAME *snp;
for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++)
{
snp = DefclassData(theEnv)->SlotNameTable[i];
while (snp != NULL)
{
if (snp->id == id)
return(snp);
snp = snp->nxt;
}
}
return(NULL);
}
/***************************************************
NAME : GetTraversalID
DESCRIPTION : Returns a unique integer ID for a
traversal into the class hierarchy
INPUTS : None
RETURNS : The id, or -1 if none available
SIDE EFFECTS : EvaluationError set when no ids
available
NOTES : Used for recursive traversals of
class hierarchy to assure that a
class is only visited once
***************************************************/
globle int GetTraversalID(
void *theEnv)
{
register unsigned i;
register DEFCLASS *cls;
if (DefclassData(theEnv)->CTID >= MAX_TRAVERSALS)
{
PrintErrorID(theEnv,"CLASSFUN",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Maximum number of simultaneous class hierarchy\n traversals exceeded ");
PrintLongInteger(theEnv,WERROR,(long) MAX_TRAVERSALS);
EnvPrintRouter(theEnv,WERROR,".\n");
SetEvaluationError(theEnv,TRUE);
return(-1);
}
for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)
for (cls = DefclassData(theEnv)->ClassTable[i] ; cls != NULL ; cls = cls->nxtHash)
ClearTraversalID(cls->traversalRecord,DefclassData(theEnv)->CTID);
return(DefclassData(theEnv)->CTID++);
}
/***************************************************
NAME : ReleaseTraversalID
DESCRIPTION : Releases an ID for future use
Also clears id from all classes
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Old ID released for later reuse
NOTES : Releases ID returned by most recent
call to GetTraversalID()
***************************************************/
globle void ReleaseTraversalID(
void *theEnv)
{
DefclassData(theEnv)->CTID--;
}
/*******************************************************
NAME : HashClass
DESCRIPTION : Generates a hash index for a given
class name
INPUTS : The address of the class name SYMBOL_HN
RETURNS : The hash index value
SIDE EFFECTS : None
NOTES : Counts on the fact that the symbol
has already been hashed into the
symbol table - uses that hash value
multiplied by a prime for a new hash
*******************************************************/
globle unsigned HashClass(
SYMBOL_HN *cname)
{
unsigned long tally;
tally = ((unsigned long) cname->bucket) * BIG_PRIME;
return((unsigned) (tally % CLASS_TABLE_HASH_SIZE));
}
/* =========================================
*****************************************
INTERNALLY VISIBLE FUNCTIONS
=========================================
***************************************** */
/*******************************************************
NAME : HashSlotName
DESCRIPTION : Generates a hash index for a given
slot name
INPUTS : The address of the slot name SYMBOL_HN
RETURNS : The hash index value
SIDE EFFECTS : None
NOTES : Counts on the fact that the symbol
has already been hashed into the
symbol table - uses that hash value
multiplied by a prime for a new hash
*******************************************************/
static unsigned HashSlotName(
SYMBOL_HN *sname)
{
unsigned long tally;
tally = ((unsigned long) sname->bucket) * BIG_PRIME;
return((unsigned) (tally % SLOT_NAME_TABLE_HASH_SIZE));
}
#if (! RUN_TIME)
/***********************************************
NAME : NewSlotNameID
DESCRIPTION : Returns an unused slot name id
as close to 1 as possible
INPUTS : None
RETURNS : The new unused id
SIDE EFFECTS : None
NOTES : None
***********************************************/
static unsigned NewSlotNameID(
void *theEnv)
{
unsigned newid = 0;
register unsigned i;
SLOT_NAME *snp;
while (TRUE)
{
for (i = 0 ; i < SLOT_NAME_TABLE_HASH_SIZE ; i++)
{
snp = DefclassData(theEnv)->SlotNameTable[i];
while ((snp != NULL) ? (snp->id != newid) : FALSE)
snp = snp->nxt;
if (snp != NULL)
break;
}
if (i < SLOT_NAME_TABLE_HASH_SIZE)
newid++;
else
break;
}
return(newid);
}
/***************************************************
NAME : DeassignClassID
DESCRIPTION : Reduces id map and MaxClassID if
no ids in use above the one being
released.
INPUTS : The id
RETURNS : Nothing useful
SIDE EFFECTS : ID map and MaxClassID possibly
reduced
NOTES : None
***************************************************/
static void DeassignClassID(
void *theEnv,
unsigned id)
{
register unsigned i;
int reallocReqd;
unsigned short oldChunk = 0,newChunk = 0;
DefclassData(theEnv)->ClassIDMap[id] = NULL;
for (i = id + 1 ; i < DefclassData(theEnv)->MaxClassID ; i++)
if (DefclassData(theEnv)->ClassIDMap[i] != NULL)
return;
reallocReqd = FALSE;
while (DefclassData(theEnv)->ClassIDMap[id] == NULL)
{
DefclassData(theEnv)->MaxClassID = (unsigned short) id;
if ((DefclassData(theEnv)->MaxClassID % CLASS_ID_MAP_CHUNK) == 0)
{
newChunk = DefclassData(theEnv)->MaxClassID;
if (reallocReqd == FALSE)
{
oldChunk = (unsigned short) (DefclassData(theEnv)->MaxClassID + CLASS_ID_MAP_CHUNK);
reallocReqd = TRUE;
}
}
if (id == 0)
break;
id--;
}
if (reallocReqd)
{
DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) genrealloc(theEnv,(void *) DefclassData(theEnv)->ClassIDMap,
(unsigned) (oldChunk * sizeof(DEFCLASS *)),
(unsigned) (newChunk * sizeof(DEFCLASS *)));
DefclassData(theEnv)->AvailClassID = newChunk;
}
}
#endif
#endif
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -