obj.c

早期freebsd实现

/*
 * Copyright (c) 1994 David I. Bell
 * Permission is granted to use, distribute, or modify this source,
 * provided that this copyright notice remains intact.
 *
 * "Object" handling primatives.
 * This simply means that user-specified routines are called to perform
 * the indicated operations.
 */

#include "calc.h"
#include "opcodes.h"
#include "func.h"
#include "symbol.h"
#include "string.h"


/*
 * Types of values returned by calling object routines.
 */
#define A_VALUE	0	/* returns arbitrary value */
#define A_INT	1	/* returns integer value */
#define A_UNDEF	2	/* returns no value */

/*
 * Error handling actions for when the function is undefined.
 */
#define E_NONE	0	/* no special action */
#define E_PRINT	1	/* print element */
#define E_CMP	2	/* compare two values */
#define E_TEST	3	/* test value for nonzero */
#define E_POW	4	/* call generic power routine */
#define E_ONE	5	/* return number 1 */
#define E_INC	6	/* increment by one */
#define E_DEC	7	/* decrement by one */
#define E_SQUARE 8	/* square value */


static struct objectinfo {
	short args;	/* number of arguments */
	short retval;	/* type of return value */
	short error;	/* special action on errors */
	char *name;	/* name of function to call */
	char *comment;	/* useful comment if any */
} objectinfo[] = {
	1, A_UNDEF, E_PRINT, "print",	"print value, default prints elements",
	1, A_VALUE, E_ONE,   "one",	"multiplicative identity, default is 1",
	1, A_INT,   E_TEST,  "test",	"logical test (false,true => 0,1), default tests elements",
	2, A_VALUE, E_NONE,  "add",	NULL,
	2, A_VALUE, E_NONE,  "sub",	NULL,
	1, A_VALUE, E_NONE,  "neg",	"negative",
	2, A_VALUE, E_NONE,  "mul",	NULL,
	2, A_VALUE, E_NONE,  "div",	"non-integral division",
	1, A_VALUE, E_NONE,  "inv",	"multiplicative inverse",
	2, A_VALUE, E_NONE,  "abs",	"absolute value within given error",
	1, A_VALUE, E_NONE,  "norm",	"square of absolute value",
	1, A_VALUE, E_NONE,  "conj",	"conjugate",
	2, A_VALUE, E_POW,   "pow",	"integer power, default does multiply, square, inverse",
	1, A_INT,   E_NONE,  "sgn",	"sign of value (-1, 0, 1)",
	2, A_INT,   E_CMP,   "cmp",	"equality (equal,nonequal => 0,1), default tests elements",
	2, A_INT,   E_NONE,  "rel",	"inequality (less,equal,greater => -1,0,1)",
	2, A_VALUE, E_NONE,  "quo",	"integer quotient",
	2, A_VALUE, E_NONE,  "mod",	"remainder of division",
	1, A_VALUE, E_NONE,  "int",	"integer part",
	1, A_VALUE, E_NONE,  "frac",	"fractional part",
	1, A_VALUE, E_INC,   "inc",	"increment, default adds 1",
	1, A_VALUE, E_DEC,   "dec",	"decrement, default subtracts 1",
	1, A_VALUE, E_SQUARE,"square",	"default multiplies by itself",
	2, A_VALUE, E_NONE,  "scale",	"multiply by power of 2",
	2, A_VALUE, E_NONE,  "shift",	"shift left by n bits (right if negative)",
	2, A_VALUE, E_NONE,  "round",	"round to given number of decimal places",
	2, A_VALUE, E_NONE,  "bround",	"round to given number of binary places",
	3, A_VALUE, E_NONE,  "root",	"root of value within given error",
	2, A_VALUE, E_NONE,  "sqrt",	"square root within given error",
	0, 0, 0, NULL
};


static STRINGHEAD objectnames;	/* names of objects */
static STRINGHEAD elements;	/* element names for parts of objects */
static OBJECTACTIONS *objects[MAXOBJECTS]; /* table of actions for objects */


/*
 * Free list of usual small objects.
 */
static FREELIST	freelist = {
	sizeof(OBJECT),		/* size of typical objects */
	100			/* number of free objects to keep */
};


static VALUE objpowi MATH_PROTO((VALUE *vp, NUMBER *q));
static BOOL objtest MATH_PROTO((OBJECT *op));
static BOOL objcmp MATH_PROTO((OBJECT *op1, OBJECT *op2));
static void objprint MATH_PROTO((OBJECT *op));


/*
 * Show all the routine names available for objects.
 */
void
showobjfuncs()
{
	register struct objectinfo *oip;

	printf("\nThe following object routines are definable.\n");
	printf("Note: xx represents the actual object type name.\n\n");
	printf("Name	Args	Comments\n");
	for (oip = objectinfo; oip->name; oip++) {
		printf("xx_%-8s %d	%s\n", oip->name, oip->args,
			oip->comment ? oip->comment : "");
	}
	printf("\n");
}


/*
 * Call the appropriate user-defined routine to handle an object action.
 * Returns the value that the routine returned.
 */
