globle void ConserveMemCommand(
void *theEnv)
{
char *argument;
DATA_OBJECT theValue;
/*===================================*/
/* The conserve-mem function expects */
/* a single symbol argument. */
/*===================================*/
if (EnvArgCountCheck(theEnv,"conserve-mem",EXACTLY,1) == -1) return;
if (EnvArgTypeCheck(theEnv,"conserve-mem",1,SYMBOL,&theValue) == FALSE) return;
argument = DOToString(theValue);
/*====================================================*/
/* If the argument is the symbol "on", then store the */
/* pretty print representation of a construct when it */
/* is defined. */
/*====================================================*/
if (strcmp(argument,"on") == 0)
{
EnvSetConserveMemory(theEnv,TRUE);
}
/*======================================================*/
/* Otherwise, if the argument is the symbol "off", then */
/* don't store the pretty print representation of a */
/* construct when it is defined. */
/*======================================================*/
else if (strcmp(argument,"off") == 0)
{
EnvSetConserveMemory(theEnv,FALSE);
}
/*=====================================================*/
/* Otherwise, generate an error since the only allowed */
/* arguments are "on" or "off." */
/*=====================================================*/
else
{
ExpectedTypeError1(theEnv,"conserve-mem",1,"symbol with value on or off");
return;
}
return;
}
/*******************************************************************************
NAME : CreateGetAndPutHandlers
DESCRIPTION : Creates two message-handlers with
the following syntax for the slot:
(defmessage-handler <class> get-<slot-name> primary ()
?self:<slot-name>)
For single-field slots:
(defmessage-handler <class> put-<slot-name> primary (?value)
(bind ?self:<slot-name> ?value))
For multifield slots:
(defmessage-handler <class> put-<slot-name> primary ($?value)
(bind ?self:<slot-name> ?value))
INPUTS : The class slot descriptor
RETURNS : Nothing useful
SIDE EFFECTS : Message-handlers created
NOTES : A put handler is not created for read-only slots
*******************************************************************************/
globle void CreateGetAndPutHandlers(
void *theEnv,
SLOT_DESC *sd)
{
char *className,*slotName;
unsigned bufsz;
char *buf,*handlerRouter = "*** Default Public Handlers ***";
int oldPWL,oldCM;
char *oldRouter;
char *oldString;
long oldIndex;
if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0))
return;
className = ValueToString(sd->cls->header.name);
slotName = ValueToString(sd->slotName->name);
bufsz = (sizeof(char) * (strlen(className) + (strlen(slotName) * 2) + 80));
buf = (char *) gm2(theEnv,bufsz);
oldPWL = GetPrintWhileLoading(theEnv);
SetPrintWhileLoading(theEnv,FALSE);
oldCM = EnvSetConserveMemory(theEnv,TRUE);
if (sd->createReadAccessor)
{
sprintf(buf,"%s get-%s () ?self:%s)",className,slotName,slotName);
oldRouter = RouterData(theEnv)->FastCharGetRouter;
oldString = RouterData(theEnv)->FastCharGetString;
oldIndex = RouterData(theEnv)->FastCharGetIndex;
RouterData(theEnv)->FastCharGetRouter = handlerRouter;
RouterData(theEnv)->FastCharGetIndex = 0;
RouterData(theEnv)->FastCharGetString = buf;
ParseDefmessageHandler(theEnv,handlerRouter);
DestroyPPBuffer(theEnv);
/*
if (OpenStringSource(theEnv,handlerRouter,buf,0))
{
ParseDefmessageHandler(handlerRouter);
DestroyPPBuffer();
CloseStringSource(theEnv,handlerRouter);
}
*/
RouterData(theEnv)->FastCharGetRouter = oldRouter;
RouterData(theEnv)->FastCharGetIndex = oldIndex;
RouterData(theEnv)->FastCharGetString = oldString;
}
if (sd->createWriteAccessor)
{
sprintf(buf,"%s put-%s ($?value) (bind ?self:%s ?value))",
className,slotName,slotName);
oldRouter = RouterData(theEnv)->FastCharGetRouter;
oldString = RouterData(theEnv)->FastCharGetString;
oldIndex = RouterData(theEnv)->FastCharGetIndex;
RouterData(theEnv)->FastCharGetRouter = handlerRouter;
RouterData(theEnv)->FastCharGetIndex = 0;
RouterData(theEnv)->FastCharGetString = buf;
ParseDefmessageHandler(theEnv,handlerRouter);
DestroyPPBuffer(theEnv);
/*
if (OpenStringSource(theEnv,handlerRouter,buf,0))
{
ParseDefmessageHandler(handlerRouter);
DestroyPPBuffer();
CloseStringSource(theEnv,handlerRouter);
}
*/
RouterData(theEnv)->FastCharGetRouter = oldRouter;
RouterData(theEnv)->FastCharGetIndex = oldIndex;
RouterData(theEnv)->FastCharGetString = oldString;
}
SetPrintWhileLoading(theEnv,oldPWL);
EnvSetConserveMemory(theEnv,oldCM);
rm(theEnv,(void *) buf,bufsz);
}
globle intBool SetConserveMemory(
intBool value)
{
return EnvSetConserveMemory(GetCurrentEnvironment(),value);
}
