📄 classini.c
字号:
NOTES : None
*********************************************************/
static void SetupDefclasses(
void *theEnv)
{
InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR);
DefclassData(theEnv)->DefclassModuleIndex =
RegisterModuleItem(theEnv,"defclass",
#if (! RUN_TIME)
AllocateModule,ReturnModule,
#else
NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
BloadDefclassModuleReference,
#else
NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
DefclassCModuleReference,
#else
NULL,
#endif
EnvFindDefclass);
DefclassData(theEnv)->DefclassConstruct = AddConstruct(theEnv,"defclass","defclasses",
#if (! BLOAD_ONLY) && (! RUN_TIME)
ParseDefclass,
#else
NULL,
#endif
EnvFindDefclass,
GetConstructNamePointer,GetConstructPPForm,
GetConstructModuleItem,EnvGetNextDefclass,
SetNextConstruct,EnvIsDefclassDeletable,
EnvUndefclass,
#if (! RUN_TIME)
RemoveDefclass
#else
NULL
#endif
);
AddClearReadyFunction(theEnv,"defclass",InstancesPurge,0);
#if ! RUN_TIME
EnvAddClearFunction(theEnv,"defclass",CreateSystemClasses,0);
InitializeClasses(theEnv);
#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
AddPortConstructItem(theEnv,"defclass",SYMBOL);
AddAfterModuleDefinedFunction(theEnv,"defclass",UpdateDefclassesScope,0);
#endif
EnvDefineFunction2(theEnv,"undefclass",'v',PTIEF UndefclassCommand,"UndefclassCommand","11w");
AddSaveFunction(theEnv,"defclass",SaveDefclasses,10);
#endif
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"list-defclasses",'v',PTIEF ListDefclassesCommand,"ListDefclassesCommand","01");
EnvDefineFunction2(theEnv,"ppdefclass",'v',PTIEF PPDefclassCommand,"PPDefclassCommand","11w");
EnvDefineFunction2(theEnv,"describe-class",'v',PTIEF DescribeClassCommand,"DescribeClassCommand","11w");
EnvDefineFunction2(theEnv,"browse-classes",'v',PTIEF BrowseClassesCommand,"BrowseClassesCommand","01w");
#endif
EnvDefineFunction2(theEnv,"get-defclass-list",'m',PTIEF GetDefclassListFunction,
"GetDefclassListFunction","01");
EnvDefineFunction2(theEnv,"superclassp",'b',PTIEF SuperclassPCommand,"SuperclassPCommand","22w");
EnvDefineFunction2(theEnv,"subclassp",'b',PTIEF SubclassPCommand,"SubclassPCommand","22w");
EnvDefineFunction2(theEnv,"class-existp",'b',PTIEF ClassExistPCommand,"ClassExistPCommand","11w");
EnvDefineFunction2(theEnv,"message-handler-existp",'b',
PTIEF MessageHandlerExistPCommand,"MessageHandlerExistPCommand","23w");
EnvDefineFunction2(theEnv,"class-abstractp",'b',PTIEF ClassAbstractPCommand,"ClassAbstractPCommand","11w");
#if DEFRULE_CONSTRUCT
EnvDefineFunction2(theEnv,"class-reactivep",'b',PTIEF ClassReactivePCommand,"ClassReactivePCommand","11w");
#endif
EnvDefineFunction2(theEnv,"class-slots",'m',PTIEF ClassSlotsCommand,"ClassSlotsCommand","12w");
EnvDefineFunction2(theEnv,"class-superclasses",'m',
PTIEF ClassSuperclassesCommand,"ClassSuperclassesCommand","12w");
EnvDefineFunction2(theEnv,"class-subclasses",'m',
PTIEF ClassSubclassesCommand,"ClassSubclassesCommand","12w");
EnvDefineFunction2(theEnv,"get-defmessage-handler-list",'m',
PTIEF GetDefmessageHandlersListCmd,"GetDefmessageHandlersListCmd","02w");
EnvDefineFunction2(theEnv,"slot-existp",'b',PTIEF SlotExistPCommand,"SlotExistPCommand","23w");
EnvDefineFunction2(theEnv,"slot-facets",'m',PTIEF SlotFacetsCommand,"SlotFacetsCommand","22w");
EnvDefineFunction2(theEnv,"slot-sources",'m',PTIEF SlotSourcesCommand,"SlotSourcesCommand","22w");
EnvDefineFunction2(theEnv,"slot-types",'m',PTIEF SlotTypesCommand,"SlotTypesCommand","22w");
EnvDefineFunction2(theEnv,"slot-allowed-values",'m',PTIEF SlotAllowedValuesCommand,"SlotAllowedValuesCommand","22w");
EnvDefineFunction2(theEnv,"slot-allowed-classes",'m',PTIEF SlotAllowedClassesCommand,"SlotAllowedClassesCommand","22w");
EnvDefineFunction2(theEnv,"slot-range",'m',PTIEF SlotRangeCommand,"SlotRangeCommand","22w");
EnvDefineFunction2(theEnv,"slot-cardinality",'m',PTIEF SlotCardinalityCommand,"SlotCardinalityCommand","22w");
EnvDefineFunction2(theEnv,"slot-writablep",'b',PTIEF SlotWritablePCommand,"SlotWritablePCommand","22w");
EnvDefineFunction2(theEnv,"slot-initablep",'b',PTIEF SlotInitablePCommand,"SlotInitablePCommand","22w");
EnvDefineFunction2(theEnv,"slot-publicp",'b',PTIEF SlotPublicPCommand,"SlotPublicPCommand","22w");
EnvDefineFunction2(theEnv,"slot-direct-accessp",'b',PTIEF SlotDirectAccessPCommand,
"SlotDirectAccessPCommand","22w");
EnvDefineFunction2(theEnv,"slot-default-value",'u',PTIEF SlotDefaultValueCommand,
"SlotDefaultValueCommand","22w");
EnvDefineFunction2(theEnv,"defclass-module",'w',PTIEF GetDefclassModuleCommand,
"GetDefclassModuleCommand","11w");
EnvDefineFunction2(theEnv,"get-class-defaults-mode", 'w', PTIEF GetClassDefaultsModeCommand, "GetClassDefaultsModeCommand", "00");
EnvDefineFunction2(theEnv,"set-class-defaults-mode", 'w', PTIEF SetClassDefaultsModeCommand, "SetClassDefaultsModeCommand", "11w");
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint);
AddWatchItem(theEnv,"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint);
#endif
}
#if (! RUN_TIME)
/*********************************************************
NAME : AddSystemClass
DESCRIPTION : Performs all necessary allocations
for adding a system class
INPUTS : 1) The name-string of the system class
2) The address of the parent class
(NULL if none)
RETURNS : The address of the new system class
SIDE EFFECTS : Allocations performed
NOTES : Assumes system-class name is unique
Also assumes SINGLE INHERITANCE for
system classes to simplify precedence
list determination
Adds classes to has table but NOT to
class list (this is responsibility
of caller)
*********************************************************/
static DEFCLASS *AddSystemClass(
void *theEnv,
char *name,
DEFCLASS *parent)
{
DEFCLASS *sys;
register unsigned i;
char defaultScopeMap[1];
sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));
sys->abstract = 1;
#if DEFRULE_CONSTRUCT
sys->reactive = 0;
#endif
IncrementSymbolCount(sys->header.name);
sys->installed = 1;
sys->system = 1;
sys->hashTableIndex = HashClass(sys->header.name);
AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);
if (parent != NULL)
{
AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);
AddClassLink(theEnv,&parent->directSubclasses,sys,-1);
AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);
for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);
}
sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];
DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;
/* =========================================
Add default scope maps for a system class
There is only one module (MAIN) so far -
which has an id of 0
========================================= */
ClearBitString((void *) defaultScopeMap,(int) sizeof(char));
SetBitMap(defaultScopeMap,0);
#if DEFMODULE_CONSTRUCT
sys->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));
IncrementBitMapCount(sys->scopeMap);
#endif
return(sys);
}
/*****************************************************
NAME : AllocateModule
DESCRIPTION : Creates and initializes a
list of deffunctions for a new module
INPUTS : None
RETURNS : The new deffunction module
SIDE EFFECTS : Deffunction module created
NOTES : None
*****************************************************/
static void *AllocateModule(
void *theEnv)
{
return((void *) get_struct(theEnv,defclassModule));
}
/***************************************************
NAME : ReturnModule
DESCRIPTION : Removes a deffunction module and
all associated deffunctions
INPUTS : The deffunction module
RETURNS : Nothing useful
SIDE EFFECTS : Module and deffunctions deleted
NOTES : None
***************************************************/
static void ReturnModule(
void *theEnv,
void *theItem)
{
FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefclassData(theEnv)->DefclassConstruct);
DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,ISA_ID));
DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,NAME_ID));
rtn_struct(theEnv,defclassModule,theItem);
}
#endif
#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
/***************************************************
NAME : UpdateDefclassesScope
DESCRIPTION : This function updates the scope
bitmaps for existing classes when
a new module is defined
INPUTS : None
RETURNS : Nothing
SIDE EFFECTS : Class scope bitmaps are updated
NOTES : None
***************************************************/
static void UpdateDefclassesScope(
void *theEnv)
{
register unsigned i;
DEFCLASS *theDefclass;
int newModuleID,count;
char *newScopeMap;
unsigned newScopeMapSize;
char *className;
struct defmodule *matchModule;
newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID;
newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
newScopeMap = (char *) gm2(theEnv,newScopeMapSize);
for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)
for (theDefclass = DefclassData(theEnv)->ClassTable[i] ;
theDefclass != NULL ;
theDefclass = theDefclass->nxtHash)
{
matchModule = theDefclass->header.whichModule->theModule;
className = ValueToString(theDefclass->header.name);
ClearBitString((void *) newScopeMap,newScopeMapSize);
GenCopyMemory(char,theDefclass->scopeMap->size,
newScopeMap,ValueToBitMap(theDefclass->scopeMap));
DecrementBitMapCount(theEnv,theDefclass->scopeMap);
if (theDefclass->system)
SetBitMap(newScopeMap,newModuleID);
else if (FindImportedConstruct(theEnv,"defclass",matchModule,
className,&count,TRUE,NULL) != NULL)
SetBitMap(newScopeMap,newModuleID);
theDefclass->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize);
IncrementBitMapCount(theDefclass->scopeMap);
}
rm(theEnv,(void *) newScopeMap,newScopeMapSize);
}
#endif
#endif
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -