/*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference ***************************************************/ static intBool ReplaceClassNameWithReference( void *theEnv, EXPRESSION *theExp) { char *theClassName; void *theDefclass; if (theExp->type == SYMBOL) { theClassName = ValueToString(theExp->value); theDefclass = (void *) LookupDefclassInScope(theEnv,theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage(theEnv,(char*)"class",theClassName); return(FALSE); } if (EnvClassAbstractP(theEnv,theDefclass)) { PrintErrorID(theEnv,(char*)"INSMNGR",3,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"Cannot create instances of abstract class "); EnvPrintRouter(theEnv,WERROR,theClassName); EnvPrintRouter(theEnv,WERROR,(char*)".\n"); return(FALSE); } theExp->type = DEFCLASS_PTR; theExp->value = theDefclass; } return(TRUE); }
/*************************************************** NAME : LookupDefclassByMdlOrScope DESCRIPTION : Finds a class anywhere (if module is specified) or in current or imported modules INPUTS : The class name RETURNS : The class (NULL if not found) SIDE EFFECTS : Error message printed on ambiguous references NOTES : Assumes no two classes of the same name are ever in the same scope ***************************************************/ globle DEFCLASS *LookupDefclassByMdlOrScope( void *theEnv, const char *classAndModuleName) { DEFCLASS *cls; const char *className; SYMBOL_HN *classSymbol; struct defmodule *theModule; if (FindModuleSeparator(classAndModuleName) == FALSE) return(LookupDefclassInScope(theEnv,classAndModuleName)); SaveCurrentModule(theEnv); className = ExtractModuleAndConstructName(theEnv,classAndModuleName); theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); RestoreCurrentModule(theEnv); if(className == NULL) return(NULL); if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL) return(NULL); cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)]; while (cls != NULL) { if ((cls->header.name == classSymbol) && (cls->header.whichModule->theModule == theModule)) return(cls->installed ? cls : NULL); cls = cls->nxtHash; } return(NULL); }
/*************************************************** NAME : ReplaceClassNameWithReference DESCRIPTION : In parsing a make instance call, this function replaces a constant class name with an actual pointer to the class INPUTS : The expression RETURNS : TRUE if all OK, FALSE if class cannot be found SIDE EFFECTS : The expression type and value are modified if class is found NOTES : Searches current nd imported modules for reference ***************************************************/ static BOOLEAN ReplaceClassNameWithReference( EXPRESSION *exp) { char *theClassName; void *theDefclass; if (exp->type == SYMBOL) { theClassName = ValueToString(exp->value); theDefclass = (void *) LookupDefclassInScope(theClassName); if (theDefclass == NULL) { CantFindItemErrorMessage("class",theClassName); return(FALSE); } if (ClassAbstractP(theDefclass)) { PrintErrorID("INSMNGR",3,FALSE); PrintRouter(WERROR,"Cannot create instances of abstract class "); PrintRouter(WERROR,theClassName); PrintRouter(WERROR,".\n"); return(FALSE); } exp->type = DEFCLASS_PTR; exp->value = theDefclass; } return(TRUE); }
/******************************************************** NAME : CreateInitialDefinstances DESCRIPTION : Makes the initial-object definstances structure for creating an initial-object which will match default object patterns in defrules INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : initial-object definstances created NOTES : None ********************************************************/ static void CreateInitialDefinstances( void *theEnv) { EXPRESSION *tmp; DEFINSTANCES *theDefinstances; theDefinstances = get_struct(theEnv,definstances); InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances, DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); theDefinstances->busy = 0; tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance")); tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL); tmp->argList->nextArg = GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME)); theDefinstances->mkinstance = PackExpression(theEnv,tmp); ReturnExpression(theEnv,tmp); IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances)); ExpressionInstall(theEnv,theDefinstances->mkinstance); AddConstructToModule((struct constructHeader *) theDefinstances); }
/****************************************************************************** NAME : NewSystemHandler DESCRIPTION : Adds a new system handler for a system class The handler is assumed to be primary and of the form: (defmessage-handler <class> <handler> () (<func>)) INPUTS : 1) Name-string of the system class 2) Name-string of the system handler 3) Name-string of the internal H/L function to implement this handler 4) The number of extra arguments (past the instance itself) that the handler willl accept RETURNS : Nothing useful SIDE EFFECTS : Creates the new handler and inserts it in the system class's handler array On errors, generate a system error and exits. NOTES : Does not check to see if handler already exists *******************************************************************************/ globle void NewSystemHandler( void *theEnv, EXEC_STATUS, char *cname, char *mname, char *fname, int extraargs) { DEFCLASS *cls; HANDLER *hnd; cls = LookupDefclassInScope(theEnv,execStatus,cname); hnd = InsertHandlerHeader(theEnv,execStatus,cls,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,mname),MPRIMARY); IncrementSymbolCount(hnd->name); hnd->system = 1; hnd->minParams = hnd->maxParams = (short) (extraargs + 1); hnd->localVarCount = 0; hnd->actions = get_struct(theEnv,execStatus,expr); hnd->actions->argList = NULL; hnd->actions->type = FCALL; hnd->actions->value = (void *) FindFunction(theEnv,execStatus,fname); hnd->actions->nextArg = NULL; }
/************************************************************** NAME : ParseSuperclasses DESCRIPTION : Parses the (is-a <superclass>+) portion of the (defclass ...) construct and returns a list of direct superclasses. The class "standard-class" is the precedence list for classes with no direct superclasses. The final precedence list (not calculated here) will have the class in question first followed by the merged precedence lists of its direct superclasses. INPUTS : 1) The logical name of the input source 2) The symbolic name of the new class RETURNS : The address of the superclass list or NULL if there was an error SIDE EFFECTS : None NOTES : Assumes "(defclass <name> [<comment>] (" has already been scanned. All superclasses must be defined before their subclasses. Duplicates in the (is-a ...) list are are not allowed (a class may only inherits from a superclass once). This routine also checks the class-precedence lists of each of the direct superclasses for an occurrence of the new class - i.e. cycles! This can only happen when a class is redefined (a new class cannot have an unspecified superclass). This routine allocates the space for the list ***************************************************************/ globle PACKED_CLASS_LINKS *ParseSuperclasses( void *theEnv, char *readSource, SYMBOL_HN *newClassName) { CLASS_LINK *clink = NULL,*cbot = NULL,*ctmp; DEFCLASS *sclass; PACKED_CLASS_LINKS *plinks; if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN) { SyntaxErrorMessage(theEnv,(char*)"defclass inheritance"); return(NULL); } GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE : (DefclassData(theEnv)->ObjectParseToken.value != (void *) DefclassData(theEnv)->ISA_SYMBOL)) { SyntaxErrorMessage(theEnv,(char*)"defclass inheritance"); return(NULL); } SavePPBuffer(theEnv,(char*)" "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN) { if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) { SyntaxErrorMessage(theEnv,(char*)"defclass"); goto SuperclassParseError; } if (FindModuleSeparator(ValueToString(newClassName))) { IllegalModuleSpecifierMessage(theEnv); goto SuperclassParseError; } if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) newClassName) { PrintErrorID(theEnv,(char*)"INHERPSR",1,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A class may not have itself as a superclass.\n"); goto SuperclassParseError; } for (ctmp = clink ; ctmp != NULL ; ctmp = ctmp->nxt) { if (GetValue(DefclassData(theEnv)->ObjectParseToken) == (void *) ctmp->cls->header.name) { PrintErrorID(theEnv,(char*)"INHERPSR",2,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A class may inherit from a superclass only once.\n"); goto SuperclassParseError; } } sclass = LookupDefclassInScope(theEnv,ValueToString(GetValue(DefclassData(theEnv)->ObjectParseToken))); if (sclass == NULL) { PrintErrorID(theEnv,(char*)"INHERPSR",3,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A class must be defined after all its superclasses.\n"); goto SuperclassParseError; } if ((sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) || (sclass == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])) { PrintErrorID(theEnv,(char*)"INHERPSR",6,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"A user-defined class cannot be a subclass of "); EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sclass)); EnvPrintRouter(theEnv,WERROR,(char*)".\n"); goto SuperclassParseError; } ctmp = get_struct(theEnv,classLink); ctmp->cls = sclass; if (clink == NULL) clink = ctmp; else cbot->nxt = ctmp; ctmp->nxt = NULL; cbot = ctmp; SavePPBuffer(theEnv,(char*)" "); GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken); } if (clink == NULL) { PrintErrorID(theEnv,(char*)"INHERPSR",4,FALSE); EnvPrintRouter(theEnv,WERROR,(char*)"Must have at least one superclass.\n"); return(NULL); } PPBackup(theEnv); PPBackup(theEnv); SavePPBuffer(theEnv,(char*)")"); plinks = get_struct(theEnv,packedClassLinks); PackClassLinks(theEnv,plinks,clink); return(plinks); SuperclassParseError: DeleteClassLinks(theEnv,clink); return(NULL); }