VALUE
objcall(action, v1, v2, v3)
	int action;
	VALUE *v1, *v2, *v3;
{
	FUNC *fp;		/* function to call */
	static OBJECTACTIONS *oap; /* object to call for */
	struct objectinfo *oip;	/* information about action */
	long index;		/* index of function (negative if undefined) */
	VALUE val;		/* return value */
	VALUE tmp;		/* temp value */
	char name[SYMBOLSIZE+1];	/* full name of user routine to call */

	if ((unsigned)action > OBJ_MAXFUNC)
		math_error("Illegal action for object call");
	oip = &objectinfo[action];
	if (v1->v_type == V_OBJ)
		oap = v1->v_obj->o_actions;
	else if (v2->v_type == V_OBJ)
		oap = v2->v_obj->o_actions;
	else
		math_error("Object routine called with non-object");
	index = oap->actions[action];
	if (index == 0) {
		strcpy(name, oap->name);
		strcat(name, "_");
		strcat(name, oip->name);
		index = adduserfunc(name);
		oap->actions[action] = index;
	}
	fp = NULL;
	if (index > 0)
		fp = findfunc(index);
	if (fp == NULL) {
		switch (oip->error) {
			case E_PRINT:
				objprint(v1->v_obj);
				val.v_type = V_NULL;
				break;
			case E_CMP:
				val.v_type = V_INT;
				if (v1->v_type != v2->v_type) {
					val.v_int = 1;
					return val;
				}
				val.v_int = objcmp(v1->v_obj, v2->v_obj);
				break;
			case E_TEST:
				val.v_type = V_INT;
				val.v_int = objtest(v1->v_obj);
				break;
			case E_POW:
				if (v2->v_type != V_NUM)
					math_error("Non-real power");
				val = objpowi(v1, v2->v_num);
				break;
			case E_ONE:
				val.v_type = V_NUM;
				val.v_num = qlink(&_qone_);
				break;
			case E_INC:
				tmp.v_type = V_NUM;
				tmp.v_num = &_qone_;
				val = objcall(OBJ_ADD, v1, &tmp, NULL_VALUE);
				break;
			case E_DEC:
				tmp.v_type = V_NUM;
				tmp.v_num = &_qone_;
				val = objcall(OBJ_SUB, v1, &tmp, NULL_VALUE);
				break;
			case E_SQUARE:
				val = objcall(OBJ_MUL, v1, v1, NULL_VALUE);
				break;
			default:
				math_error("Function \"%s\" is undefined", namefunc(index));
		}
		return val;
	}
	switch (oip->args) {
		case 0:
			break;
		case 1:
			++stack;
			stack->v_addr = v1;
			stack->v_type = V_ADDR;
			break;
		case 2:
			++stack;
			stack->v_addr = v1;
			stack->v_type = V_ADDR;
			++stack;
			stack->v_addr = v2;
			stack->v_type = V_ADDR;
			break;
		case 3:
			++stack;
			stack->v_addr = v1;
			stack->v_type = V_ADDR;
			++stack;
			stack->v_addr = v2;
			stack->v_type = V_ADDR;
			++stack;
			stack->v_addr = v3;
			stack->v_type = V_ADDR;
			break;
		default:
			math_error("Bad number of args to calculate");
	}
	calculate(fp, oip->args);
	switch (oip->retval) {
		case A_VALUE:
			return *stack--;
		case A_UNDEF:
			freevalue(stack--);
			val.v_type = V_NULL;
			break;
		case A_INT:
			if ((stack->v_type != V_NUM) || qisfrac(stack->v_num))
				math_error("Integer return value required");
			index = qtoi(stack->v_num);
			qfree(stack->v_num);
			stack--;
			val.v_type = V_INT;
			val.v_int = index;
			break;
		default:
			math_error("Bad object return");
	}
	return val;
}


/*
 * Routine called to clear the cache of known undefined functions for
 * the objects.  This changes negative indices back into positive ones
 * so that they will all be checked for existence again.
 */
void
objuncache()
{
	register int *ip;
	int i, j;

	i = objectnames.h_count;
	while (--i >= 0) {
		ip = objects[i]->actions;
		for (j = OBJ_MAXFUNC; j-- >= 0; ip++)
			if (*ip < 0)
				*ip = -*ip;
	}
}


/*
 * Print the elements of an object in short and unambiguous format.
 * This is the default routine if the user's is not defined.
 */
static void
objprint(op)
	OBJECT *op;		/* object being printed */
{
	int count;		/* number of elements */
	int i;			/* index */

	count = op->o_actions->count;
	math_fmt("obj %s {", op->o_actions->name);
	for (i = 0; i < count; i++) {
		if (i)
			math_str(", ");
		printvalue(&op->o_table[i], PRINT_SHORT | PRINT_UNAMBIG);
	}
	math_chr('}');
}


/*
 * Test an object for being "nonzero".
 * This is the default routine if the user's is not defined.
 * Returns TRUE if any of the elements are "nonzero".
 */
static BOOL
objtest(op)
	OBJECT *op;
{
	int i;			/* loop counter */

	i = op->o_actions->count;
	while (--i >= 0) {
		if (testvalue(&op->o_table[i]))
			return TRUE;
	}
	return FALSE;
}


/*
 * Compare two objects for equality, returning TRUE if they differ.
 * This is the default routine if the user's is not defined.
 * For equality, all elements must be equal.
 */
static BOOL
objcmp(op1, op2)
	OBJECT *op1, *op2;
{
	int i;			/* loop counter */

	if (op1->o_actions != op2->o_actions)
		return TRUE;
	i = op1->o_actions->count;