/********************************************************************
NAME : ClassSlots
DESCRIPTION : Groups slot info for a class into a multifield value
for dynamic perusal
INPUTS : 1) Generic pointer to class
2) Data object buffer to hold the slots of the class
3) Include (1) or exclude (0) inherited slots
RETURNS : Nothing useful
SIDE EFFECTS : Creates a multifield storing the names of
the slots of the class
NOTES : None
********************************************************************/
globle void ClassSlots(
void *clsptr,
DATA_OBJECT *result,
int inhp)
{
long size; /* 6.04 Bug Fix */
register DEFCLASS *cls;
register long i; /* 6.04 Bug Fix */
cls = (DEFCLASS *) clsptr;
size = inhp ? cls->instanceSlotCount : cls->slotCount;
result->type = MULTIFIELD;
result->begin = 0;
result->end = size - 1;
result->value = (void *) CreateMultifield(size);
if (size == 0)
return;
if (inhp)
{
for (i = 0 ; i < cls->instanceSlotCount ; i++)
{
SetMFType(result->value,i+1,SYMBOL);
SetMFValue(result->value,i+1,cls->instanceTemplate[i]->slotName->name);
}
}
else
{
for (i = 0 ; i < cls->slotCount ; i++)
{
SetMFType(result->value,i+1,SYMBOL);
SetMFValue(result->value,i+1,cls->slots[i].slotName->name);
}
}
}
globle void SlotRange(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register SLOT_DESC *sp;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-range")) == NULL)
return;
if ((sp->constraint == NULL) ? FALSE :
(sp->constraint->anyAllowed || sp->constraint->floatsAllowed ||
sp->constraint->integersAllowed))
{
result->end = 1;
result->value = CreateMultifield(2L);
SetMFType(result->value,1,sp->constraint->minValue->type);
SetMFValue(result->value,1,sp->constraint->minValue->value);
SetMFType(result->value,2,sp->constraint->maxValue->type);
SetMFValue(result->value,2,sp->constraint->maxValue->value);
}
else
{
result->type = SYMBOL;
result->value = FalseSymbol;
return;
}
}
static void SetErrorCaptureValues(
DATA_OBJECT_PTR returnValue)
{
struct multifield *theMultifield;
theMultifield = (struct multifield *) CreateMultifield(2L);
if (ErrorString != NULL)
{
SetMFType(theMultifield,1,STRING);
SetMFValue(theMultifield,1,AddSymbol(ErrorString));
}
else
{
SetMFType(theMultifield,1,SYMBOL);
SetMFValue(theMultifield,1,FalseSymbol);
}
if (WarningString != NULL)
{
SetMFType(theMultifield,2,STRING);
SetMFValue(theMultifield,2,AddSymbol(WarningString));
}
else
{
SetMFType(theMultifield,2,SYMBOL);
SetMFValue(theMultifield,2,FalseSymbol);
}
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,2);
SetpValue(returnValue,(void *) theMultifield);
}
/***************************************************************************
NAME : ClassSuperclasses
DESCRIPTION : Groups the names of superclasses into a multifield
value for dynamic perusal
INPUTS : 1) Generic pointer to class
2) Data object buffer to hold the superclasses of the class
3) Include (1) or exclude (0) indirect superclasses
RETURNS : Nothing useful
SIDE EFFECTS : Creates a multifield storing the names of
the superclasses of the class
NOTES : None
***************************************************************************/
globle void ClassSuperclasses(
void *clsptr,
DATA_OBJECT *result,
int inhp)
{
PACKED_CLASS_LINKS *plinks;
int offset;
register unsigned i,j;
if (inhp)
{
plinks = &((DEFCLASS *) clsptr)->allSuperclasses;
offset = 1;
}
else
{
plinks = &((DEFCLASS *) clsptr)->directSuperclasses;
offset = 0;
}
result->type = MULTIFIELD;
result->begin = 0;
result->end = plinks->classCount - offset - 1;
result->value = (void *) CreateMultifield(result->end + 1);
if (result->end == -1)
return;
for (i = offset , j = 1 ; i < plinks->classCount ; i++ , j++)
{
SetMFType(result->value,j,SYMBOL);
SetMFValue(result->value,j,GetDefclassNamePointer((void *) plinks->classArray[i]));
}
}
globle void SlotAllowedValues(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register int i;
register SLOT_DESC *sp;
register EXPRESSION *exp;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-allowed-values")) == NULL)
return;
if ((sp->constraint != NULL) ? (sp->constraint->restrictionList == NULL) : TRUE)
{
result->type = SYMBOL;
result->value = FalseSymbol;
return;
}
result->end = ExpressionSize(sp->constraint->restrictionList) - 1;
result->value = CreateMultifield(result->end + 1);
i = 1;
exp = sp->constraint->restrictionList;
while (exp != NULL)
{
SetMFType(result->value,i,exp->type);
SetMFValue(result->value,i,exp->value);
exp = exp->nextArg;
i++;
}
}
globle void SlotCardinality(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register SLOT_DESC *sp;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-cardinality")) == NULL)
return;
if (sp->multiple == 0)
{
SetMultifieldErrorValue(result);
return;
}
result->end = 1;
result->value = CreateMultifield(2L);
if (sp->constraint != NULL)
{
SetMFType(result->value,1,sp->constraint->minFields->type);
SetMFValue(result->value,1,sp->constraint->minFields->value);
SetMFType(result->value,2,sp->constraint->maxFields->type);
SetMFValue(result->value,2,sp->constraint->maxFields->value);
}
else
{
SetMFType(result->value,1,INTEGER);
SetMFValue(result->value,1,Zero);
SetMFType(result->value,2,SYMBOL);
SetMFValue(result->value,2,PositiveInfinity);
}
}
globle void SetMultifieldErrorValue(
DATA_OBJECT_PTR returnValue)
{
returnValue->type = MULTIFIELD;
returnValue->value = CreateMultifield(0L);
returnValue->begin = 1;
returnValue->end = 0;
}
/******************************************************************************
NAME : QueryFindAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
stores their names in the user's multi-field variable
The sets are stored sequentially :
Number of sets = (Multi-field length) / (Set length)
The first set is if the first (set length) atoms of the
multi-field variable, and so on.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
void QueryFindAllFacts(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
size_t i, j;
returnValue->begin = 0;
returnValue->range = 0;
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg,
"find-all-facts",&rcnt);
if (qtemplates == NULL)
{
returnValue->value = CreateMultifield(theEnv,0L);
return;
}
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (Fact **) gm2(theEnv,(sizeof(Fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = NULL;
FactQueryData(theEnv)->QueryCore->soln_set = NULL;
FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,qtemplates,0);
FactQueryData(theEnv)->AbortQuery = false;
returnValue->value = CreateMultifield(theEnv,FactQueryData(theEnv)->QueryCore->soln_cnt * rcnt);
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
{
for (i = 0 , j = returnValue->range ; i < rcnt ; i++ , j++)
{
returnValue->multifieldValue->contents[j].value = FactQueryData(theEnv)->QueryCore->soln_set->soln[i];
}
returnValue->range = j;
PopQuerySoln(theEnv);
}
rm(theEnv,FactQueryData(theEnv)->QueryCore->solns,(sizeof(Fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : QueryFindAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
stores their names in the user's multi-field variable
The sets are stored sequentially :
Number of sets = (Multi-field length) / (Set length)
The first set is if the first (set length) atoms of the
multi-field variable, and so on.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void QueryFindAllInstances(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
register int i,j;
result->type = MULTIFIELD;
result->begin = 0;
result->end = -1;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
"find-all-instances",&rcnt);
if (qclasses == NULL)
{
result->value = (void *) CreateMultifield(0L);
return;
}
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = NULL;
QueryCore->soln_set = NULL;
QueryCore->soln_size = rcnt;
QueryCore->soln_cnt = 0;
TestEntireChain(qclasses,0);
AbortQuery = FALSE;
result->value = (void *) CreateMultifield(QueryCore->soln_cnt * rcnt);
while (QueryCore->soln_set != NULL)
{
for (i = 0 , j = result->end + 2 ; i < rcnt ; i++ , j++)
{
SetMFType(result->value,j,INSTANCE_NAME);
SetMFValue(result->value,j,GetFullInstanceName(QueryCore->soln_set->soln[i]));
}
result->end = j-2;
PopQuerySoln();
}
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
/******************************************************************************
NAME : QueryFindFact
DESCRIPTION : Finds the first set of facts which satisfy the query and
stores their addresses in the user's multi-field variable
INPUTS : Caller's result buffer
RETURNS : True if the query is satisfied, false otherwise
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
zero or more times (depending on fact restrictions
and how early the expression evaulates to true - if at all).
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
void QueryFindFact(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt,i;
returnValue->begin = 0;
returnValue->range = 0;
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg,
"find-fact",&rcnt);
if (qtemplates == NULL)
{
returnValue->value = CreateMultifield(theEnv,0L);
return;
}
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (Fact **)
gm2(theEnv,(sizeof(Fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
if (TestForFirstInChain(theEnv,qtemplates,0) == true)
{
returnValue->value = CreateMultifield(theEnv,rcnt);
returnValue->range = rcnt;
for (i = 0 ; i < rcnt ; i++)
{
returnValue->multifieldValue->contents[i].value = FactQueryData(theEnv)->QueryCore->solns[i];
}
}
else
returnValue->value = CreateMultifield(theEnv,0L);
FactQueryData(theEnv)->AbortQuery = false;
rm(theEnv,FactQueryData(theEnv)->QueryCore->solns,(sizeof(Fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : QueryFindInstance
DESCRIPTION : Finds the first set of instances which satisfy the query and
stores their names in the user's multi-field variable
INPUTS : Caller's result buffer
RETURNS : TRUE if the query is satisfied, FALSE otherwise
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
zero or more times (depending on instance restrictions
and how early the expression evaulates to TRUE - if at all).
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void QueryFindInstance(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt,i;
result->type = MULTIFIELD;
result->begin = 0;
result->end = -1;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
"find-instance",&rcnt);
if (qclasses == NULL)
{
result->value = (void *) CreateMultifield(0L);
return;
}
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **)
gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
if (TestForFirstInChain(qclasses,0) == TRUE)
{
result->value = (void *) CreateMultifield(rcnt);
result->end = rcnt-1;
for (i = 1 ; i <= rcnt ; i++)
{
SetMFType(result->value,i,INSTANCE_NAME);
SetMFValue(result->value,i,GetFullInstanceName(QueryCore->solns[i - 1]));
}
}
else
result->value = (void *) CreateMultifield(0L);
AbortQuery = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
globle void OldGetConstructList(
DATA_OBJECT_PTR returnValue,
void *(*nextFunction)(void *),
char *(*nameFunction)(void *))
{
void *theConstruct;
long count = 0;
struct multifield *theList;
/*====================================*/
/* Determine the number of constructs */
/* of the specified type. */
/*====================================*/
for (theConstruct = (*nextFunction)(NULL);
theConstruct != NULL;
theConstruct = (*nextFunction)(theConstruct))
{ count++; }
/*===========================*/
/* Create a multifield large */
/* enough to store the list. */
/*===========================*/
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,count);
theList = (struct multifield *) CreateMultifield((int) count);
SetpValue(returnValue,(void *) theList);
/*====================================*/
/* Store the names in the multifield. */
/*====================================*/
for (theConstruct = (*nextFunction)(NULL), count = 1;
theConstruct != NULL;
theConstruct = (*nextFunction)(theConstruct), count++)
{
if (HaltExecution == TRUE)
{
SetMultifieldErrorValue(returnValue);
return;
}
SetMFType(theList,count,SYMBOL);
SetMFValue(theList,count,AddSymbol((*nameFunction)(theConstruct)));
}
}
globle void SlotSources(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register int i,classi;
register SLOT_DESC *sp,*csp;
CLASS_LINK *ctop,*ctmp;
DEFCLASS *cls;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-sources")) == NULL)
return;
i = 1;
ctop = get_struct(classLink);
ctop->cls = sp->cls;
ctop->nxt = NULL;
if (sp->composite)
{
for (classi = 1 ; classi < (unsigned int)sp->cls->allSuperclasses.classCount ; classi++)
{
cls = sp->cls->allSuperclasses.classArray[classi];
csp = FindClassSlot(cls,sp->slotName->name);
if ((csp != NULL) ? (csp->noInherit == 0) : FALSE)
{
ctmp = get_struct(classLink);
ctmp->cls = cls;
ctmp->nxt = ctop;
ctop = ctmp;
i++;
if (csp->composite == 0)
break;
}
}
}
result->end = i - 1;
result->value = (void *) CreateMultifield(i);
for (ctmp = ctop , i = 1 ; ctmp != NULL ; ctmp = ctmp->nxt , i++)
{
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i,GetDefclassNamePointer((void *) ctmp->cls));
}
DeleteClassLinks(ctop);
}
/**************************************************************************
NAME : ClassSubclassAddresses
DESCRIPTION : Groups the class addresses of subclasses for a class into a
multifield value for dynamic perusal
INPUTS : 1) Generic pointer to class
2) Data object buffer to hold the sublclasses of the class
3) Include (1) or exclude (0) indirect subclasses
RETURNS : Nothing useful
SIDE EFFECTS : Creates a multifield storing the subclass
addresss of the class
NOTES : None
**************************************************************************/
globle void ClassSubclassAddresses(
void *clsptr,
DATA_OBJECT *result,
int inhp)
{
register int i,id;
if ((id = GetTraversalID()) == -1)
return;
i = CountSubclasses((DEFCLASS *) clsptr,inhp,id);
ReleaseTraversalID();
result->type = MULTIFIELD;
result->begin = 0;
result->end = i - 1;
result->value = (void *) CreateMultifield(i);
if (i == 0)
return;
if ((id = GetTraversalID()) == -1)
return;
StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,FALSE);
ReleaseTraversalID();
}
/*-deref or pk_tpn can fill malloced space, then can use this to get to a m.f.*/
VOID tpn_to_mf(DATA_OBJECT_PTR rp)
{
int num=1,stride=1,*pi,offset=0,i;
float *pf;
double *pd;
char tstr[9],type,*pc,t1[2];
VOID *mfp;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return;
}
/*get number (& offset & stride) to put to a m.f.*/
if(RtnArgCount() > 2) num=(int)RtnLong(3);
if(RtnArgCount() > 3) offset=(int)RtnLong(4);
if(RtnArgCount() > 4) stride=(int)RtnLong(5);
/*could use SetMultifieldErrorValue(rp); return;*/
mfp = CreateMultifield(num);
/*get the ptr, and set the MF*/
switch(type)
{
case 'i' : pi = (int *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,INTEGER);
SetMFValue(mfp,i,AddLong(pi[offset+i]));
}
break;
case 'f' : pf = (float *)get_ptr(2);
for(i=0; i<num; i++)
{
printf("%f to mf,",pf[offset+i]); fflush(stdout);
SetMFType(mfp,i,FLOAT);
SetMFValue(mfp,i,AddDouble((double)pf[offset+i]));
}
break;
case 'd' : pd = (double *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,FLOAT);
SetMFValue(mfp,i,AddDouble(pd[offset+i]));
}
break;
/*this one could go per char or by stride or by space breaks*/
/*go by char for now*/
case 'b' : pc = (char *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,SYMBOL);
t1[0]=pc[offset+i];
SetMFValue(mfp,i,AddSymbol(t1));
}
break;
} /*gets past this and dies when printing out the result-
-looks liked capped ok though*/
SetpType(rp,MULTIFIELD);
SetpValue(rp,mfp);
SetpDOBegin(rp,1);
SetpDOEnd(rp,num);
return;
}
/*might be dangerous, maybe trasfer to from mf instead*/
VOID tpn_mf_mirror(DATA_OBJECT_PTR rp)
{
int *pi,i,num,offset=0,stride=1;
float *pf;
double *pd;
char tstr[9],type,t1[2];
VOID *mfp;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return;
}
/*get number (& offset & stride) to put to a m.f.*/
if(RtnArgCount() > 2) num=(int)RtnLong(3);
if(RtnArgCount() > 3) offset=(int)RtnLong(4);
if(RtnArgCount() > 4) stride=(int)RtnLong(5);
/*could use SetMultifieldErrorValue(rp); return;*/
mfp = CreateMultifield(num);
/*get the ptr, and set the MF*/
switch(type)
{
case 'i' : pi = (int *)get_ptr(2);
for(i=0; i<num; i++)
{
printf(",%d ",
SetMFType(mfp,i,INTEGER));
/*SetMFValue(mfp,i,AddLong(pi[offset+i]));
set the Data_Object ptr to the address*/
}
break;
case 'f' : pf = (float *)get_ptr(2);
for(i=0; i<num; i++)
{
printf("%f to mf,",pf[offset+i]);
fflush(stdout);
printf(",%d ",
SetMFType(mfp,i,FLOAT));
fflush(stdout);
/*SetMFValue(mfp,i,AddDouble((double)pf[offset+i]));
set the Data_Object ptr to the address*/
}
break;
case 'd' : pd = (double *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,FLOAT);
/*SetMFValue(mfp,i,AddDouble(pd[offset+i]));
set the Data_Object ptr to the address*/
}
break;
}
SetpType(rp,MULTIFIELD);
SetpValue(rp,mfp);
SetpDOBegin(rp,1);
SetpDOEnd(rp,num);
return;
}
globle void StoreInMultifield(
DATA_OBJECT *returnValue,
EXPRESSION *expptr,
int garbageSegment)
{
DATA_OBJECT val_ptr;
DATA_OBJECT *val_arr;
struct multifield *theMultifield;
struct multifield *orig_ptr;
long start, end, i,j, k, seg_size, argCount;
argCount = CountArguments(expptr);
/*=========================================*/
/* If no arguments are given return a NULL */
/* multifield of length zero. */
/*=========================================*/
if (argCount == 0)
{
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,0);
if (garbageSegment) theMultifield = (struct multifield *) CreateMultifield(0L);
else theMultifield = (struct multifield *) CreateMultifield2(0L);
SetpValue(returnValue,(void *) theMultifield);
return;
}
else
{
/*========================================*/
/* Get a new segment with length equal to */
/* the total length of all the arguments. */
/*========================================*/
val_arr = (DATA_OBJECT *) gm3((long) sizeof(DATA_OBJECT) * argCount);
seg_size = 0;
for(i = 1 ; i <= argCount ; i++ , expptr = expptr->nextArg)
{
EvaluateExpression(expptr,&val_ptr);
if (EvaluationError)
{
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,0);
if (garbageSegment)
{ theMultifield = (struct multifield *) CreateMultifield(0L); }
else theMultifield = (struct multifield *) CreateMultifield2(0L);
SetpValue(returnValue,(void *) theMultifield);
rm3(val_arr,(long) sizeof(DATA_OBJECT) * argCount);
return;
}
SetpType(val_arr+i-1,GetType(val_ptr));
if (GetType(val_ptr) == MULTIFIELD)
{
SetpValue(val_arr+i-1,GetpValue(&val_ptr));
start = GetDOBegin(val_ptr);
end = GetDOEnd(val_ptr);
}
else if (GetType(val_ptr) == RVOID)
{
SetpValue(val_arr+i-1,GetValue(val_ptr));
start = 1;
end = 0;
}
else
{
SetpValue(val_arr+i-1,GetValue(val_ptr));
start = end = -1;
}
seg_size += end - start + 1;
SetpDOBegin(val_arr+i-1,start);
SetpDOEnd(val_arr+i-1,end);
}
if (garbageSegment)
{ theMultifield = (struct multifield *) CreateMultifield(seg_size); }
else theMultifield = (struct multifield *) CreateMultifield2(seg_size);
/*========================================*/
/* Copy each argument into new segment. */
/*========================================*/
for(k=0,j=1; k < argCount;k++)
{
if (GetpType(val_arr+k) == MULTIFIELD)
{
start = GetpDOBegin(val_arr+k);
end = GetpDOEnd(val_arr+k);
orig_ptr = (struct multifield *) GetpValue(val_arr+k);
for(i=start; i< end + 1; i++,j++)
{
SetMFType(theMultifield,j,(GetMFType(orig_ptr,i)));
SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i)));
}
}
else if (GetpType(val_arr+k) != MULTIFIELD)
{
SetMFType(theMultifield,j,(short) (GetpType(val_arr+k)));
SetMFValue(theMultifield,j,(GetpValue(val_arr+k)));
j++;
}
}
/*=========================*/
/* Return the new segment. */
/*=========================*/
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,seg_size);
SetpValue(returnValue,(void *) theMultifield);
rm3(val_arr,(long) sizeof(DATA_OBJECT) * argCount);
return;
}
}
globle void SlotTypes(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register int i,j;
register SLOT_DESC *sp;
char typemap[2];
int msize;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-types"))
== NULL)
return;
if ((sp->constraint != NULL) ? sp->constraint->anyAllowed : TRUE)
{
typemap[0] = typemap[1] = (char) 0xFF;
ClearBitMap(typemap,MULTIFIELD);
msize = 8;
}
else
{
typemap[0] = typemap[1] = (char) 0x00;
msize = 0;
if (sp->constraint->symbolsAllowed)
{
msize++;
SetBitMap(typemap,SYMBOL);
}
if (sp->constraint->stringsAllowed)
{
msize++;
SetBitMap(typemap,STRING);
}
if (sp->constraint->floatsAllowed)
{
msize++;
SetBitMap(typemap,FLOAT);
}
if (sp->constraint->integersAllowed)
{
msize++;
SetBitMap(typemap,INTEGER);
}
if (sp->constraint->instanceNamesAllowed)
{
msize++;
SetBitMap(typemap,INSTANCE_NAME);
}
if (sp->constraint->instanceAddressesAllowed)
{
msize++;
SetBitMap(typemap,INSTANCE_ADDRESS);
}
if (sp->constraint->externalAddressesAllowed)
{
msize++;
SetBitMap(typemap,EXTERNAL_ADDRESS);
}
if (sp->constraint->factAddressesAllowed)
{
msize++;
SetBitMap(typemap,FACT_ADDRESS);
}
}
result->end = msize - 1;
result->value = CreateMultifield(msize);
i = 1;
j = 0;
while (i <= msize)
{
if (TestBitMap(typemap,j))
{
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i,
(void *) GetDefclassNamePointer((void *)
PrimitiveClassMap[j]));
i++;
}
j++;
}
}
globle void SlotFacets(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register int i;
register SLOT_DESC *sp;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-facets")) == NULL)
return;
#if INSTANCE_PATTERN_MATCHING
result->end = 9;
result->value = (void *) CreateMultifield(10L);
for (i = 1 ; i <= 10 ; i++)
SetMFType(result->value,i,SYMBOL);
#else
result->end = 8;
result->value = (void *) CreateMultifield(9L);
for (i = 1 ; i <= 9 ; i++)
SetMFType(result->value,i,SYMBOL);
#endif
if (sp->multiple)
SetMFValue(result->value,1,AddSymbol("MLT"));
else
SetMFValue(result->value,1,AddSymbol("SGL"));
if (sp->noDefault)
SetMFValue(result->value,2,AddSymbol("NIL"));
else
{
if (sp->dynamicDefault)
SetMFValue(result->value,2,AddSymbol("DYN"));
else
SetMFValue(result->value,2,AddSymbol("STC"));
}
if (sp->noInherit)
SetMFValue(result->value,3,AddSymbol("NIL"));
else
SetMFValue(result->value,3,AddSymbol("INH"));
if (sp->initializeOnly)
SetMFValue(result->value,4,AddSymbol("INT"));
else if (sp->noWrite)
SetMFValue(result->value,4,AddSymbol("R"));
else
SetMFValue(result->value,4,AddSymbol("RW"));
if (sp->shared)
SetMFValue(result->value,5,AddSymbol("SHR"));
else
SetMFValue(result->value,5,AddSymbol("LCL"));
#if INSTANCE_PATTERN_MATCHING
if (sp->reactive)
SetMFValue(result->value,6,AddSymbol("RCT"));
else
SetMFValue(result->value,6,AddSymbol("NIL"));
if (sp->composite)
SetMFValue(result->value,7,AddSymbol("CMP"));
else
SetMFValue(result->value,7,AddSymbol("EXC"));
if (sp->publicVisibility)
SetMFValue(result->value,8,AddSymbol("PUB"));
else
SetMFValue(result->value,8,AddSymbol("PRV"));
SetMFValue(result->value,9,AddSymbol(GetCreateAccessorString((void *) sp)));
SetMFValue(result->value,10,sp->noWrite ? AddSymbol("NIL") : (void *) sp->overrideMessage);
#else
if (sp->composite)
SetMFValue(result->value,6,AddSymbol("CMP"));
else
SetMFValue(result->value,6,AddSymbol("EXC"));
if (sp->publicVisibility)
SetMFValue(result->value,7,AddSymbol("PUB"));
else
SetMFValue(result->value,7,AddSymbol("PRV"));
SetMFValue(result->value,8,AddSymbol(GetCreateAccessorString((void *) sp)));
SetMFValue(result->value,9,sp->noWrite ? AddSymbol("NIL") : (void *) sp->overrideMessage);
#endif
}
globle struct multifield *StringToMultifield(
char *theString)
{
struct token theToken;
struct multifield *theSegment;
struct field *theFields;
long numberOfFields = 0; /* 6.04 Bug Fix */
struct expr *topAtom = NULL, *lastAtom = NULL, *theAtom;
/*====================================================*/
/* Open the string as an input source and read in the */
/* list of values to be stored in the multifield. */
/*====================================================*/
OpenStringSource("multifield-str",theString,0);
GetToken("multifield-str",&theToken);
while (theToken.type != STOP)
{
if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
(theToken.type == FLOAT) || (theToken.type == INTEGER) ||
(theToken.type == INSTANCE_NAME))
{ theAtom = GenConstant(theToken.type,theToken.value); }
else
{ theAtom = GenConstant(STRING,AddSymbol(theToken.printForm)); }
numberOfFields++;
if (topAtom == NULL) topAtom = theAtom;
else lastAtom->nextArg = theAtom;
lastAtom = theAtom;
GetToken("multifield-str",&theToken);
}
CloseStringSource("multifield-str");
/*====================================================================*/
/* Create a multifield of the appropriate size for the values parsed. */
/*====================================================================*/
theSegment = (struct multifield *) CreateMultifield(numberOfFields);
theFields = theSegment->theFields;
/*====================================*/
/* Copy the values to the multifield. */
/*====================================*/
theAtom = topAtom;
numberOfFields = 0;
while (theAtom != NULL)
{
theFields[numberOfFields].type = theAtom->type;
theFields[numberOfFields].value = theAtom->value;
numberOfFields++;
theAtom = theAtom->nextArg;
}
/*===========================*/
/* Return the parsed values. */
/*===========================*/
ReturnExpression(topAtom);
/*============================*/
/* Return the new multifield. */
/*============================*/
return(theSegment);
}
/************************************************************************
NAME : GetDefmessageHandlerList
DESCRIPTION : Groups handler info for a class into a multifield value
for dynamic perusal
INPUTS : 1) Generic pointer to class (NULL to get handlers for
all classes)
2) Data object buffer to hold the handlers of the class
3) Include (1) or exclude (0) inherited handlers
RETURNS : Nothing useful
SIDE EFFECTS : Creates a multifield storing the names and types of
the message-handlers of the class
NOTES : None
************************************************************************/
globle void GetDefmessageHandlerList(
void *clsptr,
DATA_OBJECT *result,
int inhp)
{
DEFCLASS *cls,*svcls,*svnxt,*supcls;
register int j,classi,classiLimit;
long i,len,sublen;
if (clsptr == NULL)
{
inhp = 0;
cls = (DEFCLASS *) GetNextDefclass(NULL);
svnxt = (DEFCLASS *) GetNextDefclass((void *) cls);
}
else
{
cls = (DEFCLASS *) clsptr;
svnxt = (DEFCLASS *) GetNextDefclass((void *) cls);
SetNextDefclass((void *) cls,NULL);
}
for (svcls = cls , i = 0 ;
cls != NULL ;
cls = (DEFCLASS *) GetNextDefclass((void *) cls))
{
classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
for (classi = 0 ; classi < classiLimit ; classi++)
i += cls->allSuperclasses.classArray[classi]->handlerCount;
}
len = i * 3;
result->type = MULTIFIELD;
result->begin = 0;
result->end = len - 1;
result->value = (void *) CreateMultifield(len);
for (cls = svcls , sublen = 0 ;
cls != NULL ;
cls = (DEFCLASS *) GetNextDefclass((void *) cls))
{
classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
for (classi = 0 ; classi < classiLimit ; classi++)
{
supcls = cls->allSuperclasses.classArray[classi];
if (inhp == 0)
i = sublen + 1;
else
i = len - (supcls->handlerCount * 3) - sublen + 1;
for (j = 0 ; j < supcls->handlerCount ; j++)
{
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i++,GetDefclassNamePointer((void *) supcls));
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i++,supcls->handlers[j].name);
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i++,AddSymbol(hndquals[supcls->handlers[j].type]));
}
sublen += supcls->handlerCount * 3;
}
}
if (svcls != NULL)
SetNextDefclass((void *) svcls,(void *) svnxt);
}
