func.c

早期freebsd实现

			break;
		default:
			math_error("Bad argument type for rsearch");
	}
	result.v_type = V_NULL;
	if (index >= 0) {
		result.v_type = V_NUM;
		result.v_num = itoq(index);
	}
	return result;
}


static VALUE
f_list(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;

	result.v_type = V_LIST;
	result.v_list = listalloc();
	while (count-- > 0)
		insertlistlast(result.v_list, *vals++);
	return result;
}


/*ARGSUSED*/
static VALUE
f_assoc(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;

	result.v_type = V_ASSOC;
	result.v_assoc = assocalloc(0L);
	return result;
}


static VALUE
f_listinsert(v1, v2, v3)
	VALUE *v1, *v2, *v3;
{
	VALUE result;

	if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
		math_error("Inserting into non-list variable");
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v2->v_type != V_NUM) || qisfrac(v2->v_num))
		math_error("Non-integral index for list insert");
	if (v3->v_type == V_ADDR)
		v3 = v3->v_addr;
	insertlistmiddle(v1->v_addr->v_list, qtoi(v2->v_num), v3);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_listpush(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;

	if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
		math_error("Pushing onto non-list variable");
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	insertlistfirst(v1->v_addr->v_list, v2);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_listappend(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;

	if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
		math_error("Appending to non-list variable");
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	insertlistlast(v1->v_addr->v_list, v2);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_listdelete(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;

	if ((v1->v_type != V_ADDR) || (v1->v_addr->v_type != V_LIST))
		math_error("Deleting from non-list variable");
	if (v2->v_type == V_ADDR)
		v2 = v2->v_addr;
	if ((v2->v_type != V_NUM) || qisfrac(v2->v_num))
		math_error("Non-integral index for list delete");
	removelistmiddle(v1->v_addr->v_list, qtoi(v2->v_num), &result);
	return result;
}


static VALUE
f_listpop(vp)
	VALUE *vp;
{
	VALUE result;

	if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST))
		math_error("Popping from non-list variable");
	removelistfirst(vp->v_addr->v_list, &result);
	return result;
}


static VALUE
f_listremove(vp)
	VALUE *vp;
{
	VALUE result;

	if ((vp->v_type != V_ADDR) || (vp->v_addr->v_type != V_LIST))
		math_error("Removing from non-list variable");
	removelistlast(vp->v_addr->v_list, &result);
	return result;
}


/*
 * Return the current runtime of calc in seconds.
 * This is the user mode time only.
 */
static NUMBER *
f_runtime()
{
	struct tms buf;

	times(&buf);
	return iitoq((long) buf.tms_utime, (long) CLK_TCK);
}


static VALUE
f_fopen(v1, v2)
	VALUE *v1, *v2;
{
	VALUE result;
	FILEID id;

	if (v1->v_type != V_STR)
		math_error("Non-string filename for fopen");
	if (v2->v_type != V_STR)
		math_error("Non-string mode for fopen");
	id = openid(v1->v_str, v2->v_str);
	if (id == FILEID_NONE) {
		result.v_type = V_NUM;
		result.v_num = itoq((long) errno);
	} else {
		result.v_type = V_FILE;
		result.v_file = id;
	}
	return result;
}


static VALUE
f_fclose(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_FILE)
		math_error("Non-file for fclose");
	if (closeid(vp->v_file)) {
		result.v_type = V_NUM;
		result.v_num = itoq((long) errno);
	} else
		result.v_type = V_NULL;
	return result;
}


static VALUE
f_ferror(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_FILE)
		math_error("Non-file for ferror");
	result.v_type = V_NUM;
	result.v_num = itoq((long) errorid(vp->v_file));
	return result;
}


static VALUE
f_feof(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_FILE)
		math_error("Non-file for feof");
	result.v_type = V_NUM;
	result.v_num = itoq((long) eofid(vp->v_file));
	return result;
}


