obj.c

早期freebsd实现

	while (--i >= 0) {
		if (comparevalue(&op1->o_table[i], &op2->o_table[i]))
			return TRUE;
	}
	return FALSE;
}


/*
 * Raise an object to an integral power.
 * This is the default routine if the user's is not defined.
 * Negative powers mean the positive power of the inverse.
 * Zero means the multiplicative identity.
 */
static VALUE
objpowi(vp, q)
	VALUE *vp;		/* value to be powered */
	NUMBER *q;		/* power to raise number to */
{
	VALUE res, tmp;
	long power;		/* power to raise to */
	unsigned long bit;	/* current bit value */

	if (qisfrac(q))
		math_error("Raising object to non-integral power");
	if (zisbig(q->num))
		math_error("Raising object to very large power");
	power = (zistiny(q->num) ? z1tol(q->num) : z2tol(q->num));
	if (qisneg(q))
		power = -power;
	/*
	 * Handle some low powers specially
	 */
	if ((power <= 2) && (power >= -2)) {
		switch ((int) power) {
			case 0:
				return objcall(OBJ_ONE, vp, NULL_VALUE, NULL_VALUE);
			case 1:
				res.v_obj = objcopy(vp->v_obj);
				res.v_type = V_OBJ;
				return res;
			case -1:
				return objcall(OBJ_INV, vp, NULL_VALUE, NULL_VALUE);
			case 2:
				return objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
		}
	}
	if (power < 0)
		power = -power;
	/*
	 * Compute the power by squaring and multiplying.
	 * This uses the left to right method of power raising.
	 */
	bit = TOPFULL;
	while ((bit & power) == 0)
		bit >>= 1L;
	bit >>= 1L;
	res = objcall(OBJ_SQUARE, vp, NULL_VALUE, NULL_VALUE);
	if (bit & power) {
		tmp = objcall(OBJ_MUL, &res, vp, NULL_VALUE);
		objfree(res.v_obj);
		res = tmp;
	}
	bit >>= 1L;
	while (bit) {
		tmp = objcall(OBJ_SQUARE, &res, NULL_VALUE, NULL_VALUE);
		objfree(res.v_obj);
		res = tmp;
		if (bit & power) {
			tmp = objcall(OBJ_MUL, &res, vp, NULL_VALUE);
			objfree(res.v_obj);
			res = tmp;
		}
		bit >>= 1L;
	}
	if (qisneg(q)) {
		tmp = objcall(OBJ_INV, &res, NULL_VALUE, NULL_VALUE);
		objfree(res.v_obj);
		return tmp;
	}
	return res;
}


/*
 * Define a (possibly) new class of objects.
 * The list of indexes for the element names is also specified here,
 * and the number of elements defined for the object.
 */
void
defineobject(name, indices, count)
	char *name;		/* name of object type */
	int indices[];		/* table of indices for elements */
	int count;
{
	OBJECTACTIONS *oap;	/* object definition structure */
	STRINGHEAD *hp;
	int index;

	hp = &objectnames;
	if (hp->h_list == NULL)
		initstr(hp);
	index = findstr(hp, name);
	if (index >= 0) {
		/*
		 * Object is already defined.  Give an error unless this
		 * new definition is exactly the same as the old one.
		 */
		oap = objects[index];
		if (oap->count == count) {
			for (index = 0; ; index++) {
				if (index >= count)
					return;
				if (oap->elements[index] != indices[index])
					break;
			}
		}
		math_error("Object type \"%s\" is already defined", name);
	}

	if (hp->h_count >= MAXOBJECTS)
		math_error("Too many object types in use");
	oap = (OBJECTACTIONS *) malloc(objectactionsize(count));
	if (oap)
		name = addstr(hp, name);
	if ((oap == NULL) || (name == NULL))
		math_error("Cannot allocate object type");
	oap->name = name;
	oap->count = count;
	for (index = OBJ_MAXFUNC; index >= 0; index--)
		oap->actions[index] = 0;
	for (index = 0; index < count; index++)
		oap->elements[index] = indices[index];
	index = findstr(hp, name);
	objects[index] = oap;
	return;
}


/*
 * Check an object name to see if it is currently defined.
 * If so, the index for the object type is returned.
 * If the object name is currently unknown, then -1 is returned.
 */
