factor/native/arithmetic.c

#include "factor.h"

void primitive_arithmetic_type(void)
{
	CELL obj1 = dpeek(), obj2 = get(ds - CELLS);
	CELL type1 = TAG(obj1), type2 = TAG(obj2);

	switch(type2)
	{
	case FIXNUM_TYPE:
		switch(type1)
		{
		case BIGNUM_TYPE:
			put(ds - CELLS,tag_bignum(to_bignum(obj2)));
			break;
		case FLOAT_TYPE:
			put(ds - CELLS,tag_float(to_float((obj2))));
			break;
		}
		dpush(tag_fixnum(type1));
		break;
	case BIGNUM_TYPE:
		switch(type1)
		{
		case FIXNUM_TYPE:
			drepl(tag_bignum(to_bignum(obj1)));
			dpush(tag_fixnum(type2));
			break;
		case FLOAT_TYPE:
			put(ds - CELLS,tag_float(to_float((obj2))));
			dpush(tag_fixnum(type1));
			break;
		default:
			dpush(tag_fixnum(type1));
			break;
		}
		break;
	case RATIO_TYPE:
		switch(type1)
		{
		case FIXNUM_TYPE: case BIGNUM_TYPE:
			dpush(tag_fixnum(type2));
			break;
		case FLOAT_TYPE:
			put(ds - CELLS,tag_float(to_float((obj2))));
			dpush(tag_fixnum(type1));
			break;
		default:
			dpush(tag_fixnum(type1));
			break;
		}
		break;
	case FLOAT_TYPE:
		switch(type1)
		{
		case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE:
			drepl(tag_float(to_float(obj1)));
			dpush(tag_fixnum(type2));
			break;
		default:
			dpush(tag_fixnum(type1));
			break;
		}
		break;
	case COMPLEX_TYPE:
		switch(type1)
		{
		case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE: case FLOAT_TYPE:
			dpush(tag_fixnum(type2));
			break;
		default:
			dpush(tag_fixnum(type1));
			break;
		}
		break;
	default:
		dpush(tag_fixnum(type2));
		break;
	}
}
working on 64-bit fake 'bignums' 2004-07-28 19:02:24 -04:00			`#include "factor.h"`

marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`void primitive_arithmetic_type(void)`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`{`
halos 2005-03-03 20:43:55 -05:00			`CELL obj1 = dpeek(), obj2 = get(ds - CELLS);`
			`CELL type1 = TAG(obj1), type2 = TAG(obj2);`
slightly faster type checking 2004-09-19 00:57:33 -04:00
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`switch(type2)`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`{`
			`case FIXNUM_TYPE:`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`switch(type1)`
			`{`
			`case BIGNUM_TYPE:`
faster generic arithmetic, messing around with inference 2005-01-16 17:58:28 -05:00			`put(ds - CELLS,tag_bignum(to_bignum(obj2)));`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`break;`
			`case FLOAT_TYPE:`
faster generic arithmetic, messing around with inference 2005-01-16 17:58:28 -05:00			`put(ds - CELLS,tag_float(to_float((obj2))));`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`break;`
			`}`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`case BIGNUM_TYPE:`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`switch(type1)`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`{`
			`case FIXNUM_TYPE:`
faster generic arithmetic, messing around with inference 2005-01-16 17:58:28 -05:00			`drepl(tag_bignum(to_bignum(obj1)));`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type2));`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`break;`
			`case FLOAT_TYPE:`
faster generic arithmetic, messing around with inference 2005-01-16 17:58:28 -05:00			`put(ds - CELLS,tag_float(to_float((obj2))));`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`default:`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`}`
working on the FFI 2004-09-19 17:39:28 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`case RATIO_TYPE:`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`switch(type1)`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`{`
halos 2005-03-03 20:43:55 -05:00			`case FIXNUM_TYPE: case BIGNUM_TYPE:`
			`dpush(tag_fixnum(type2));`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`break;`
			`case FLOAT_TYPE:`
faster generic arithmetic, messing around with inference 2005-01-16 17:58:28 -05:00			`put(ds - CELLS,tag_float(to_float((obj2))));`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`default:`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`}`
working on the FFI 2004-09-19 17:39:28 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`case FLOAT_TYPE:`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`switch(type1)`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`{`
halos 2005-03-03 20:43:55 -05:00			`case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE:`
faster generic arithmetic, messing around with inference 2005-01-16 17:58:28 -05:00			`drepl(tag_float(to_float(obj1)));`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type2));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`default:`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`}`
working on the FFI 2004-09-19 17:39:28 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`case COMPLEX_TYPE:`
marginally faster generic arithmetic 2004-12-18 20:24:46 -05:00			`switch(type1)`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`{`
halos 2005-03-03 20:43:55 -05:00			`case FIXNUM_TYPE: case BIGNUM_TYPE: case RATIO_TYPE: case FLOAT_TYPE:`
			`dpush(tag_fixnum(type2));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`default:`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type1));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`}`
working on the FFI 2004-09-19 17:39:28 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`default:`
halos 2005-03-03 20:43:55 -05:00			`dpush(tag_fixnum(type2));`
slightly faster type checking 2004-09-19 00:57:33 -04:00			`break;`
some minor cleanups in preparation for landing of s48 bignums 2004-08-25 00:26:49 -04:00			`}`
rewrote generic arithmetic in factor 2004-09-19 00:33:40 -04:00			`}`