static VALUE
f_fflush(vp)
	VALUE *vp;
{
	VALUE result;

	if (vp->v_type != V_FILE)
		math_error("Non-file for fflush");
	flushid(vp->v_file);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_fprintf(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;

	if (vals[0]->v_type != V_FILE)
		math_error("Non-file for fprintf");
	if (vals[1]->v_type != V_STR)
		math_error("Non-string format for fprintf");
	idprintf(vals[0]->v_file, vals[1]->v_str, count - 2, vals + 2);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_printf(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;

	if (vals[0]->v_type != V_STR)
		math_error("Non-string format for printf");
	idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1);
	result.v_type = V_NULL;
	return result;
}


static VALUE
f_strprintf(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;

	if (vals[0]->v_type != V_STR)
		math_error("Non-string format for strprintf");
	math_divertio();
	idprintf(FILEID_STDOUT, vals[0]->v_str, count - 1, vals + 1);
	result.v_str = math_getdivertedio();
	result.v_type = V_STR;
	result.v_subtype = V_STRALLOC;
	return result;
}


static VALUE
f_fgetc(vp)
	VALUE *vp;
{
	VALUE result;
	int ch;

	if (vp->v_type != V_FILE)
		math_error("Non-file for fgetc");
	ch = getcharid(vp->v_file);
	result.v_type = V_NULL;
	if (ch != EOF) {
		result.v_type = V_STR;
		result.v_subtype = V_STRLITERAL;
		result.v_str = charstr(ch);
	}
	return result;
}


static VALUE
f_fgetline(vp)
	VALUE *vp;
{
	VALUE result;
	char *str;

	if (vp->v_type != V_FILE)
		math_error("Non-file for fgetline");
	readid(vp->v_file, &str);
	result.v_type = V_NULL;
	if (str) {
		result.v_type = V_STR;
		result.v_subtype = V_STRALLOC;
		result.v_str = str;
	}
	return result;
}


static VALUE
f_files(count, vals)
	int count;
	VALUE **vals;
{
	VALUE result;

	if (count == 0) {
		result.v_type = V_NUM;
		result.v_num = itoq((long) MAXFILES);
		return result;
	}
	if ((vals[0]->v_type != V_NUM) || qisfrac(vals[0]->v_num))
		math_error("Non-integer for files");
	result.v_type = V_NULL;
	result.v_file = indexid(qtoi(vals[0]->v_num));
	if (result.v_file != FILEID_NONE)
		result.v_type = V_FILE;
	return result;
}


/*
 * return a numerical 'value' of the mode/base
 */
static NUMBER *
base_value(mode)
	long mode;	/* a MODE_XYZ value */
{
	NUMBER *result;

	/* return the old base */
	switch (mode) {
	case MODE_DEFAULT:
		if (_outmode_ == MODE_DEFAULT) {
			result = itoq(10); /* firewall */
		} else {
			result = base_value(_outmode_);
		}
		break;
	case MODE_FRAC:
		result = qalloc();
		itoz(3, &result->den);
		break;
	case MODE_INT:
		result = itoq(-10);
		break;
	case MODE_REAL:
		result = itoq(10);
		break;
	case MODE_EXP:
		result = qalloc();
		ztenpow(20, &result->num);
		break;
	case MODE_HEX:
		result = itoq(16);
		break;
	case MODE_OCTAL:
		result = itoq(8);
		break;
	case MODE_BINARY:
		result = itoq(2);
		break;
	default:
		result = itoq(0);
		break;
	}
	return result;
}


/*
 * set the default output base/mode
 */
static NUMBER *
f_base(count, vals)
	int count;
	NUMBER **vals;
{
	long base;	/* output base/mode */
	long oldbase=0;	/* output base/mode */

	/* deal with just a query */
	if (count != 1) {
		return base_value(_outmode_);
	}

	/* deal with the specal modes first */
	if (qisfrac(vals[0])) {
		return base_value(math_setmode(MODE_FRAC));
	}
	if (vals[0]->num.len > 64/BASEB) {
		return base_value(math_setmode(MODE_EXP));
	}

	/* set the base, if possible */
	base = qtoi(vals[0]);
	switch (base) {
	case -10:
		oldbase = math_setmode(MODE_INT);
		break;
	case 2:
		oldbase = math_setmode(MODE_BINARY);
		break;
	case 8:
		oldbase = math_setmode(MODE_OCTAL);
		break;
	case 10:
		oldbase = math_setmode(MODE_REAL);
		break;
	case 16:
		oldbase = math_setmode(MODE_HEX);
		break;
	default:
		math_error("Unsupported base");
		break;
	}

	/* return the old base */
	return base_value(oldbase);
}


/*
 * Show the list of primitive built-in functions
 */
void
showbuiltins()
{
	register struct builtin *bp;	/* current function */

	printf("\nName\tArgs\tDescription\n\n");
	for (bp = builtins; bp->b_name; bp++) {
		printf("%-9s ", bp->b_name);
		if (bp->b_maxargs == IN)
			printf("%d+    ", bp->b_minargs);
		else if (bp->b_minargs == bp->b_maxargs)
			printf("%-6d", bp->b_minargs);
		else
			printf("%d-%-4d", bp->b_minargs, bp->b_maxargs);
		printf(" %s\n", bp->b_desc);
	}
	printf("\n");
}


/*
 * Return the index of a built-in function given its name.
 * Returns minus one if the name is not known.
 */
int
getbuiltinfunc(name)
	char *name;
{
	register struct builtin *bp;

	for (bp = builtins; bp->b_name; bp++) {
		if ((*name == *bp->b_name) && (strcmp(name, bp->b_name) == 0))
		return (bp - builtins);
	}
	return -1;
}


/*
 * Given the index of a built-in function, return its name.
 */
char *
builtinname(index)
	long index;
{
	if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
		return "";
	return builtins[index].b_name;
}


/*
 * Given the index of a built-in function, and the number of arguments seen,
 * determine if the number of arguments are legal.  This routine is called
 * during parsing time.
 */
void
builtincheck(index, count)
	int count;
	long index;
{
	register struct builtin *bp;

	if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
		math_error("Unknown built in index");
	bp = &builtins[index];
	if (count < bp->b_minargs)
		scanerror(T_NULL, "Too few arguments for builtin function \"%s\"",
	bp->b_name);
	if (count > bp->b_maxargs)
		scanerror(T_NULL, "Too many arguments for builtin function \"%s\"",
			bp->b_name);
}


/*
 * Return the opcode for a built-in function that can be used to avoid
 * the function call at all.
 */
int
builtinopcode(index)
	long index;
{
	if ((unsigned long)index >= (sizeof(builtins) / sizeof(builtins[0])) - 1)
		return OP_NOP;
	return builtins[index].b_opcode;
}

/* END CODE */