int
checkobject(name)
	char *name;
{
	STRINGHEAD *hp;

	hp = &objectnames;
	if (hp->h_list == NULL)
		return -1;
	return findstr(hp, name);
}


/*
 * Define a (possibly) new element name for an object.
 * Returns an index which identifies the element name.
 */
int
addelement(name)
	char *name;
{
	STRINGHEAD *hp;
	int index;

	hp = &elements;
	if (hp->h_list == NULL)
		initstr(hp);
	index = findstr(hp, name);
	if (index >= 0)
		return index;
	if (addstr(hp, name) == NULL)
		math_error("Cannot allocate element name");
	return findstr(hp, name);
}


/*
 * Return the index which identifies an element name.
 * Returns minus one if the element name is unknown.
 */
int
findelement(name)
	char *name;		/* element name */
{
	if (elements.h_list == NULL)
		return -1;
	return findstr(&elements, name);
}


/*
 * Return the value table offset to be used for an object element name.
 * This converts the element index from the element table into an offset
 * into the object value array.  Returns -1 if the element index is unknown.
 */
int
objoffset(op, index)
	OBJECT *op;
	long index;
{
	register OBJECTACTIONS *oap;
	int offset;			/* offset into value array */

	oap = op->o_actions;
	for (offset = oap->count - 1; offset >= 0; offset--) {
		if (oap->elements[offset] == index)
			return offset;
	}
	return -1;
}


/*
 * Allocate a new object structure with the specified index.
 */
OBJECT *
objalloc(index)
	long index;
{
	OBJECTACTIONS *oap;
	OBJECT *op;
	VALUE *vp;
	int i;

	if ((unsigned) index >= MAXOBJECTS)
		math_error("Allocating bad object index");
	oap = objects[index];
	if (oap == NULL)
		math_error("Object type not defined");
	i = oap->count;
	if (i < USUAL_ELEMENTS)
		i = USUAL_ELEMENTS;
	if (i == USUAL_ELEMENTS)
		op = (OBJECT *) allocitem(&freelist);
	else
		op = (OBJECT *) malloc(objectsize(i));
	if (op == NULL)
		math_error("Cannot allocate object");
	op->o_actions = oap;
	vp = op->o_table;
	for (i = oap->count; i-- > 0; vp++) {
		vp->v_num = qlink(&_qzero_);
		vp->v_type = V_NUM;
	}
	return op;
}


/*
 * Free an object structure.
 */
void
objfree(op)
	register OBJECT *op;
{
	VALUE *vp;
	int i;

	vp = op->o_table;
	for (i = op->o_actions->count; i-- > 0; vp++) {
		if (vp->v_type == V_NUM) {
			qfree(vp->v_num);
		} else
			freevalue(vp);
	}
	if (op->o_actions->count <= USUAL_ELEMENTS)
		freeitem(&freelist, (FREEITEM *) op);
	else
		free((char *) op);
}


/*
 * Copy an object value
 */
OBJECT *
objcopy(op)
	OBJECT *op;
{
	VALUE *v1, *v2;
	OBJECT *np;
	int i;

	i = op->o_actions->count;
	if (i < USUAL_ELEMENTS)
		i = USUAL_ELEMENTS;
	if (i == USUAL_ELEMENTS)
		np = (OBJECT *) allocitem(&freelist);
	else
		np = (OBJECT *) malloc(objectsize(i));
	if (np == NULL)
		math_error("Cannot allocate object");
	np->o_actions = op->o_actions;
	v1 = op->o_table;
	v2 = np->o_table;
	for (i = op->o_actions->count; i-- > 0; v1++, v2++) {
		if (v1->v_type == V_NUM) {
			v2->v_num = qlink(v1->v_num);
			v2->v_type = V_NUM;
		} else
			copyvalue(v1, v2);
	}
	return np;
}


/*
 * Return a trivial hash value for an object.
 */
HASH
objhash(op)
	OBJECT *op;
{
	HASH hash;
	int i;

	hash = 0;
	i = op->o_actions->count;
	while (--i >= 0)
		hash = hash * 4000037 + hashvalue(&op->o_table[i]);
	return hash;
}

/* END CODE */