Diff | Source/Git

Download diff

	4b825dc642cb6eb9a060e54bf8d69288fbee4904		cfad47cfa334b206c65f22086bcc5d63e6f70944
		1	#ifdef RCSID
		2	static char RCSid[] =
		3	"$Header$";
		4	#endif
		5
		6	/*
		7	* Copyright (c) 2000, 2002 Michael J. Roberts. All Rights Reserved.
		8	*
		9	* Please see the accompanying license file, LICENSE.TXT, for information
		10	* on using and copying this software.
		11	*/
		12	/*
		13	Name
		14	vmbignum.cpp - big number metaclass
		15	Function
		16
		17	Notes
		18
		19	Modified
		20	02/18/00 MJRoberts - Creation
		21	*/
		22
		23	#include <stdlib.h>
		24	#include <string.h>
		25	#include <assert.h>
		26	#include <limits.h>
		27	#include <stdarg.h>
		28
		29	#include "t3std.h"
		30	#include "vmtype.h"
		31	#include "vmmcreg.h"
		32	#include "vmbignum.h"
		33	#include "vmobj.h"
		34	#include "vmerr.h"
		35	#include "vmerrnum.h"
		36	#include "vmfile.h"
		37	#include "vmpool.h"
		38	#include "vmstack.h"
		39	#include "utf8.h"
		40	#include "vmstr.h"
		41	#include "vmbif.h"
		42	#include "vmmeta.h"
		43	#include "vmlst.h"
		44
		45
		46	/* ------------------------------------------------------------------------ */
		47	/*
		48	* statics
		49	*/
		50
		51	/* metaclass registration object */
		52	static CVmMetaclassBigNum metaclass_reg_obj;
		53	CVmMetaclass *CVmObjBigNum::metaclass_reg_ = &metaclass_reg_obj;
		54
		55	/* function table */
		56	int (CVmObjBigNum::
		57	*CVmObjBigNum::func_table_[])(VMG_ vm_obj_id_t self,
		58	vm_val_t retval, uint argc) =
		59	{
		60	&CVmObjBigNum::getp_undef,
		61	&CVmObjBigNum::getp_format,
		62	&CVmObjBigNum::getp_equal_rnd,
		63	&CVmObjBigNum::getp_get_prec,
		64	&CVmObjBigNum::getp_set_prec,
		65	&CVmObjBigNum::getp_frac,
		66	&CVmObjBigNum::getp_whole,
		67	&CVmObjBigNum::getp_round_dec,
		68	&CVmObjBigNum::getp_abs,
		69	&CVmObjBigNum::getp_ceil,
		70	&CVmObjBigNum::getp_floor,
		71	&CVmObjBigNum::getp_get_scale,
		72	&CVmObjBigNum::getp_scale,
		73	&CVmObjBigNum::getp_negate,
		74	&CVmObjBigNum::getp_copy_sign,
		75	&CVmObjBigNum::getp_is_neg,
		76	&CVmObjBigNum::getp_remainder,
		77	&CVmObjBigNum::getp_sin,
		78	&CVmObjBigNum::getp_cos,
		79	&CVmObjBigNum::getp_tan,
		80	&CVmObjBigNum::getp_deg2rad,
		81	&CVmObjBigNum::getp_rad2deg,
		82	&CVmObjBigNum::getp_asin,
		83	&CVmObjBigNum::getp_acos,
		84	&CVmObjBigNum::getp_atan,
		85	&CVmObjBigNum::getp_sqrt,
		86	&CVmObjBigNum::getp_ln,
		87	&CVmObjBigNum::getp_exp,
		88	&CVmObjBigNum::getp_log10,
		89	&CVmObjBigNum::getp_pow,
		90	&CVmObjBigNum::getp_sinh,
		91	&CVmObjBigNum::getp_cosh,
		92	&CVmObjBigNum::getp_tanh,
		93	&CVmObjBigNum::getp_pi,
		94	&CVmObjBigNum::getp_e
		95	};
		96
		97
		98	/* constant value 1 */
		99	const unsigned char CVmObjBigNum::one_[] =
		100	{
		101	/* number of digits - we just need one to represent the integer 1 */
		102	0x01, 0x00,
		103
		104	/* exponent */
		105	0x01, 0x00,
		106
		107	/* flags */
		108	0x00,
		109
		110	/* mantissa - just one digit is needed, but pad out the byte with zero */
		111	0x10
		112	};
		113
		114	#if 0
		115	/*
		116	* Pi to 2048 digits
		117	*/
		118	const unsigned char CVmObjBigNum::pi_[] =
		119	{
		120	/* number of digits of precision */
		121	0x00, 0x08,
		122
		123	/* base-10 exponent */
		124	0x01, 0x00,
		125
		126	/* flags */
		127	0x00,
		128
		129	/*
		130	* the first 2048 decimal digits of pi, packed two to a byte (typed
		131	* in from memory, I hope I got everything right :)
		132	*/
		133
		134	/* 1-100 */
		135	0x31, 0x41, 0x59, 0x26, 0x53, 0x58, 0x97, 0x93, 0x23, 0x84,
		136	0x62, 0x64, 0x33, 0x83, 0x27, 0x95, 0x02, 0x88, 0x41, 0x97,
		137	0x16, 0x93, 0x99, 0x37, 0x51, 0x05, 0x82, 0x09, 0x74, 0x94,
		138	0x45, 0x92, 0x30, 0x78, 0x16, 0x40, 0x62, 0x86, 0x20, 0x89,
		139	0x98, 0x62, 0x80, 0x34, 0x82, 0x53, 0x42, 0x11, 0x70, 0x67,
		140
		141	/* 101-200 */
		142	0x98, 0x21, 0x48, 0x08, 0x65, 0x13, 0x28, 0x23, 0x06, 0x64,
		143	0x70, 0x93, 0x84, 0x46, 0x09, 0x55, 0x05, 0x82, 0x23, 0x17,
		144	0x25, 0x35, 0x94, 0x08, 0x12, 0x84, 0x81, 0x11, 0x74, 0x50,
		145	0x28, 0x41, 0x02, 0x70, 0x19, 0x38, 0x52, 0x11, 0x05, 0x55,
		146	0x96, 0x44, 0x62, 0x29, 0x48, 0x95, 0x49, 0x30, 0x38, 0x19,
		147
		148	/* 201-300 */
		149	0x64, 0x42, 0x88, 0x10, 0x97, 0x56, 0x65, 0x93, 0x34, 0x46,
		150	0x12, 0x84, 0x75, 0x64, 0x82, 0x33, 0x78, 0x67, 0x83, 0x16,
		151	0x52, 0x71, 0x20, 0x19, 0x09, 0x14, 0x56, 0x48, 0x56, 0x69,
		152	0x23, 0x46, 0x03, 0x48, 0x61, 0x04, 0x54, 0x32, 0x66, 0x48,
		153	0x21, 0x33, 0x93, 0x60, 0x72, 0x60, 0x24, 0x91, 0x41, 0x27,
		154
		155	/* 301-400 */
		156	0x37, 0x24, 0x58, 0x70, 0x06, 0x60, 0x63, 0x15, 0x58, 0x81,
		157	0x74, 0x88, 0x15, 0x20, 0x92, 0x09, 0x62, 0x82, 0x92, 0x54,
		158	0x09, 0x17, 0x15, 0x36, 0x43, 0x67, 0x89, 0x25, 0x90, 0x36,
		159	0x00, 0x11, 0x33, 0x05, 0x30, 0x54, 0x88, 0x20, 0x46, 0x65,
		160	0x21, 0x38, 0x41, 0x46, 0x95, 0x19, 0x41, 0x51, 0x16, 0x09,
		161
		162	/* 401-500 */
		163	0x43, 0x30, 0x57, 0x27, 0x03, 0x65, 0x75, 0x95, 0x91, 0x95,
		164	0x30, 0x92, 0x18, 0x61, 0x17, 0x38, 0x19, 0x32, 0x61, 0x17,
		165	0x93, 0x10, 0x51, 0x18, 0x54, 0x80, 0x74, 0x46, 0x23, 0x79,
		166	0x96, 0x27, 0x49, 0x56, 0x73, 0x51, 0x88, 0x57, 0x52, 0x72,
		167	0x48, 0x91, 0x22, 0x79, 0x38, 0x18, 0x30, 0x11, 0x94, 0x91,
		168
		169	/* 501-600 */
		170	0x29, 0x83, 0x36, 0x73, 0x36, 0x24, 0x40, 0x65, 0x66, 0x43,
		171	0x08, 0x60, 0x21, 0x39, 0x49, 0x46, 0x39, 0x52, 0x24, 0x73,
		172	0x71, 0x90, 0x70, 0x21, 0x79, 0x86, 0x09, 0x43, 0x70, 0x27,
		173	0x70, 0x53, 0x92, 0x17, 0x17, 0x62, 0x93, 0x17, 0x67, 0x52,
		174	0x38, 0x46, 0x74, 0x81, 0x84, 0x67, 0x66, 0x94, 0x05, 0x13,
		175
		176	/* 601-700 */
		177	0x20, 0x00, 0x56, 0x81, 0x27, 0x14, 0x52, 0x63, 0x56, 0x08,
		178	0x27, 0x78, 0x57, 0x71, 0x34, 0x27, 0x57, 0x78, 0x96, 0x09,
		179	0x17, 0x36, 0x37, 0x17, 0x87, 0x21, 0x46, 0x84, 0x40, 0x90,
		180	0x12, 0x24, 0x95, 0x34, 0x30, 0x14, 0x65, 0x49, 0x58, 0x53,
		181	0x71, 0x05, 0x07, 0x92, 0x27, 0x96, 0x89, 0x25, 0x89, 0x23,
		182
		183	/* 701-800 */
		184	0x54, 0x20, 0x19, 0x95, 0x61, 0x12, 0x12, 0x90, 0x21, 0x96,
		185	0x08, 0x64, 0x03, 0x44, 0x18, 0x15, 0x98, 0x13, 0x62, 0x97,
		186	0x74, 0x77, 0x13, 0x09, 0x96, 0x05, 0x18, 0x70, 0x72, 0x11,
		187	0x34, 0x99, 0x99, 0x99, 0x83, 0x72, 0x97, 0x80, 0x49, 0x95,
		188	0x10, 0x59, 0x73, 0x17, 0x32, 0x81, 0x60, 0x96, 0x31, 0x85,
		189
		190	/* 801-900 */
		191	0x95, 0x02, 0x44, 0x59, 0x45, 0x53, 0x46, 0x90, 0x83, 0x02,
		192	0x64, 0x25, 0x22, 0x30, 0x82, 0x53, 0x34, 0x46, 0x85, 0x03,
		193	0x52, 0x61, 0x93, 0x11, 0x88, 0x17, 0x10, 0x10, 0x00, 0x31,
		194	0x37, 0x83, 0x87, 0x52, 0x88, 0x65, 0x87, 0x53, 0x32, 0x08,
		195	0x38, 0x14, 0x20, 0x61, 0x71, 0x77, 0x66, 0x91, 0x47, 0x30,
		196
		197	/* 901-1000 */
		198	0x35, 0x98, 0x25, 0x34, 0x90, 0x42, 0x87, 0x55, 0x46, 0x87,
		199	0x31, 0x15, 0x95, 0x62, 0x86, 0x38, 0x82, 0x35, 0x37, 0x87,
		200	0x59, 0x37, 0x51, 0x95, 0x77, 0x81, 0x85, 0x77, 0x80, 0x53,
		201	0x21, 0x71, 0x22, 0x68, 0x06, 0x61, 0x30, 0x01, 0x92, 0x78,
		202	0x76, 0x61, 0x11, 0x95, 0x90, 0x92, 0x16, 0x42, 0x01, 0x98,
		203
		204	/* 1001-1100 */
		205	0x93, 0x80, 0x95, 0x25, 0x72, 0x01, 0x06, 0x54, 0x85, 0x86,
		206	0x32, 0x78, 0x86, 0x59, 0x36, 0x15, 0x33, 0x81, 0x82, 0x79,
		207	0x68, 0x23, 0x03, 0x01, 0x95, 0x20, 0x35, 0x30, 0x18, 0x52,
		208	0x96, 0x89, 0x95, 0x77, 0x36, 0x22, 0x59, 0x94, 0x13, 0x89,
		209	0x12, 0x49, 0x72, 0x17, 0x75, 0x28, 0x34, 0x79, 0x13, 0x15,
		210
		211	/* 1101-1200 */
		212	0x15, 0x57, 0x48, 0x57, 0x24, 0x24, 0x54, 0x15, 0x06, 0x95,
		213	0x95, 0x08, 0x29, 0x53, 0x31, 0x16, 0x86, 0x17, 0x27, 0x85,
		214	0x58, 0x89, 0x07, 0x50, 0x98, 0x38, 0x17, 0x54, 0x63, 0x74,
		215	0x64, 0x93, 0x93, 0x19, 0x25, 0x50, 0x60, 0x40, 0x09, 0x27,
		216	0x70, 0x16, 0x71, 0x13, 0x90, 0x09, 0x84, 0x88, 0x24, 0x01,
		217
		218	/* 1201-1300 */
		219	0x28, 0x58, 0x36, 0x16, 0x03, 0x56, 0x37, 0x07, 0x66, 0x01,
		220	0x04, 0x71, 0x01, 0x81, 0x94, 0x29, 0x55, 0x59, 0x61, 0x98,
		221	0x94, 0x67, 0x67, 0x83, 0x74, 0x49, 0x44, 0x82, 0x55, 0x37,
		222	0x97, 0x74, 0x72, 0x68, 0x47, 0x10, 0x40, 0x47, 0x53, 0x46,
		223	0x46, 0x20, 0x80, 0x46, 0x68, 0x42, 0x59, 0x06, 0x94, 0x91,
		224
		225	/* 1301-1400 */
		226	0x29, 0x33, 0x13, 0x67, 0x70, 0x28, 0x98, 0x91, 0x52, 0x10,
		227	0x47, 0x52, 0x16, 0x20, 0x56, 0x96, 0x60, 0x24, 0x05, 0x80,
		228	0x38, 0x15, 0x01, 0x93, 0x51, 0x12, 0x53, 0x38, 0x24, 0x30,
		229	0x03, 0x55, 0x87, 0x64, 0x02, 0x47, 0x49, 0x64, 0x73, 0x26,
		230	0x39, 0x14, 0x19, 0x92, 0x72, 0x60, 0x42, 0x69, 0x92, 0x27,
		231
		232	/* 1401-1500 */
		233	0x96, 0x78, 0x23, 0x54, 0x78, 0x16, 0x36, 0x00, 0x93, 0x41,
		234	0x72, 0x16, 0x41, 0x21, 0x99, 0x24, 0x58, 0x63, 0x15, 0x03,
		235	0x02, 0x86, 0x18, 0x29, 0x74, 0x55, 0x57, 0x06, 0x74, 0x98,
		236	0x38, 0x50, 0x54, 0x94, 0x58, 0x85, 0x86, 0x92, 0x69, 0x95,
		237	0x69, 0x09, 0x27, 0x21, 0x07, 0x97, 0x50, 0x93, 0x02, 0x95,
		238
		239	/* 1501-1600 */
		240	0x53, 0x21, 0x16, 0x53, 0x44, 0x98, 0x72, 0x02, 0x75, 0x59,
		241	0x60, 0x23, 0x64, 0x80, 0x66, 0x54, 0x99, 0x11, 0x98, 0x81,
		242	0x83, 0x47, 0x97, 0x75, 0x35, 0x66, 0x36, 0x98, 0x07, 0x42,
		243	0x65, 0x42, 0x52, 0x78, 0x62, 0x55, 0x18, 0x18, 0x41, 0x75,
		244	0x74, 0x67, 0x28, 0x90, 0x97, 0x77, 0x72, 0x79, 0x38, 0x00,
		245
		246	/* 1601-1700 */
		247	0x08, 0x16, 0x47, 0x06, 0x00, 0x16, 0x14, 0x52, 0x49, 0x19,
		248	0x21, 0x73, 0x21, 0x72, 0x14, 0x77, 0x23, 0x50, 0x14, 0x14,
		249	0x41, 0x97, 0x35, 0x68, 0x54, 0x81, 0x61, 0x36, 0x11, 0x57,
		250	0x35, 0x25, 0x52, 0x13, 0x34, 0x75, 0x74, 0x18, 0x49, 0x46,
		251	0x84, 0x38, 0x52, 0x33, 0x23, 0x90, 0x73, 0x94, 0x14, 0x33,
		252
		253	/* 1701-1800 */
		254	0x34, 0x54, 0x77, 0x62, 0x41, 0x68, 0x62, 0x51, 0x89, 0x83,
		255	0x56, 0x94, 0x85, 0x56, 0x20, 0x99, 0x21, 0x92, 0x22, 0x18,
		256	0x42, 0x72, 0x55, 0x02, 0x54, 0x25, 0x68, 0x87, 0x67, 0x17,
		257	0x90, 0x49, 0x46, 0x01, 0x65, 0x34, 0x66, 0x80, 0x49, 0x88,
		258	0x62, 0x72, 0x32, 0x79, 0x17, 0x86, 0x08, 0x57, 0x84, 0x38,
		259
		260	/* 1801-1900 */
		261	0x38, 0x27, 0x96, 0x79, 0x76, 0x68, 0x14, 0x54, 0x10, 0x09,
		262	0x53, 0x88, 0x37, 0x86, 0x36, 0x09, 0x50, 0x68, 0x00, 0x64,
		263	0x22, 0x51, 0x25, 0x20, 0x51, 0x17, 0x39, 0x29, 0x84, 0x89,
		264	0x60, 0x84, 0x12, 0x84, 0x88, 0x62, 0x69, 0x45, 0x60, 0x42,
		265	0x41, 0x96, 0x52, 0x85, 0x02, 0x22, 0x10, 0x66, 0x11, 0x86,
		266
		267	/* 1901-2000 */
		268	0x30, 0x67, 0x44, 0x27, 0x86, 0x22, 0x03, 0x91, 0x94, 0x94,
		269	0x50, 0x47, 0x12, 0x37, 0x13, 0x78, 0x69, 0x60, 0x95, 0x63,
		270	0x64, 0x37, 0x19, 0x17, 0x28, 0x74, 0x67, 0x76, 0x46, 0x57,
		271	0x57, 0x39, 0x62, 0x41, 0x38, 0x90, 0x86, 0x58, 0x32, 0x64,
		272	0x59, 0x95, 0x81, 0x33, 0x90, 0x47, 0x80, 0x27, 0x59, 0x00,
		273
		274	/* 2001-2048 */
		275	0x99, 0x46, 0x57, 0x64, 0x07, 0x89, 0x51, 0x26, 0x94, 0x68,
		276	0x39, 0x83, 0x52, 0x59, 0x57, 0x09, 0x82, 0x58, 0x22, 0x62,
		277	0x05, 0x22, 0x48, 0x94
		278	};
		279	#endif
		280
		281	/* ------------------------------------------------------------------------ */
		282	/*
		283	* Static creation methods. These routines allocate an object ID and
		284	* create a new object.
		285	*/
		286
		287
		288	/* create dynamically using stack arguments */
		289	vm_obj_id_t CVmObjBigNum::create_from_stack(VMG_ const uchar **pc_ptr,
		290	uint argc)
		291	{
		292	vm_obj_id_t id;
		293	vm_val_t *val;
		294	size_t digits;
		295	const char *strval = 0;
		296	const CVmObjBigNum *objval = 0;
		297
		298	/* check arguments */
		299	if (argc < 1 \|\| argc > 2)
		300	err_throw(VMERR_WRONG_NUM_OF_ARGS);
		301
		302	/*
		303	* check the first argument, which gives the source value - this can be
		304	* an integer, a string, or another BigNumber value
		305	*/
		306	val = G_stk->get(0);
		307	if (val->typ == VM_INT)
		308	{
		309	/* we'll use the integer value */
		310	}
		311	else if (val->typ == VM_OBJ && is_bignum_obj(vmg_ val->val.obj))
		312	{
		313	/* we'll use the BigNumber value as the source */
		314	objval = (CVmObjBigNum *)vm_objp(vmg_ val->val.obj);
		315	}
		316	else if ((strval = val->get_as_string(vmg0_)) != 0)
		317	{
		318	/* we'll parse the string value */
		319	}
		320	else
		321	{
		322	/* it's not a source type we accept */
		323	err_throw(VMERR_NUM_VAL_REQD);
		324	}
		325
		326	/*
		327	* get the precision value, if provided; if not, infer it from the
		328	* source value
		329	*/
		330	if (argc > 1)
		331	{
		332	/* make sure it's an integer */
		333	if (G_stk->get(1)->typ != VM_INT)
		334	err_throw(VMERR_INT_VAL_REQD);
		335
		336	/* retrieve the value */
		337	digits = (size_t)G_stk->get(1)->val.intval;
		338	}
		339	else if (strval != 0)
		340	{
		341	utf8_ptr p;
		342	size_t rem;
		343	size_t prec;
		344	int pt;
		345	int significant;
		346	int digcnt;
		347
		348	/* set up to scan the string */
		349	p.set((char *)strval + VMB_LEN);
		350	rem = vmb_get_len(strval);
		351
		352	/* skip leading spaces */
		353	for ( ; rem != 0 && is_space(p.getch()) ; p.inc(&rem)) ;
		354
		355	/* skip the sign if present */
		356	if (rem != 0 && (p.getch() == '-' \|\| p.getch() == '+'))
		357	p.inc(&rem);
		358
		359	/* we haven't yet found a significant leading digit */
		360	significant = FALSE;
		361
		362	/* scan digits */
		363	for (prec = 0, digcnt = 0, pt = FALSE ; rem != 0 ; p.inc(&rem))
		364	{
		365	wchar_t ch;
		366
		367	/* get this character */
		368	ch = p.getch();
		369
		370	/* see what we have */
		371	if (is_digit(ch))
		372	{
		373	/*
		374	* if it's not a zero, note that we've found a
		375	* significant digit
		376	*/
		377	if (ch != '0')
		378	significant = TRUE;
		379
		380	/*
		381	* if we have found a significant digit so far, count
		382	* this one - do not count leading zeroes, whether they
		383	* occur before or after the decimal point
		384	*/
		385	if (significant)
		386	++prec;
		387
		388	/* count the digit in any case */
		389	++digcnt;
		390	}
		391	else if (ch == '.' && !pt)
		392	{
		393	/* decimal point - note it and keep going */
		394	pt = TRUE;
		395	}
		396	else if (ch == 'e' \|\| ch == 'E')
		397	{
		398	/* exponent - that's the end of the mantissa */
		399	break;
		400	}
		401	else
		402	{
		403	/* we've reached the end of the number */
		404	break;
		405	}
		406	}
		407
		408	/*
		409	* if the precision is zero, the number must be zero - use the
		410	* actual number of digits for the default precision, so that a
		411	* value specified as "0.0000000" has eight digits of precision
		412	*/
		413	if (prec == 0)
		414	prec = digcnt;
		415
		416	/* use the precision necessary to store the entire string */
		417	digits = prec;
		418	}
		419	else if (objval != 0)
		420	{
		421	/* use the same precision as the source BigNumber value */
		422	digits = get_prec(objval->get_ext());
		423	}
		424	else
		425	{
		426	/* use a default precision */
		427	digits = 32;
		428	}
		429
		430	/* create the value */
		431	if (strval != 0)
		432	{
		433	/* create the value from the string */
		434	id = vm_new_id(vmg_ FALSE, FALSE, FALSE);
		435	new (vmg_ id) CVmObjBigNum(vmg_ strval + VMB_LEN,
		436	vmb_get_len(strval), digits);
		437	}
		438	else if (objval != 0)
		439	{
		440	vm_val_t new_val;
		441
		442	/* create the value based on the BigNumber value */
		443	round_val(vmg_ &new_val, objval->get_ext(), digits, TRUE);
		444
		445	/* return the new object ID */
		446	id = new_val.val.obj;
		447	}
		448	else
		449	{
		450	/* create the value based on the integer value */
		451	id = vm_new_id(vmg_ FALSE, FALSE, FALSE);
		452	new (vmg_ id) CVmObjBigNum(vmg_ val->val.intval, digits);
		453	}
		454
		455	/* discard arguments */
		456	G_stk->discard(argc);
		457
		458	/* return the new object */
		459	return id;
		460	}
		461
		462	/* create with a given precision */
		463	vm_obj_id_t CVmObjBigNum::create(VMG_ int in_root_set, size_t digits)
		464	{
		465	vm_obj_id_t id = vm_new_id(vmg_ in_root_set, FALSE, FALSE);
		466	new (vmg_ id) CVmObjBigNum(vmg_ digits);
		467	return id;
		468	}
		469
		470	/* create from an integer value */
		471	vm_obj_id_t CVmObjBigNum::create(VMG_ int in_root_set,
		472	long val, size_t digits)
		473	{
		474	vm_obj_id_t id = vm_new_id(vmg_ in_root_set, FALSE, FALSE);
		475	new (vmg_ id) CVmObjBigNum(vmg_ val, digits);
		476	return id;
		477	}
		478
		479	/* ------------------------------------------------------------------------ */
		480	/*
		481	* Constructors. These are called indirectly through our static
		482	* creation methods.
		483	*/
		484
		485	/*
		486	* Create with no extension
		487	*/
		488	CVmObjBigNum::CVmObjBigNum()
		489	{
		490	/* no extension */
		491	ext_ = 0;
		492	}
		493
		494	/*
		495	* Create with a given precision
		496	*/
		497	CVmObjBigNum::CVmObjBigNum(VMG_ size_t digits)
		498	{
		499	/* allocate space */
		500	alloc_bignum(vmg_ digits);
		501	}
		502
		503	/*
		504	* Create with a given integer value
		505	*/
		506	CVmObjBigNum::CVmObjBigNum(VMG_ long val, size_t digits)
		507	{
		508	/* allocate space */
		509	alloc_bignum(vmg_ digits);
		510
		511	/* set the value */
		512	set_int_val(val);
		513	}
		514
		515	/*
		516	* Create with a given string as the source value
		517	*/
		518	CVmObjBigNum::CVmObjBigNum(VMG_ const char *str, size_t len, size_t digits)
		519	{
		520	/* allocate space */
		521	alloc_bignum(vmg_ digits);
		522
		523	/* set the value */
		524	set_str_val(str, len);
		525	}
		526
		527	/* ------------------------------------------------------------------------ */
		528	/*
		529	* Delete
		530	*/
		531	void CVmObjBigNum::notify_delete(VMG_ int in_root_set)
		532	{
		533	/*
		534	* free our extension - do this only if it's not in the root set,
		535	* because extension will be directly in the image data for a root
		536	* set object
		537	*/
		538	if (ext_ != 0 && !in_root_set)
		539	G_mem->get_var_heap()->free_mem(ext_);
		540	}
		541
		542
		543	/* ------------------------------------------------------------------------ */
		544	/*
		545	* Allocate space for a given precision
		546	*/
		547	void CVmObjBigNum::alloc_bignum(VMG_ size_t digits)
		548	{
		549	/* allocate space for the given number of elements */
		550	ext_ = (char *)G_mem->get_var_heap()
		551	->alloc_mem(calc_alloc(digits), this);
		552
		553	/* set the precision */
		554	set_prec(ext_, digits);
		555
		556	/* initialize the value to zero */
		557	set_int_val(0);
		558
		559	/* clear the flags */
		560	ext_[VMBN_FLAGS] = 0;
		561	}
		562
		563	/*
		564	* Calculate the amount of memory we need for a given number of digits
		565	* of precision
		566	*/
		567	size_t CVmObjBigNum::calc_alloc(size_t digits)
		568	{
		569	/*
		570	* we need the header (UINT2, INT2, BYTE), plus one byte for each
		571	* two decimal digits
		572	*/
		573	return (2 + 2 + 1) + ((digits + 1)/2);
		574	}
		575
		576
		577	/* ------------------------------------------------------------------------ */
		578	/*
		579	* Write to a 'data' mode file
		580	*/
		581	int CVmObjBigNum::write_to_data_file(osfildef *fp)
		582	{
		583	char buf[16];
		584
		585	/* write the number of digits (i.e., the precision) */
		586	oswp2(buf, get_prec(ext_));
		587	if (osfwb(fp, buf, 2))
		588	return 1;
		589
		590	/* write our entire extension */
		591	if (osfwb(fp, ext_, calc_alloc(get_prec(ext_))))
		592	return 1;
		593
		594	/* success */
		595	return 0;
		596	}
		597
		598	/*
		599	* Read from a 'data' mode file and instantiate a new BigNumber object to
		600	* hold the result
		601	*/
		602	int CVmObjBigNum::read_from_data_file(VMG_ vm_val_t retval, osfildef fp)
		603	{
		604	char buf[16];
		605	size_t prec;
		606	CVmObjBigNum *bignum;
		607
		608	/* read the precision */
		609	if (osfrb(fp, buf, 2))
		610	return 1;
		611	prec = osrp2(buf);
		612
		613	/* create a BigNumber with the required precision */
		614	retval->set_obj(create(vmg_ FALSE, prec));
		615	bignum = (CVmObjBigNum *)vm_objp(vmg_ retval->val.obj);
		616
		617	/* read the bytes into the new object's extension */
		618	if (osfrb(fp, bignum->get_ext(), calc_alloc(prec)))
		619	return 1;
		620
		621	/* success */
		622	return 0;
		623	}
		624
		625
		626	/* ------------------------------------------------------------------------ */
		627	/*
		628	* Set my value to a given integer value
		629	*/
		630	void CVmObjBigNum::set_int_val(long val)
		631	{
		632	size_t prec;
		633	int exp;
		634
		635	/* get the precision */
		636	prec = get_prec(ext_);
		637
		638	/* set the type to number */
		639	set_type(ext_, VMBN_T_NUM);
		640
		641	/* set the sign bit */
		642	if (val < 0)
		643	{
		644	/* set the value negative */
		645	set_neg(ext_, TRUE);
		646
		647	/* use the absolute value for the mantissa */
		648	val = -val;
		649	}
		650	else
		651	{
		652	/* set the value positive */
		653	set_neg(ext_, FALSE);
		654	}
		655
		656	/* initially zero the mantissa */
		657	memset(ext_ + VMBN_MANT, 0, (prec + 1)/2);
		658
		659	/* initialize the exponent to zero */
		660	exp = 0;
		661
		662	/* shift the integer value into the value */
		663	while (val != 0)
		664	{
		665	unsigned int dig;
		666
		667	/* get the low-order digit of the value */
		668	dig = (unsigned int)(val % 10);
		669
		670	/* shift the value one place */
		671	val /= 10;
		672
		673	/*
		674	* shift our number one place right to accommodate this next
		675	* higher-order digit
		676	*/
		677	shift_right(ext_, 1);
		678
		679	/* set the new most significant digit */
		680	set_dig(ext_, 0, dig);
		681
		682	/* that's another factor of 10 */
		683	++exp;
		684	}
		685
		686	/* set the exponent */
		687	set_exp(ext_, exp);
		688
		689	/* normalize the number */
		690	normalize(ext_);
		691	}
		692
		693	/*
		694	* Set my value to a string
		695	*/
		696	void CVmObjBigNum::set_str_val(const char *str, size_t len)
		697	{
		698	size_t prec;
		699	int exp;
		700	utf8_ptr p;
		701	size_t rem;
		702	int neg;
		703	size_t idx;
		704	int pt;
		705	int significant;
		706
		707	/* get the precision */
		708	prec = get_prec(ext_);
		709
		710	/* set the type to number */
		711	set_type(ext_, VMBN_T_NUM);
		712
		713	/* initially zero the mantissa */
		714	memset(ext_ + VMBN_MANT, 0, (prec + 1)/2);
		715
		716	/* set up to scan the string */
		717	p.set((char *)str);
		718	rem = len;
		719
		720	/* initialize the exponent to zero */
		721	exp = 0;
		722
		723	/* presume it will be positive */
		724	neg = FALSE;
		725
		726	/* skip leading spaces */
		727	while (rem != 0 && is_space(p.getch()))
		728	p.inc(&rem);
		729
		730	/* check for a sign */
		731	if (rem != 0 && p.getch() == '+')
		732	{
		733	/* skip the sign */
		734	p.inc(&rem);
		735	}
		736	else if (rem != 0 && p.getch() == '-')
		737	{
		738	/* note the sign and skip it */
		739	neg = TRUE;
		740	p.inc(&rem);
		741	}
		742
		743	/* set the sign */
		744	set_neg(ext_, neg);
		745
		746	/* we haven't yet found a significant digit */
		747	significant = FALSE;
		748
		749	/* shift the digits into the value */
		750	for (idx = 0, pt = FALSE ; rem != 0 ; p.inc(&rem))
		751	{
		752	wchar_t ch;
		753
		754	/* get this character */
		755	ch = p.getch();
		756
		757	/* check for a digit */
		758	if (is_digit(ch))
		759	{
		760	/*
		761	* if it's not a zero, we're definitely into the significant
		762	* part of the number
		763	*/
		764	if (ch != '0')
		765	significant = TRUE;
		766
		767	/*
		768	* if it's significant, add it to the number - skip leading
		769	* zeroes, since they add no information to the number
		770	*/
		771	if (significant)
		772	{
		773	/* if we're not out of precision, add the digit */
		774	if (idx < prec)
		775	{
		776	/* set the next digit */
		777	set_dig(ext_, idx, value_of_digit(ch));
		778
		779	/* move on to the next digit position */
		780	++idx;
		781	}
		782
		783	/*
		784	* that's another factor of 10 if we haven't found the
		785	* decimal point (whether or not we're out of precision
		786	* to actually store the digit, count the increase in
		787	* the exponent)
		788	*/
		789	if (!pt)
		790	++exp;
		791	}
		792	else if (pt)
		793	{
		794	/*
		795	* we haven't yet found a significant digit, so this is
		796	* a leading zero, but we have found the decimal point -
		797	* this reduces the exponent by one
		798	*/
		799	--exp;
		800	}
		801	}
		802	else if (ch == '.' && !pt)
		803	{
		804	/*
		805	* this is the decimal point - note it; from now on, we
		806	* won't increase the exponent as we add digits
		807	*/
		808	pt = TRUE;
		809	}
		810	else if (ch == 'e' \|\| ch == 'E')
		811	{
		812	int acc;
		813	int exp_neg = FALSE;
		814
		815	/* exponent - skip the 'e' */
		816	p.inc(&rem);
		817
		818	/* check for a sign */
		819	if (rem != 0 && p.getch() == '+')
		820	{
		821	/* skip the sign */
		822	p.inc(&rem);
		823	}
		824	else if (rem != 0 && p.getch() == '-')
		825	{
		826	/* skip it and note it */
		827	p.inc(&rem);
		828	exp_neg = TRUE;
		829	}
		830
		831	/* parse the exponent */
		832	for (acc = 0 ; rem != 0 ; p.inc(&rem))
		833	{
		834	wchar_t ch;
		835
		836	/* if this is a digit, add it to the exponent */
		837	ch = p.getch();
		838	if (is_digit(ch))
		839	{
		840	/* accumulate the digit */
		841	acc *= 10;
		842	acc += value_of_digit(ch);
		843	}
		844	else
		845	{
		846	/* that's it for the exponent */
		847	break;
		848	}
		849	}
		850
		851	/* if it's negative, apply the sign */
		852	if (exp_neg)
		853	acc = -acc;
		854
		855	/* add the exponent to the one we've calculated */
		856	exp += acc;
		857
		858	/* after the exponent, we're done with the whole number */
		859	break;
		860	}
		861	else
		862	{
		863	/* it looks like we've reached the end of the number */
		864	break;
		865	}
		866	}
		867
		868	/* set the exponent */
		869	set_exp(ext_, exp);
		870
		871	/* normalize the number */
		872	normalize(ext_);
		873	}
		874
		875
		876	/* ------------------------------------------------------------------------ */
		877	/*
		878	* Convert to an integer value
		879	*/
		880	long CVmObjBigNum::convert_to_int()
		881	{
		882	size_t prec = get_prec(ext_);
		883	int is_neg = get_neg(ext_);
		884	int exp = get_exp(ext_);
		885	size_t idx;
		886	size_t stop_idx;
		887	long acc;
		888	int round_inc;
		889
		890	/*
		891	* T3 VM integer value limits.
		892	*
		893	* Note: The T3 VM integer type is ALWAYS a signed 32 bit value,
		894	* regardless of the local integer size. So we have to use HARD-CODED
		895	* numbers here, NOT the limits.h values (LONG_MAX, LONG_MIN).
		896	*/
		897	const long long_max = 2147483647L;
		898	const long long_min = (-2147483647L - 1);
		899
		900	/* start the accumulator at zero */
		901	acc = 0;
		902
		903	/* presume no rounding */
		904	round_inc = 0;
		905
		906	/* check to see if the first fractional digit is represented */
		907	if (exp >= 0 && (size_t)exp < prec)
		908	{
		909	/* if the digit is 5 or over, round up */
		910	if (get_dig(ext_, (size_t)exp) >= 5)
		911	round_inc = (is_neg ? -1 : 1);
		912	}
		913
		914	/* stop at the first fractional digit */
		915	if (exp <= 0)
		916	{
		917	/* all digits are fractional */
		918	stop_idx = 0;
		919	}
		920	else if ((size_t)exp < prec)
		921	{
		922	/* stop at the first fractional digit */
		923	stop_idx = (size_t)exp;
		924	}
		925	else
		926	{
		927	/* all of the digits are in the whole part */
		928	stop_idx = prec;
		929	}
		930
		931	/* convert the integer part digit by digit */
		932	if (stop_idx > 0)
		933	{
		934	/* loop over digits */
		935	for (idx = 0 ; idx < stop_idx ; ++idx)
		936	{
		937	/* get this digit */
		938	int dig = get_dig(ext_, idx);
		939
		940	/* make sure that shifting the accumulator won't overflow */
		941	if (is_neg ? acc < (long_min/10) : acc > (long_max/10))
		942	err_throw(VMERR_NUM_OVERFLOW);
		943
		944	/* shift the accumulator */
		945	acc *= 10;
		946
		947	/* make sure this digit won't overflow the 32-bit VM int type */
		948	if (is_neg ? acc < (long_min + dig) : acc > (long_max - dig))
		949	err_throw(VMERR_NUM_OVERFLOW);
		950
		951	/* add the digit */
		952	if (is_neg)
		953	acc -= dig;
		954	else
		955	acc += dig;
		956	}
		957	}
		958
		959	/* make sure rounding won't overflow */
		960	if (is_neg ? acc < long_min - round_inc : acc > long_max - round_inc)
		961	err_throw(VMERR_NUM_OVERFLOW);
		962
		963	/* return the result adjusted for rounding */
		964	return acc + round_inc;
		965	}
		966
		967	/* ------------------------------------------------------------------------ */
		968	/*
		969	* Create a string representation of the number
		970	*/
		971	const char *CVmObjBigNum::cast_to_string(VMG_ vm_obj_id_t self,
		972	vm_val_t *new_str) const
		973	{
		974	/* use my static method */
		975	return cvt_to_string(vmg_ self, new_str, ext_, 100, -1, -1, -1, 0, 0);
		976	}
		977
		978	/*
		979	* convert to a string, storing the result in the given buffer
		980	*/
		981	char CVmObjBigNum::cvt_to_string_buf(VMG_ char buf, size_t buflen,
		982	int max_digits, int whole_places,
		983	int frac_digits, int exp_digits,
		984	ulong flags)
		985	{
		986	/* convert to a string into our buffer */
		987	return cvt_to_string_gen(vmg_ 0, ext_, max_digits, whole_places,
		988	frac_digits, exp_digits, flags, 0,
		989	buf, buflen);
		990	}
		991
		992	/*
		993	* Convert to a string, creating a new string object to hold the result
		994	*/
		995	const char *CVmObjBigNum::cvt_to_string(VMG_ vm_obj_id_t self,
		996	vm_val_t *new_str,
		997	const char *ext,
		998	int max_digits, int whole_places,
		999	int frac_digits, int exp_digits,
		1000	ulong flags, vm_val_t *lead_fill)
		1001	{
		1002	const char *ret;
		1003
		1004	/* push a self-reference for gc protection during allocation */
		1005	G_stk->push()->set_obj(self);
		1006
		1007	/*
		1008	* convert to a string - don't pass in a buffer, since we want to
		1009	* create a new string to hold the result
		1010	*/
		1011	ret = cvt_to_string_gen(vmg_ new_str, ext, max_digits, whole_places,
		1012	frac_digits, exp_digits, flags, lead_fill, 0, 0);
		1013
		1014	/* discard our gc protection */
		1015	G_stk->discard();
		1016
		1017	/* return the result */
		1018	return ret;
		1019	}
		1020
		1021	/*
		1022	* Common routine to create a string representation. If buf is null,
		1023	* we'll allocate a new string object, filling in new_str with the
		1024	* object reference; otherwise, we'll format into the given buffer.
		1025	*/
		1026	char CVmObjBigNum::cvt_to_string_gen(VMG_ vm_val_t new_str,
		1027	const char *ext,
		1028	int max_digits, int whole_places,
		1029	int frac_digits, int exp_digits,
		1030	ulong flags, vm_val_t *lead_fill,
		1031	char *buf, size_t buflen)
		1032	{
		1033	int always_sign = ((flags & VMBN_FORMAT_SIGN) != 0);
		1034	int always_sign_exp = ((flags & VMBN_FORMAT_EXP_SIGN) != 0);
		1035	int always_exp = ((flags & VMBN_FORMAT_EXP) != 0);
		1036	int lead_zero = ((flags & VMBN_FORMAT_LEADING_ZERO) != 0);
		1037	int always_show_pt = ((flags & VMBN_FORMAT_POINT) != 0);
		1038	int exp_caps = ((flags & VMBN_FORMAT_EXP_CAP) != 0);
		1039	int pos_lead_space = ((flags & VMBN_FORMAT_POS_SPACE) != 0);
		1040	int commas = ((flags & VMBN_FORMAT_COMMAS) != 0);
		1041	int euro = ((flags & VMBN_FORMAT_EUROSTYLE) != 0);
		1042	size_t req_chars;
		1043	int prec = (int)get_prec(ext);
		1044	int exp = get_exp(ext);
		1045	int dig_before_pt;
		1046	int dig_after_pt;
		1047	int idx;
		1048	unsigned int dig;
		1049	char *p;
		1050	int exp_carry;
		1051	int show_pt;
		1052	int whole_padding;
		1053	int non_sci_digs;
		1054	char decpt_char = (euro ? ',' : '.');
		1055	char comma_char = (euro ? '.' : ',');
		1056	const char *lead_fill_str = 0;
		1057	size_t lead_fill_len;
		1058	char *tmp_ext = 0;
		1059	uint tmp_hdl;
		1060
		1061	/* get the fill string, if a value was provided */
		1062	if (lead_fill != 0 && lead_fill->typ != VM_NIL)
		1063	{
		1064	/* get the string value */
		1065	lead_fill_str = lead_fill->get_as_string(vmg0_);
		1066
		1067	/* if it's not a string, it's an error */
		1068	if (lead_fill_str == 0)
		1069	err_throw(VMERR_STRING_VAL_REQD);
		1070
		1071	/* read and skip the length prefix */
		1072	lead_fill_len = vmb_get_len(lead_fill_str);
		1073	lead_fill_str += VMB_LEN;
		1074
		1075	/* if the length is zero, ignore the lead fill string entirely */
		1076	if (lead_fill_len == 0)
		1077	lead_fill_str = 0;
		1078	}
		1079	else
		1080	{
		1081	/* no lead fill needed */
		1082	lead_fill_len = 0;
		1083	}
		1084
		1085	/*
		1086	* If we're not required to use exponential notation, but we don't
		1087	* have enough max_digits places for the part before the decimal
		1088	* point, use exponential anyway. (The number of digits before the
		1089	* decimal point is simply the exponent if it's greater than zero,
		1090	* or zero otherwise.)
		1091	*/
		1092	if (exp > max_digits)
		1093	always_exp = TRUE;
		1094
		1095	/*
		1096	* If we're not required to use exponential notation, but our
		1097	* absolute value is so small that we wouldn't show anything
		1098	* "0.00000..." (i.e., we'd have too many zeroes after the decimal
		1099	* point to show any actual digits of our number), use exponential
		1100	* notation. If our exponent is negative, its absolute value is the
		1101	* number of zeroes we'd show after the decimal point before the
		1102	* first non-zero digit.
		1103	*/
		1104	if (exp < 0
		1105	&& (-exp > max_digits
		1106	\|\| (frac_digits != -1 && -exp > frac_digits)))
		1107	always_exp = TRUE;
		1108
		1109	/* calculate how many digits we'd need in non-scientific notation */
		1110	if (exp < 0)
		1111	{
		1112	/* we have leading zeroes before the first significant digit */
		1113	non_sci_digs = -exp + prec;
		1114	}
		1115	else if (exp > prec)
		1116	{
		1117	/* we have trailing zeroes after the last significant digit */
		1118	non_sci_digs = exp + prec;
		1119	}
		1120	else
		1121	{
		1122	/*
		1123	* we have no leading or trailing zeroes to represent - only the
		1124	* digits actually stored need to be displayed
		1125	*/
		1126	non_sci_digs = prec;
		1127	}
		1128
		1129	/*
		1130	* Figure out how much space we need for our string: use the smaller
		1131	* of max_digits or the actual space we need for non-scientific
		1132	* notation, plus overhead space for the sign, a leading zero, a
		1133	* decimal point, an 'E' for the exponent, an exponent sign, and up
		1134	* to five digits for the exponent (16-bit integer -> -32768 to
		1135	* 32767). Also add one extra digit in case we need to add a digit
		1136	* due to rounding.
		1137	*/
		1138	if (max_digits < non_sci_digs)
		1139	req_chars = max_digits;
		1140	else
		1141	req_chars = non_sci_digs;
		1142	req_chars += 11;
		1143
		1144	/*
		1145	* Make sure we leave enough room for the lead fill string - if they
		1146	* specified a number of whole places, and we're not using
		1147	* exponential format, we'll insert lead fill characters before the
		1148	* first non-zero whole digit.
		1149	*/
		1150	if (!always_exp && whole_places != -1 && exp < whole_places)
		1151	{
		1152	int extra;
		1153	int char_size;
		1154
		1155	/*
		1156	* if the exponent is negative, we'll pad by the full amount;
		1157	* otherwise, we'll just pad by the difference between the
		1158	* number of places needed and the exponent
		1159	*/
		1160	extra = whole_places;
		1161	if (exp > 0)
		1162	extra -= exp;
		1163
		1164	/*
		1165	* Add the extra bytes: one byte per character if we're using
		1166	* the default space padding, or up to three bytes per character
		1167	* if a lead string was specified (each unicode character can
		1168	* take up to three bytes)
		1169	*/
		1170	char_size = (lead_fill_str != 0 ? 3 : 1);
		1171	req_chars += extra * char_size;
		1172
		1173	/*
		1174	* add space for each padding character we could insert into a
		1175	* comma position (there's at most one comma per three fill
		1176	* characters)
		1177	*/
		1178	if (commas)
		1179	req_chars += ((extra + 2)/3) * char_size;
		1180	}
		1181
		1182	/*
		1183	* If we're using commas, and we're not using scientific notation,
		1184	* add space for a comma for each three digits before the decimal
		1185	* point
		1186	*/
		1187	if (commas && !always_exp)
		1188	{
		1189	/* add space for the commas */
		1190	req_chars += ((exp + 2) / 3);
		1191	}
		1192
		1193	/*
		1194	* if they requested a specific minimum number of exponent digits,
		1195	* and that number is greater than the allowance of 5 we already
		1196	* provided, add the extra space needed
		1197	*/
		1198	if (exp_digits > 5)
		1199	req_chars += (exp_digits - 5);
		1200
		1201	/*
		1202	* If they requested a specific number of digits after the decimal
		1203	* point, make sure we have room for those digits.
		1204	*/
		1205	if (frac_digits != -1)
		1206	req_chars += frac_digits;
		1207
		1208	/* check to see if the caller passed in a buffer */
		1209	if (buf != 0)
		1210	{
		1211	/*
		1212	* the caller passed in a buffer - if it's not big enough to
		1213	* hold the result, return failure
		1214	*/
		1215	if (buflen < req_chars + VMB_LEN)
		1216	return 0;
		1217	}
		1218	else
		1219	{
		1220	/* no buffer - allocate a new string */
		1221	buf = CVmObjString::alloc_str_buf(vmg_ new_str, 0, 0, req_chars);
		1222	}
		1223
		1224	/* check for special values */
		1225	switch(get_type(ext))
		1226	{
		1227	case VMBN_T_NUM:
		1228	/* normal number - proceed */
		1229	break;
		1230
		1231	case VMBN_T_NAN:
		1232	/* not a number - show "1.#NAN" */
		1233	strcpy(buf + VMB_LEN, "1.#NAN");
		1234	oswp2(buf, 6);
		1235	return buf;
		1236
		1237	case VMBN_T_INF:
		1238	/* positive or negative infinity */
		1239	if (get_neg(ext))
		1240	{
		1241	strcpy(buf + VMB_LEN, "-1.#INF");
		1242	oswp2(buf, 7);
		1243	}
		1244	else
		1245	{
		1246	strcpy(buf + VMB_LEN, "1.#INF");
		1247	oswp2(buf, 6);
		1248	}
		1249	return buf;
		1250
		1251	default:
		1252	/* other values are not valid */
		1253	strcpy(buf + VMB_LEN, "1.#???");
		1254	oswp2(buf, 6);
		1255	return buf;
		1256	}
		1257
		1258	/*
		1259	* Allocate a temporary buffer to contain a copy of the number. At
		1260	* most, we'll have to show max_digits of the number, or the current
		1261	* precision, whichever is lower.
		1262	*/
		1263	{
		1264	int new_prec;
		1265
		1266	/*
		1267	* limit the new precision to the maximum digits to be shown, or
		1268	* our existing precision, whichever is lower
		1269	*/
		1270	new_prec = max_digits;
		1271	if (prec < new_prec)
		1272	new_prec = prec;
		1273
		1274	/* allocate the space */
		1275	alloc_temp_regs(vmg_ (size_t)new_prec, 1, &tmp_ext, &tmp_hdl);
		1276
		1277	/* copy the value to the temp register, rounding the value */
		1278	copy_val(tmp_ext, ext, TRUE);
		1279
		1280	/* note the new precision */
		1281	prec = new_prec;
		1282
		1283	/* forget the original number and use the rounded version */
		1284	ext = tmp_ext;
		1285	}
		1286
		1287	start_over:
		1288	/*
		1289	* note the exponent, in case we rounded or otherwise adjusted the
		1290	* temporary number
		1291	*/
		1292	exp = get_exp(ext);
		1293
		1294	/* presume we won't carry into the exponent */
		1295	exp_carry = FALSE;
		1296
		1297	/* no whole-part padding yet */
		1298	whole_padding = 0;
		1299
		1300	/*
		1301	* Figure out where the decimal point goes in the display. If we're
		1302	* displaying in exponential format, we'll always display exactly
		1303	* one digit before the decimal point. Otherwise, we'll display the
		1304	* number given by our exponent if it's positive, or zero or one
		1305	* (depending on lead_zero) if it's negative or zero.
		1306	*/
		1307	if (always_exp)
		1308	dig_before_pt = 1;
		1309	else if (exp > 0)
		1310	dig_before_pt = exp;
		1311	else
		1312	dig_before_pt = 0;
		1313
		1314	/*
		1315	* if the digits before the decimal point exceed our maximum number
		1316	* of digits allowed, we'll need to use exponential format
		1317	*/
		1318	if (dig_before_pt > max_digits)
		1319	{
		1320	always_exp = TRUE;
		1321	goto start_over;
		1322	}
		1323
		1324	/*
		1325	* Limit digits after the decimal point according to the maximum
		1326	* digits allowed and the number we'll show before the decimal
		1327	* point.
		1328	*/
		1329	dig_after_pt = max_digits - dig_before_pt;
		1330
		1331	/* start writing after the buffer length prefix */
		1332	p = buf + VMB_LEN;
		1333
		1334	/*
		1335	* if we're not in exponential mode, add leading spaces for the
		1336	* unused whole places
		1337	*/
		1338	if (!always_exp && dig_before_pt < whole_places)
		1339	{
		1340	int cnt;
		1341	size_t src_rem;
		1342	utf8_ptr src;
		1343	utf8_ptr dst;
		1344	int idx;
		1345
		1346	/* start with the excess whole places */
		1347	cnt = whole_places - dig_before_pt;
		1348
		1349	/* if we're going to add a leading zero, that's one less space */
		1350	if (dig_before_pt == 0 && lead_zero)
		1351	--cnt;
		1352
		1353	/*
		1354	* Increase the count by the number of comma positions in the
		1355	* padding area.
		1356	*/
		1357	if (commas)
		1358	{
		1359	/* scan over the positions to fill and count commas */
		1360	for (idx = dig_before_pt ; idx < whole_places ; ++idx)
		1361	{
		1362	/* if this is a comma position, note it */
		1363	if ((idx % 3) == 0)
		1364	++cnt;
		1365	}
		1366	}
		1367
		1368	/* set up our read and write pointers */
		1369	src.set((char *)lead_fill_str);
		1370	src_rem = lead_fill_len;
		1371	dst.set(p);
		1372
		1373	/* add (and count) the leading spaces */
		1374	for ( ; cnt != 0 ; --cnt, ++whole_padding)
		1375	{
		1376	wchar_t ch;
		1377
		1378	/*
		1379	* if we have a lead fill string, read from it; otherwise,
		1380	* just use a space
		1381	*/
		1382	if (lead_fill_str != 0)
		1383	{
		1384	/* if we've exhausted the string, start over */
		1385	if (src_rem == 0)
		1386	{
		1387	src.set((char *)lead_fill_str);
		1388	src_rem = lead_fill_len;
		1389	}
		1390
		1391	/* get the next character */
		1392	ch = src.getch();
		1393
		1394	/* skip this character */
		1395	src.inc(&src_rem);
		1396	}
		1397	else
		1398	{
		1399	/* no lead fill string - insert a space by default */
		1400	ch = ' ';
		1401	}
		1402
		1403	/* write this character */
		1404	dst.setch(ch);
		1405	}
		1406
		1407	/* resynchronize from our utf8 pointer */
		1408	p = dst.getptr();
		1409	}
		1410
		1411	/*
		1412	* if the number is negative, or we're always showing a sign, add
		1413	* the sign; if we're not adding a sign, but we're showing a leading
		1414	* space for positive numbers, add the leading space
		1415	*/
		1416	if (get_neg(ext))
		1417	*p++ = '-';
		1418	else if (always_sign)
		1419	*p++ = '+';
		1420	else if (pos_lead_space)
		1421	*p++ = ' ';
		1422
		1423	/*
		1424	* if we have no digits before the decimal, and we're adding a
		1425	* leading zero, add it now
		1426	*/
		1427	if (dig_before_pt == 0 && lead_zero)
		1428	{
		1429	/* add the leading zero */
		1430	*p++ = '0';
		1431
		1432	/* reduce the limit on the digits after the decimal point */
		1433	--dig_after_pt;
		1434	}
		1435
		1436	/*
		1437	* If we have limited the number of digits that we'll allow after the
		1438	* decimal point, due to the limit on the total number of digits and
		1439	* the number of digits we need to display before the decimal, start
		1440	* over in exponential format to ensure we get the after-decimal
		1441	* display we want.
		1442	*
		1443	* Note that we won't bother going into exponential format if the
		1444	* number of digits before the decimal point is zero or one, because
		1445	* exponential format won't give us any more room - in such cases we
		1446	* simply have an impossible request.
		1447	*/
		1448	if (!always_exp && frac_digits != -1 && dig_after_pt < frac_digits
		1449	&& dig_before_pt > 1)
		1450	{
		1451	/* switch to exponential format and start over */
		1452	always_exp = TRUE;
		1453	goto start_over;
		1454	}
		1455
		1456	/* display the digits before the decimal point */
		1457	for (idx = 0 ; idx < dig_before_pt && idx < prec ; ++idx)
		1458	{
		1459	/*
		1460	* if this isn't the first digit, and we're adding commas, and
		1461	* an even multiple of three more digits follow, insert a comma
		1462	*/
		1463	if (idx != 0 && commas && !always_exp
		1464	&& ((dig_before_pt - idx) % 3) == 0)
		1465	*p++ = comma_char;
		1466
		1467	/* get this digit */
		1468	dig = get_dig(ext, idx);
		1469
		1470	/* add it to the string */
		1471	*p++ = (dig + '0');
		1472	}
		1473
		1474	/* if we ran out of precision, add zeroes */
		1475	for ( ; idx < dig_before_pt ; ++idx)
		1476	*p++ = '0';
		1477
		1478	/*
		1479	* Add the decimal point. Show the decimal point unless
		1480	* always_show_pt is false, and either frac_digits is zero, or
		1481	* frac_digits is -1 and we have no fractional part.
		1482	*/
		1483	if (always_show_pt)
		1484	{
		1485	/* always showing the point */
		1486	show_pt = TRUE;
		1487	}
		1488	else
		1489	{
		1490	if (frac_digits > 0)
		1491	{
		1492	/* we're showing fractional digits - always show a point */
		1493	show_pt = TRUE;
		1494	}
		1495	else if (frac_digits == 0)
		1496	{
		1497	/* we're showing no fractional digits, so suppress the point */
		1498	show_pt = FALSE;
		1499	}
		1500	else
		1501	{
		1502	/*
		1503	* for now assume we'll show the point; we'll take it back
		1504	* out if we don't encounter anything but zeroes
		1505	*/
		1506	show_pt = TRUE;
		1507	}
		1508	}
		1509
		1510	/* if we're showing the fractional part, show it */
		1511	if (show_pt)
		1512	{
		1513	int frac_len;
		1514	int frac_lim;
		1515	char *last_non_zero;
		1516
		1517	/*
		1518	* remember the current position as the last trailing non-zero -
		1519	* if we don't find anything but zeroes and decide to remove the
		1520	* trailing zeroes, we'll also remove the decimal point by
		1521	* coming back here
		1522	*/
		1523	last_non_zero = p;
		1524
		1525	/* add the point */
		1526	*p++ = decpt_char;
		1527
		1528	/* if we're always showing a decimal point, we can't remove it */
		1529	if (always_show_pt)
		1530	last_non_zero = p;
		1531
		1532	/* if frac_digits is -1, there's no limit */
		1533	if (frac_digits == -1)
		1534	frac_lim = dig_after_pt;
		1535	else
		1536	frac_lim = frac_digits;
		1537
		1538	/*
		1539	* further limit the fractional digits according to the maximum
		1540	* digit allowance
		1541	*/
		1542	if (frac_lim > dig_after_pt)
		1543	frac_lim = dig_after_pt;
		1544
		1545	/* no fractional digits output yet */
		1546	frac_len = 0;
		1547
		1548	/*
		1549	* if we haven't yet reached the first non-zero digit, display
		1550	* as many zeroes as necessary
		1551	*/
		1552	if (idx == 0 && exp < 0)
		1553	{
		1554	int cnt;
		1555
		1556	/*
		1557	* display leading zeroes based no the exponent: if exp is
		1558	* zero, we don't need any; if exp is -1, we need one; if
		1559	* exp is -2, we need two, and so on
		1560	*/
		1561	for (cnt = exp ; cnt != 0 && frac_len < frac_lim ;
		1562	++cnt, ++frac_len)
		1563	{
		1564	/* add a zero */
		1565	*p++ = '0';
		1566	}
		1567	}
		1568
		1569	/* add the fractional digits */
		1570	for ( ; idx < prec && frac_len < frac_lim ; ++idx, ++frac_len)
		1571	{
		1572	/* get this digit */
		1573	dig = get_dig(ext, idx);
		1574
		1575	/* add it */
		1576	*p++ = (dig + '0');
		1577
		1578	/*
		1579	* if it's not a zero, note the location - if we decide to
		1580	* trim trailing zeroes, we'll want to keep at least this
		1581	* much, since this is a significant trailing digit
		1582	*/
		1583	if (dig != 0)
		1584	last_non_zero = p;
		1585	}
		1586
		1587	/*
		1588	* add the trailing zeroes if we ran out of precision before we
		1589	* filled the requested number of places
		1590	*/
		1591	if (frac_digits != -1)
		1592	{
		1593	/* fill out the remaining request length with zeroes */
		1594	for ( ; frac_len < frac_lim ; ++frac_len)
		1595	*p++ = '0';
		1596	}
		1597	else
		1598	{
		1599	char *p1;
		1600
		1601	/*
		1602	* if we're removing the decimal point, we're not showing a
		1603	* fractional part after all - so note
		1604	*/
		1605	if (last_non_zero < p && *last_non_zero == decpt_char)
		1606	show_pt = FALSE;
		1607
		1608	/*
		1609	* We can use whatever length we like, so remove meaningless
		1610	* trailing zeroes. Before we do this, though, make sure we
		1611	* aren't rounding up the last trailing zero - if the next
		1612	* digit is 5 or higher, we'll round the final zero to a 1.
		1613	*/
		1614	if (p > last_non_zero
		1615	&& idx < prec
		1616	&& get_dig(ext, idx) >= 5)
		1617	{
		1618	/*
		1619	* That last zero is significant after all, since we're
		1620	* going to round it up to a 1 for display. Don't actually
		1621	* do the rounding now; simply note that the last zero is
		1622	* significant so that we don't drop the digits leading up
		1623	* to it.
		1624	*/
		1625	last_non_zero = p;
		1626	}
		1627
		1628	/*
		1629	* We've checked for rounding in the last digit, so we can now
		1630	* safely remove meaningless trailing zeroes. If this leaves a
		1631	* completely empty buffer, not counting a sign and/or a
		1632	* decimal point, it means that we have a fractional number
		1633	* that we're showing without an exponent, and the number of
		1634	* digits we had for display was insufficient to reach the
		1635	* first non-zero fractional digit. In this case, simply show
		1636	* '0' (or '0.', if a decimal point is required) as the result.
		1637	* To find out, scan for digits.
		1638	*/
		1639	p = last_non_zero;
		1640	for (p1 = buf + VMB_LEN ; p1 < p && !is_digit(*p1) ; ++p1) ;
		1641
		1642	/* if we didn't find any digits, add/insert a '0' */
		1643	if (p1 == p)
		1644	{
		1645	/*
		1646	* if there's a decimal point, insert the '0' before it;
		1647	* otherwise, just append the zero
		1648	*/
		1649	if (p > buf + VMB_LEN && *(p-1) == decpt_char)
		1650	{
		1651	*(p-1) = '0';
		1652	*p++ = decpt_char;
		1653	}
		1654	else
		1655	*p++ = '0';
		1656	}
		1657	}
		1658	}
		1659
		1660	/*
		1661	* Check for rounding. If another digit remains, and that digit is
		1662	* greater than or equal to 5, round up.
		1663	*/
		1664	if (idx < prec && get_dig(ext, idx) >= 5)
		1665	{
		1666	char *rp;
		1667	int need_carry;
		1668	int found_pt;
		1669	int dig_cnt;
		1670
		1671	/*
		1672	* go back through the number and add one to the last digit,
		1673	* carrying as needed
		1674	*/
		1675	for (dig_cnt = 0, found_pt = FALSE, need_carry = TRUE, rp = p - 1 ;
		1676	rp >= buf + VMB_LEN ; rp = utf8_ptr::s_dec(rp))
		1677	{
		1678	/* if this is a digit, bump it up */
		1679	if (is_digit(*rp))
		1680	{
		1681	/* count it */
		1682	++dig_cnt;
		1683
		1684	/* if it's 9, we'll have to carry; otherwise it's easy */
		1685	if (*rp == '9')
		1686	{
		1687	/* set it to zero and keep going to do the carry */
		1688	*rp = '0';
		1689
		1690	/*
		1691	* if we haven't found the decimal point yet, and
		1692	* we're not required to show a certain number of
		1693	* fractional digits, we can simply remove this
		1694	* trailing zero
		1695	*/
		1696	if (show_pt && !found_pt && frac_digits == -1)
		1697	{
		1698	/* remove the trailing zero */
		1699	p = utf8_ptr::s_dec(p);
		1700
		1701	/* remove it from the digit count */
		1702	--dig_cnt;
		1703	}
		1704	}
		1705	else
		1706	{
		1707	/* bump it up one */
		1708	++(*rp);
		1709
		1710	/* no more carrying is needed */
		1711	need_carry = FALSE;
		1712
		1713	/* we don't need to look any further */
		1714	break;
		1715	}
		1716	}
		1717	else if (*rp == decpt_char)
		1718	{
		1719	/* note that we found the decimal point */
		1720	found_pt = TRUE;
		1721	}
		1722	}
		1723
		1724	/*
		1725	* If we got to the start of the number and we still need a
		1726	* carry, we must have had all 9's. In this case, we need to
		1727	* redo the entire number, since all of the layout (commas,
		1728	* leading spaces, etc) can change - it's way too much work to
		1729	* try to back-patch all of this stuff, so we'll just bump the
		1730	* number up and reformat it from scratch.
		1731	*/
		1732	if (need_carry)
		1733	{
		1734	int carry;
		1735
		1736	/*
		1737	* clear the digit that provoked the rounding - we don't
		1738	* want to round again on the next iteration
		1739	*/
		1740	set_dig(tmp_ext, idx, 0);
		1741
		1742	/* round up the number starting at the previous digit */
		1743	for (carry = TRUE ; idx != 0 ; )
		1744	{
		1745	/* move to the previous digit */
		1746	--idx;
		1747
		1748	/* if this digit is a 9, we'll need to carry */
		1749	if (get_dig(tmp_ext, idx) == 9)
		1750	{
		1751	/* adjust this digit and keep going */
		1752	set_dig(tmp_ext, idx, 0);
		1753	}
		1754	else
		1755	{
		1756	/* bump this digit up one */
		1757	set_dig(tmp_ext, idx, get_dig(tmp_ext, idx) + 1);
		1758
		1759	/* we're done */
		1760	carry = FALSE;
		1761	break;
		1762	}
		1763	}
		1764
		1765	/* if we need to carry one more place, shift it */
		1766	if (carry)
		1767	{
		1768	/* shift the number */
		1769	shift_right(tmp_ext, 1);
		1770
		1771	/* adjust the exponent accordingly */
		1772	set_exp(tmp_ext, get_exp(tmp_ext) + 1);
		1773
		1774	/* insert the leading 1 */
		1775	set_dig(tmp_ext, 0, 1);
		1776	}
		1777
		1778	/*
		1779	* if this pushes us over the maximum digit range, switch to
		1780	* scientific notation
		1781	*/
		1782	if (dig_cnt + 1 > max_digits)
		1783	always_exp = TRUE;
		1784
		1785	/* go back and start over */
		1786	goto start_over;
		1787	}
		1788	}
		1789
		1790	/* add the exponent */
		1791	if (always_exp)
		1792	{
		1793	int disp_exp;
		1794
		1795	/* add the 'E' */
		1796	*p++ = (exp_caps ? 'E' : 'e');
		1797
		1798	/*
		1799	* calculate the display exponent - it's one less than the
		1800	* actual exponent, because we put the point after one digit
		1801	*/
		1802	disp_exp = exp - 1;
		1803
		1804	/*
		1805	* if we carried into the exponent due to rounding, increase the
		1806	* exponent by one
		1807	*/
		1808	if (exp_carry)
		1809	++disp_exp;
		1810
		1811	/* add the sign */
		1812	if (disp_exp < 0)
		1813	{
		1814	*p++ = '-';
		1815	disp_exp = -disp_exp;
		1816	}
		1817	else if (always_sign_exp)
		1818	*p++ = '+';
		1819
		1820	/*
		1821	* if the exponent is zero, just put zero (unless a more
		1822	* specific format was requested)
		1823	*/
		1824	if (disp_exp == 0 && exp_digits == -1)
		1825	{
		1826	/* add the zero exponent */
		1827	*p++ = '0';
		1828	}
		1829	else
		1830	{
		1831	char buf[20];
		1832	char *ep;
		1833	int dig_cnt;
		1834
		1835	/* build the exponent in reverse */
		1836	for (dig_cnt = 0, ep = buf + sizeof(buf) ; disp_exp != 0 ;
		1837	disp_exp /= 10, ++dig_cnt)
		1838	{
		1839	/* move back one character */
		1840	--ep;
		1841
		1842	/* add one digit */
		1843	*ep = (disp_exp % 10) + '0';
		1844	}
		1845
		1846	/* if necessary, add leading zeroes to the exponent */
		1847	if (exp_digits != -1 && exp_digits > dig_cnt)
		1848	{
		1849	for ( ; dig_cnt < exp_digits ; ++dig_cnt)
		1850	*p++ = '0';
		1851	}
		1852
		1853	/* copy the exponent into the output */
		1854	for ( ; ep < buf + sizeof(buf) ; ++ep)
		1855	p++ = ep;
		1856	}
		1857	}
		1858
		1859	/* set the string length */
		1860	vmb_put_len(buf, p - (buf + VMB_LEN));
		1861
		1862	/* if we allocated a temporary register, free it */
		1863	if (tmp_ext != 0)
		1864	release_temp_regs(vmg_ 1, tmp_hdl);
		1865
		1866	/* return the string buffer */
		1867	return buf;
		1868	}
		1869
		1870	/* ------------------------------------------------------------------------ */
		1871	/*
		1872	* Shift the value left (multiply by 10^shift)
		1873	*/
		1874	void CVmObjBigNum::shift_left(char *ext, unsigned int shift)
		1875	{
		1876	size_t prec = get_prec(ext);
		1877	size_t i;
		1878
		1879	/* do nothing with a zero shift */
		1880	if (shift == 0)
		1881	return;
		1882
		1883	/* if it's an even shift, it's especially easy */
		1884	if ((shift & 1) == 0)
		1885	{
		1886	/* simply move the bytes left by the required amount */
		1887	for (i = 0 ; i + shift/2 < (prec+1)/2 ; ++i)
		1888	ext[VMBN_MANT + i] = ext[VMBN_MANT + i + shift/2];
		1889
		1890	/* zero the remaining digits */
		1891	for ( ; i < (prec+1)/2 ; ++i)
		1892	ext[VMBN_MANT + i] = 0;
		1893
		1894	/*
		1895	* be sure to zero the last digit - if we have an odd precision,
		1896	* we will have copied the garbage digit from the final
		1897	* half-byte
		1898	*/
		1899	set_dig(ext, prec - shift, 0);
		1900	}
		1901	else
		1902	{
		1903	/* apply the shift to each digit */
		1904	for (i = 0 ; i + shift < prec ; ++i)
		1905	{
		1906	unsigned int dig;
		1907
		1908	/* get this source digit */
		1909	dig = get_dig(ext, i + shift);
		1910
		1911	/* set this destination digit */
		1912	set_dig(ext, i, dig);
		1913	}
		1914
		1915	/* zero the remaining digits */
		1916	for ( ; i < prec ; ++i)
		1917	set_dig(ext, i, 0);
		1918	}
		1919	}
		1920
		1921	/*
		1922	* Shift the value right (divide by 10^shift)
		1923	*/
		1924	void CVmObjBigNum::shift_right(char *ext, unsigned int shift)
		1925	{
		1926	size_t prec = get_prec(ext);
		1927	size_t i;
		1928
		1929	/* if it's an even shift, it's especially easy */
		1930	if ((shift & 1) == 0)
		1931	{
		1932	/* simply move the bytes left by the required amount */
		1933	for (i = (prec+1)/2 ; i > shift/2 ; --i)
		1934	ext[VMBN_MANT + i-1] = ext[VMBN_MANT + i-1 - shift/2];
		1935
		1936	/* zero the leading digits */
		1937	for ( ; i > 0 ; --i)
		1938	ext[VMBN_MANT + i-1] = 0;
		1939	}
		1940	else
		1941	{
		1942	/* apply the shift to each digit */
		1943	for (i = prec ; i > shift ; --i)
		1944	{
		1945	unsigned int dig;
		1946
		1947	/* get this source digit */
		1948	dig = get_dig(ext, i-1 - shift);
		1949
		1950	/* set this destination digit */
		1951	set_dig(ext, i-1, dig);
		1952	}
		1953
		1954	/* zero the remaining digits */
		1955	for ( ; i >0 ; --i)
		1956	set_dig(ext, i-1, 0);
		1957	}
		1958	}
		1959
		1960	/*
		1961	* Increment a number
		1962	*/
		1963	void CVmObjBigNum::increment_abs(char *ext)
		1964	{
		1965	size_t idx;
		1966	int exp = get_exp(ext);
		1967	int carry;
		1968
		1969	/* start at the one's place, if represented */
		1970	idx = (exp <= 0 ? 0 : (size_t)exp);
		1971
		1972	/*
		1973	* if the units digit is to the right of the number (i.e., the
		1974	* number's scale is large), there's nothing to do
		1975	*/
		1976	if (idx > get_prec(ext))
		1977	return;
		1978
		1979	/* increment digits */
		1980	for (carry = TRUE ; idx != 0 ; )
		1981	{
		1982	int dig;
		1983
		1984	/* move to the next digit */
		1985	--idx;
		1986
		1987	/* get the digit value */
		1988	dig = get_dig(ext, idx);
		1989
		1990	/* increment it, checking for carry */
		1991	if (dig == 9)
		1992	{
		1993	/* increment it to zero and keep going to carry */
		1994	set_dig(ext, idx, 0);
		1995	}
		1996	else
		1997	{
		1998	/* increment this digit */
		1999	set_dig(ext, idx, dig + 1);
		2000
		2001	/* there's no carry out */
		2002	carry = FALSE;
		2003
		2004	/* done */
		2005	break;
		2006	}
		2007	}
		2008
		2009	/* if we carried past the end of the number, insert the leading 1 */
		2010	if (carry)
		2011	{
		2012	/*
		2013	* if we still haven't reached the units position, shift right
		2014	* until we do
		2015	*/
		2016	while (get_exp(ext) < 0)
		2017	{
		2018	/* shift it right and adjust the exponent */
		2019	shift_right(ext, 1);
		2020	set_exp(ext, get_exp(ext) + 1);
		2021	}
		2022
		2023	/* shift the number right and adjust the exponent */
		2024	shift_right(ext, 1);
		2025	set_exp(ext, get_exp(ext) + 1);
		2026
		2027	/* insert the leading 1 */
		2028	set_dig(ext, 0, 1);
		2029	}
		2030
		2031	/* we know the value is now non-zero */
		2032	ext[VMBN_FLAGS] &= ~VMBN_F_ZERO;
		2033	}
		2034
		2035	/*
		2036	* Determine if the fractional part is zero
		2037	*/
		2038	int CVmObjBigNum::is_frac_zero(const char *ext)
		2039	{
		2040	size_t idx;
		2041	int exp = get_exp(ext);
		2042	size_t prec = get_prec(ext);
		2043
		2044	/* start at the first fractional digit, if represented */
		2045	idx = (exp <= 0 ? 0 : (size_t)exp);
		2046
		2047	/* scan the digits for a non-zero digit */
		2048	for ( ; idx < prec ; ++idx)
		2049	{
		2050	/* if this digit is non-zero, the fraction is non-zero */
		2051	if (get_dig(ext, idx) != 0)
		2052	return FALSE;
		2053	}
		2054
		2055	/* we didn't find any non-zero fractional digits */
		2056	return TRUE;
		2057	}
		2058
		2059	/*
		2060	* Normalize a number - shift it so that the first digit is non-zero.
		2061	* If the number is zero, set the exponent to zero and clear the sign
		2062	* bit.
		2063	*/
		2064	void CVmObjBigNum::normalize(char *ext)
		2065	{
		2066	int idx;
		2067	int prec = get_prec(ext);
		2068	int all_zero;
		2069	int nonzero_idx = 0;
		2070
		2071	/* no work is necessary for anything but ordinary numbers */
		2072	if (is_nan(ext))
		2073	return;
		2074
		2075	/* check for an all-zero mantissa */
		2076	for (all_zero = TRUE, idx = 0 ; idx < prec ; ++idx)
		2077	{
		2078	/* check this digit */
		2079	if (get_dig(ext, idx) != 0)
		2080	{
		2081	/* note the location of the first non-zero digit */
		2082	nonzero_idx = idx;
		2083
		2084	/* note that the number isn't all zeroes */
		2085	all_zero = FALSE;
		2086
		2087	/* no need to keep searching */
		2088	break;
		2089	}
		2090	}
		2091
		2092	/* if it's zero, set the canonical zero format */
		2093	if (all_zero)
		2094	{
		2095	/* set the value to zero */
		2096	set_zero(ext);
		2097	}
		2098	else
		2099	{
		2100	/* clear the zero flag */
		2101	ext[VMBN_FLAGS] &= ~VMBN_F_ZERO;
		2102
		2103	/* shift the mantissa left to make the first digit non-zero */
		2104	if (nonzero_idx != 0)
		2105	shift_left(ext, nonzero_idx);
		2106
		2107	/* decrease the exponent to account for the mantissa shift */
		2108	set_exp(ext, get_exp(ext) - nonzero_idx);
		2109	}
		2110	}
		2111
		2112	/*
		2113	* Round the value up - increments the least significant digit
		2114	*/
		2115	void CVmObjBigNum::round_up_abs(char *ext)
		2116	{
		2117	int idx;
		2118	int carry;
		2119
		2120	/*
		2121	* Scan from least significant and apply the rounding. Keep going
		2122	* until we reach the most significant digit.
		2123	*/
		2124	for (carry = TRUE, idx = get_prec(ext) ; idx != 0 ; )
		2125	{
		2126	int dig;
		2127
		2128	/* move to the next position */
		2129	--idx;
		2130
		2131	/* get the digit at this position */
		2132	dig = get_dig(ext, idx);
		2133
		2134	/* check to see if we'll need to carry past this digit */
		2135	if (dig == 9)
		2136	{
		2137	/* set it to zero and keep going to do the carry */
		2138	set_dig(ext, idx, 0);
		2139	}
		2140	else
		2141	{
		2142	/* increment this digit */
		2143	set_dig(ext, idx, dig + 1);
		2144
		2145	/* no need to carry - note it and stop looping */
		2146	carry = FALSE;
		2147	break;
		2148	}
		2149	}
		2150
		2151	/*
		2152	* if we carried past the most significant digit, we must shift the
		2153	* value right, dropping the least significant digit, and insert a
		2154	* leading 1
		2155	*/
		2156	if (carry)
		2157	{
		2158	/* shift the mantissa */
		2159	shift_right(ext, 1);
		2160
		2161	/* compensate for the shift in the exponent */
		2162	set_exp(ext, get_exp(ext) + 1);
		2163
		2164	/* insert the leading 1 */
		2165	set_dig(ext, 0, 1);
		2166	}
		2167
		2168	/* we know the value is non-zero now */
		2169	ext[VMBN_FLAGS] &= ~VMBN_F_ZERO;
		2170	}
		2171
		2172	/*
		2173	* Copy a value, extending with zeroes if expanding, or truncating or
		2174	* rounding, as desired, if the precision changes
		2175	*/
		2176	void CVmObjBigNum::copy_val(char dst, const char src, int round)
		2177	{
		2178	size_t src_prec = get_prec(src);
		2179	size_t dst_prec = get_prec(dst);
		2180
		2181	/* check to see if we're growing or shrinking */
		2182	if (dst_prec > src_prec)
		2183	{
		2184	/*
		2185	* it's growing - copy the entire old mantissa, plus the flags,
		2186	* sign, and exponent
		2187	*/
		2188	memcpy(dst + VMBN_EXP, src + VMBN_EXP,
		2189	(VMBN_MANT - VMBN_EXP) + (src_prec + 1)/2);
		2190
		2191	/* clear the balance of the mantissa */
		2192	memset(dst + VMBN_MANT + (src_prec + 1)/2,
		2193	0, (dst_prec + 1)/2 - (src_prec + 1)/2);
		2194
		2195	/*
		2196	* clear the digit just after the last digit we copied - we
		2197	* might have missed this with the memset, since it only deals
		2198	* with even-numbered pairs of digits
		2199	*/
		2200	set_dig(dst, src_prec, 0);
		2201	}
		2202	else
		2203	{
		2204	/* it's shrinking - truncate the mantissa to the new length */
		2205	memcpy(dst + VMBN_EXP, src + VMBN_EXP,
		2206	(VMBN_MANT - VMBN_EXP) + (dst_prec + 1)/2);
		2207
		2208	/* check for rounding */
		2209	if (round && dst_prec < src_prec && get_dig(src, dst_prec) >= 5)
		2210	{
		2211	/* round the value */
		2212	round_up_abs(dst);
		2213	}
		2214	}
		2215	}
		2216
		2217	/*
		2218	* Multiply by an integer constant value
		2219	*/
		2220	void CVmObjBigNum::mul_by_long(char *ext, unsigned long val)
		2221	{
		2222	size_t idx;
		2223	size_t prec = get_prec(ext);
		2224	unsigned long carry = 0;
		2225	int trail_dig = 0;
		2226
		2227	/*
		2228	* start at the least significant digit and work up through the
		2229	* digits
		2230	*/
		2231	for (idx = prec ; idx != 0 ; )
		2232	{
		2233	unsigned long prod;
		2234
		2235	/* move to the next digit */
		2236	--idx;
		2237
		2238	/*
		2239	* compute the product of this digit and the given value, and
		2240	* add in the carry from the last digit
		2241	*/
		2242	prod = (val * get_dig(ext, idx)) + carry;
		2243
		2244	/* set this digit to the residue mod 10 */
		2245	set_dig(ext, idx, prod % 10);
		2246
		2247	/* carry the rest */
		2248	carry = prod / 10;
		2249	}
		2250
		2251	/* if we have a carry left over, shift it in */
		2252	while (carry != 0)
		2253	{
		2254	/* remember the digit we're dropping */
		2255	trail_dig = get_dig(ext, prec - 1);
		2256
		2257	/* shift the number and adjust the exponent */
		2258	shift_right(ext, 1);
		2259	set_exp(ext, get_exp(ext) + 1);
		2260
		2261	/* shift in this digit of the carry */
		2262	set_dig(ext, 0, carry % 10);
		2263
		2264	/* take it out of the carry */
		2265	carry /= 10;
		2266	}
		2267
		2268	/* round up if the dropped trailing digit is 5 or higher */
		2269	if (trail_dig >= 5)
		2270	round_up_abs(ext);
		2271
		2272	/* normalize the result */
		2273	normalize(ext);
		2274	}
		2275
		2276	/*
		2277	* Divide by an integer constant value
		2278	*/
		2279	void CVmObjBigNum::div_by_long(char *ext, unsigned long val)
		2280	{
		2281	size_t in_idx;
		2282	size_t out_idx;
		2283	int sig;
		2284	size_t prec = get_prec(ext);
		2285	unsigned long rem = 0;
		2286
		2287	/*
		2288	* start at the most significant digit and work down
		2289	*/
		2290	for (rem = 0, sig = FALSE, in_idx = out_idx = 0 ;
		2291	in_idx < prec \|\| out_idx < prec ; ++in_idx)
		2292	{
		2293	long quo;
		2294
		2295	/*
		2296	* shift this digit into the remainder - if we're past the end
		2297	* of the number, shift in an implied trailing zero
		2298	*/
		2299	rem *= 10;
		2300	rem += (in_idx < prec ? get_dig(ext, in_idx) : 0);
		2301
		2302	/* calculate the quotient */
		2303	quo = rem / val;
		2304
		2305	/* if the quotient is non-zero, we've found a significant digit */
		2306	if (quo != 0)
		2307	sig = TRUE;
		2308
		2309	/*
		2310	* if we've found a significant digit, store it; otherwise, just
		2311	* reduce the exponent to account for an implied leading zero
		2312	* that we won't actually store
		2313	*/
		2314	if (sig)
		2315	{
		2316	/* store the digit */
		2317	set_dig(ext, out_idx, (int)quo);
		2318
		2319	/* move on to the next output digit */
		2320	++out_idx;
		2321	}
		2322	else
		2323	{
		2324	/* all leading zeroes so far - adjust the exponent */
		2325	set_exp(ext, get_exp(ext) - 1);
		2326	}
		2327
		2328	/* calculate the remainder */
		2329	rem %= val;
		2330
		2331	/*
		2332	* if we've reached the last input digit and the remainder is
		2333	* zero, we're done - fill out the rest of the number with
		2334	* trailing zeroes and stop looping
		2335	*/
		2336	if (rem == 0 && in_idx >= prec)
		2337	{
		2338	/* check to see if we have any significant digits */
		2339	if (sig)
		2340	{
		2341	/* fill out the rest of the number with zeroes */
		2342	for ( ; out_idx < prec ; ++out_idx)
		2343	set_dig(ext, out_idx, 0);
		2344	}
		2345	else
		2346	{
		2347	/* no significant digits - the result is zero */
		2348	set_zero(ext);
		2349	}
		2350
		2351	/* we have our result */
		2352	break;
		2353	}
		2354	}
		2355
		2356	/*
		2357	* Round up if the next digit that we can't store is 5 or higher.
		2358	* The next digit can be calculated by shifting in the implied
		2359	* trailing zero (i.e., multiplying the remainder by 10 and adding
		2360	* zero) then dividing it by the divisor.
		2361	*/
		2362	if ((rem * 10)/val >= 5)
		2363	round_up_abs(ext);
		2364
		2365	/* normalize the result */
		2366	normalize(ext);
		2367	}
		2368
		2369	/* ------------------------------------------------------------------------ */
		2370	/*
		2371	* save to a file
		2372	*/
		2373	void CVmObjBigNum::save_to_file(VMG_ class CVmFile *fp)
		2374	{
		2375	size_t prec;
		2376
		2377	/* get our precision */
		2378	prec = get_prec(ext_);
		2379
		2380	/* write the data */
		2381	fp->write_bytes(ext_, calc_alloc(prec));
		2382	}
		2383
		2384	/*
		2385	* restore from a file
		2386	*/
		2387	void CVmObjBigNum::restore_from_file(VMG_ vm_obj_id_t,
		2388	CVmFile fp, CVmObjFixup )
		2389	{
		2390	size_t prec;
		2391
		2392	/* read the precision */
		2393	prec = fp->read_uint2();
		2394
		2395	/* free any existing extension */
		2396	if (ext_ != 0)
		2397	{
		2398	G_mem->get_var_heap()->free_mem(ext_);
		2399	ext_ = 0;
		2400	}
		2401
		2402	/* allocate the space */
		2403	alloc_bignum(vmg_ prec);
		2404
		2405	/* store our precision */
		2406	set_prec(ext_, prec);
		2407
		2408	/* read the contents */
		2409	fp->read_bytes(ext_ + VMBN_EXP, calc_alloc(prec) - VMBN_EXP);
		2410	}
		2411
		2412
		2413	/* ------------------------------------------------------------------------ */
		2414	/*
		2415	* set a property
		2416	*/
		2417	void CVmObjBigNum::set_prop(VMG_ class CVmUndo *,
		2418	vm_obj_id_t, vm_prop_id_t,
		2419	const vm_val_t *)
		2420	{
		2421	/* we have no properties to set */
		2422	err_throw(VMERR_INVALID_SETPROP);
		2423	}
		2424
		2425	/*
		2426	* get a static property
		2427	*/
		2428	int CVmObjBigNum::call_stat_prop(VMG_ vm_val_t result, const uchar *pc_ptr,
		2429	uint *argc, vm_prop_id_t prop)
		2430	{
		2431	/* translate the property into a function vector index */
		2432	switch(G_meta_table
		2433	->prop_to_vector_idx(metaclass_reg_->get_reg_idx(), prop))
		2434	{
		2435	case VMOBJBN_GET_PI:
		2436	return s_getp_pi(vmg_ result, argc);
		2437
		2438	case VMOBJBN_GET_E:
		2439	return s_getp_e(vmg_ result, argc);
		2440
		2441	default:
		2442	/*
		2443	* we don't define this one - inherit the default from the base
		2444	* object metaclass
		2445	*/
		2446	return CVmObject::call_stat_prop(vmg_ result, pc_ptr, argc, prop);
		2447	}
		2448	}
		2449
		2450	/*
		2451	* get a property
		2452	*/
		2453	int CVmObjBigNum::get_prop(VMG_ vm_prop_id_t prop, vm_val_t *val,
		2454	vm_obj_id_t self, vm_obj_id_t *source_obj,
		2455	uint *argc)
		2456	{
		2457	uint func_idx;
		2458
		2459	/* translate the property into a function vector index */
		2460	func_idx = G_meta_table
		2461	->prop_to_vector_idx(metaclass_reg_->get_reg_idx(), prop);
		2462
		2463	/* call the function */
		2464	if ((this->*func_table_[func_idx])(vmg_ self, val, argc))
		2465	{
		2466	*source_obj = metaclass_reg_->get_class_obj(vmg0_);
		2467	return TRUE;
		2468	}
		2469
		2470	/* inherit default handling */
		2471	return CVmObject::get_prop(vmg_ prop, val, self, source_obj, argc);
		2472	}
		2473
		2474	/*
		2475	* Property evaluator - formatString
		2476	*/
		2477	int CVmObjBigNum::getp_format(VMG_ vm_obj_id_t self,
		2478	vm_val_t retval, uint argc)
		2479	{
		2480	int orig_argc = (argc != 0 ? *argc : 0);
		2481	int max_digits;
		2482	uint flags = 0;
		2483	int whole_places = -1;
		2484	int frac_digits = -1;
		2485	int exp_digits = -1;
		2486	vm_val_t *lead_fill = 0;
		2487	static CVmNativeCodeDesc desc(1, 5);
		2488
		2489	/* check arguments */
		2490	if (get_prop_check_argc(retval, argc, &desc))
		2491	return TRUE;
		2492
		2493	/* get the maximum digit count */
		2494	max_digits = CVmBif::pop_int_val(vmg0_);
		2495
		2496	/* get the flags */
		2497	if (orig_argc >= 2)
		2498	flags = CVmBif::pop_int_val(vmg0_);
		2499
		2500	/* get the whole places */
		2501	if (orig_argc >= 3)
		2502	whole_places = CVmBif::pop_int_val(vmg0_);
		2503
		2504	/* get the fraction digits */
		2505	if (orig_argc >= 4)
		2506	frac_digits = CVmBif::pop_int_val(vmg0_);
		2507
		2508	/* get the exponent digits */
		2509	if (orig_argc >= 5)
		2510	exp_digits = CVmBif::pop_int_val(vmg0_);
		2511
		2512	/*
		2513	* get the lead fill string if provided (leave it on the stack to
		2514	* protect against garbage collection)
		2515	*/
		2516	if (orig_argc >= 6)
		2517	lead_fill = G_stk->get(0);
		2518
		2519	/* format the number, which will build the return string */
		2520	cvt_to_string(vmg_ self, retval, ext_, max_digits, whole_places,
		2521	frac_digits, exp_digits, flags, lead_fill);
		2522
		2523	/* discard the lead fill string, if provided */
		2524	if (lead_fill != 0)
		2525	G_stk->discard();
		2526
		2527	/* handled */
		2528	return TRUE;
		2529	}
		2530
		2531	/*
		2532	* Property eval - equal after rounding
		2533	*/
		2534	int CVmObjBigNum::getp_equal_rnd(VMG_ vm_obj_id_t self,
		2535	vm_val_t retval, uint argc)
		2536	{
		2537	vm_val_t val2;
		2538	static CVmNativeCodeDesc desc(1);
		2539
		2540	/* check arguments */
		2541	if (get_prop_check_argc(retval, argc, &desc))
		2542	return TRUE;
		2543
		2544	/* pop the value to compare */
		2545	G_stk->pop(&val2);
		2546
		2547	/* convert it to BigNumber */
		2548	if (!cvt_to_bignum(vmg_ self, &val2))
		2549	{
		2550	/* it's not a BigNumber, so it's not equal */
		2551	retval->set_nil();
		2552	}
		2553	else
		2554	{
		2555	int ret;
		2556
		2557	/* test for equality */
		2558	ret = compute_eq_round(vmg_ ext_, get_objid_ext(vmg_ val2.val.obj));
		2559
		2560	/* set the return value */
		2561	retval->set_logical(ret);
		2562	}
		2563
		2564	/* handled */
		2565	return TRUE;
		2566	}
		2567
		2568	/*
		2569	* property eval - get the precision
		2570	*/
		2571	int CVmObjBigNum::getp_get_prec(VMG_ vm_obj_id_t self,
		2572	vm_val_t retval, uint argc)
		2573	{
		2574	static CVmNativeCodeDesc desc(0);
		2575
		2576	/* check arguments */
		2577	if (get_prop_check_argc(retval, argc, &desc))
		2578	return TRUE;
		2579
		2580	/* return an integer giving my precision */
		2581	retval->set_int(get_prec(ext_));
		2582
		2583	/* handled */
		2584	return TRUE;
		2585	}
		2586
		2587	/*
		2588	* property eval - set the precision
		2589	*/
		2590	int CVmObjBigNum::getp_set_prec(VMG_ vm_obj_id_t self,
		2591	vm_val_t retval, uint argc)
		2592	{
		2593	size_t digits;
		2594	static CVmNativeCodeDesc desc(1);
		2595
		2596	/* check arguments */
		2597	if (get_prop_check_argc(retval, argc, &desc))
		2598	return TRUE;
		2599
		2600	/* get the number of digits for rounding */
		2601	digits = CVmBif::pop_int_val(vmg0_);
		2602
		2603	/* if I'm not a number, return myself unchanged */
		2604	if (is_nan(ext_))
		2605	{
		2606	retval->set_obj(self);
		2607	return TRUE;
		2608	}
		2609
		2610	/* push a self-reference while we're working */
		2611	G_stk->push()->set_obj(self);
		2612
		2613	/* create the rounded value */
		2614	round_val(vmg_ retval, ext_, digits, TRUE);
		2615
		2616	/* remove my self-reference */
		2617	G_stk->discard();
		2618
		2619	/* handled */
		2620	return TRUE;
		2621	}
		2622
		2623	/*
		2624	* get pi (static method)
		2625	*/
		2626	int CVmObjBigNum::s_getp_pi(VMG_ vm_val_t val, uint argc)
		2627	{
		2628	size_t prec;
		2629	char *new_ext;
		2630	const char *pi;
		2631	static CVmNativeCodeDesc desc(1);
		2632
		2633	/* check arguments */
		2634	if (get_prop_check_argc(val, argc, &desc))
		2635	return TRUE;
		2636
		2637	/* get the precision argument */
		2638	prec = CVmBif::pop_int_val(vmg0_);
		2639
		2640	/* allocate the result */
		2641	val->set_obj(create(vmg_ FALSE, prec));
		2642	new_ext = get_objid_ext(vmg_ val->val.obj);
		2643
		2644	/* cache pi to the required precision */
		2645	pi = cache_pi(vmg_ prec);
		2646
		2647	/* return the value */
		2648	copy_val(new_ext, pi, TRUE);
		2649
		2650	/* handled */
		2651	return TRUE;
		2652	}
		2653
		2654	/*
		2655	* get e (static method)
		2656	*/
		2657	int CVmObjBigNum::s_getp_e(VMG_ vm_val_t val, uint argc)
		2658	{
		2659	size_t prec;
		2660	char *new_ext;
		2661	const char *e;
		2662	static CVmNativeCodeDesc desc(1);
		2663
		2664	/* check arguments */
		2665	if (get_prop_check_argc(val, argc, &desc))
		2666	return TRUE;
		2667
		2668	/* get the precision argument */
		2669	prec = CVmBif::pop_int_val(vmg0_);
		2670
		2671	/* allocate the result */
		2672	val->set_obj(create(vmg_ FALSE, prec));
		2673	new_ext = get_objid_ext(vmg_ val->val.obj);
		2674
		2675	/* cache e to the required precision */
		2676	e = cache_e(vmg_ prec);
		2677
		2678	/* return the value */
		2679	copy_val(new_ext, e, TRUE);
		2680
		2681	/* handled */
		2682	return TRUE;
		2683	}
		2684
		2685	/*
		2686	* Set up for a zero-argument operation that returns a BigNumber result.
		2687	* Returns true if the argument check indicates that the caller should
		2688	* simply return to its caller, false if the caller should proceed.
		2689	*
		2690	* After checking the argument count, we'll proceed to set up the return
		2691	* value as per setup_getp_retval().
		2692	*/
		2693	int CVmObjBigNum::setup_getp_0(VMG_ vm_obj_id_t self, vm_val_t *retval,
		2694	uint argc, char *new_ext)
		2695	{
		2696	static CVmNativeCodeDesc desc(0);
		2697
		2698	/* check arguments */
		2699	if (get_prop_check_argc(retval, argc, &desc))
		2700	return TRUE;
		2701
		2702	/* set up the return value */
		2703	return setup_getp_retval(vmg_ self, retval, new_ext, get_prec(ext_));
		2704	}
		2705
		2706	/*
		2707	* Set up for a one-argument operation that takes a BigNumber value as
		2708	* the argument and returns a BigNumber result. Does the work of
		2709	* setup_getp_0, but also pops the argument value and converts it to a
		2710	* BigNumber (throwing an error if the value is not convertible).
		2711	*
		2712	* Fills in val2 with the argument value, and fills in *ext2 with val2's
		2713	* extension buffer.
		2714	*
		2715	* The result value will have the larger of the precisions of self and
		2716	* the other value, unless use_self_prec is set, in which case we'll use
		2717	* self's precision unconditionally.
		2718	*
		2719	* If either argument is not a number, we'll set the return value to the
		2720	* not-a-number argument unchanged, and return true.
		2721	*/
		2722	int CVmObjBigNum::setup_getp_1(VMG_ vm_obj_id_t self,
		2723	vm_val_t retval, uint argc,
		2724	char **new_ext,
		2725	vm_val_t val2, const char *ext2,
		2726	int use_self_prec)
		2727	{
		2728	size_t prec = get_prec(ext_);
		2729	static CVmNativeCodeDesc desc(1);
		2730
		2731	/* check arguments */
		2732	if (get_prop_check_argc(retval, argc, &desc))
		2733	return TRUE;
		2734
		2735	/* pop the argument value */
		2736	G_stk->pop(val2);
		2737
		2738	/* convert it to BigNumber */
		2739	if (!cvt_to_bignum(vmg_ self, val2))
		2740	{
		2741	/* it's not a BigNumber - throw an error */
		2742	err_throw(VMERR_BAD_TYPE_BIF);
		2743	}
		2744
		2745	/* get the other value's extension */
		2746	*ext2 = get_objid_ext(vmg_ val2->val.obj);
		2747
		2748	/* if the other value is not a number, return it as the result */
		2749	if (is_nan(*ext2))
		2750	{
		2751	retval->set_obj(val2->val.obj);
		2752	return TRUE;
		2753	}
		2754
		2755	/*
		2756	* if val2's precision is higher than ours, use it, unless we've
		2757	* been specifically told to use our own precision for the result
		2758	*/
		2759	if (!use_self_prec && get_prec(*ext2) > prec)
		2760	prec = get_prec(*ext2);
		2761
		2762	/* push the other result to protect it from garbage collection */
		2763	G_stk->push(val2);
		2764
		2765	/* allocate the return value */
		2766	if (setup_getp_retval(vmg_ self, retval, new_ext, prec))
		2767	{
		2768	/* discard the val2 reference we pushed for gc protection */
		2769	G_stk->discard();
		2770
		2771	/* tell the caller we're done */
		2772	return TRUE;
		2773	}
		2774
		2775	/* tell the caller to proceed */
		2776	return FALSE;
		2777	}
		2778
		2779	/*
		2780	* Set up for an operation that returns a BigNumber result. Returns
		2781	* true if we finished the operation, in which case the caller should
		2782	* simply return; returns false if the operation should still be carried
		2783	* out, in which case the caller should proceed as normal.
		2784	*
		2785	* If the 'self' value is not-a-number, we'll return it as the result
		2786	* (and return true to indicate that no further processing is required).
		2787	*
		2788	* If we return false, we'll have pushed a reference to 'self' onto the
		2789	* stack for protection against garbage collection. The caller must
		2790	* discard this reference before returning. We push no such
		2791	* self-reference if we return true.
		2792	*
		2793	* In addition, if we return false, we'll fill in '*new_ext' with a
		2794	* pointer to the extension buffer for the return value object that we
		2795	* allocate. We'll allocate the return value with the same precision as
		2796	* 'self'.
		2797	*
		2798	* Note that the caller should ensure that any argument sare removed
		2799	* from the stack before calling this routine, since we might push the
		2800	* self-reference onto the stack.
		2801	*/
		2802	int CVmObjBigNum::setup_getp_retval(VMG_ vm_obj_id_t self,
		2803	vm_val_t retval, char *new_ext,
		2804	size_t prec)
		2805	{
		2806	/* if I'm not a number, return myself unchanged */
		2807	if (is_nan(ext_))
		2808	{
		2809	retval->set_obj(self);
		2810	return TRUE;
		2811	}
		2812
		2813	/* push a self-reference while we're working */
		2814	G_stk->push()->set_obj(self);
		2815
		2816	/* create a new number with the same precision as the original */
		2817	retval->set_obj(create(vmg_ FALSE, prec));
		2818	*new_ext = get_objid_ext(vmg_ retval->val.obj);
		2819
		2820	/* tell the caller to proceed */
		2821	return FALSE;
		2822	}
		2823
		2824	/*
		2825	* property eval - get the fractional part
		2826	*/
		2827	int CVmObjBigNum::getp_frac(VMG_ vm_obj_id_t self,
		2828	vm_val_t retval, uint argc)
		2829	{
		2830	char *new_ext;
		2831	size_t idx;
		2832	int exp = get_exp(ext_);
		2833	size_t prec = get_prec(ext_);
		2834
		2835	/* check arguments and allocate the result value */
		2836	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		2837	return TRUE;
		2838
		2839	/* make a copy in the new object */
		2840	memcpy(new_ext, ext_, calc_alloc(prec));
		2841
		2842	/* clear out the first n digits, where n is the exponent */
		2843	for (idx = 0 ; idx < prec && (int)idx < exp ; ++idx)
		2844	set_dig(new_ext, idx, 0);
		2845
		2846	/* normalize the result */
		2847	normalize(new_ext);
		2848
		2849	/* remove my self-reference */
		2850	G_stk->discard();
		2851
		2852	/* handled */
		2853	return TRUE;
		2854	}
		2855
		2856	/*
		2857	* property eval - get the whole part, with no rounding
		2858	*/
		2859	int CVmObjBigNum::getp_whole(VMG_ vm_obj_id_t self,
		2860	vm_val_t retval, uint argc)
		2861	{
		2862	char *new_ext;
		2863	size_t idx;
		2864	int exp = get_exp(ext_);
		2865	size_t prec = get_prec(ext_);
		2866
		2867	/* check arguments and allocate the result value */
		2868	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		2869	return TRUE;
		2870
		2871	/* make a copy in the new object */
		2872	memcpy(new_ext, ext_, calc_alloc(prec));
		2873
		2874	/* check what we have */
		2875	if (exp <= 0)
		2876	{
		2877	/* it's an entirely fractional number - the result is zero */
		2878	set_zero(new_ext);
		2879	}
		2880	else
		2881	{
		2882	/* clear digits after the decimal point */
		2883	for (idx = (size_t)exp ; idx < prec ; ++idx)
		2884	set_dig(new_ext, idx, 0);
		2885
		2886	/* normalize the result */
		2887	normalize(new_ext);
		2888	}
		2889
		2890	/* remove my self-reference */
		2891	G_stk->discard();
		2892
		2893	/* handled */
		2894	return TRUE;
		2895	}
		2896
		2897	/*
		2898	* property eval - round to a given number of decimal places
		2899	*/
		2900	int CVmObjBigNum::getp_round_dec(VMG_ vm_obj_id_t self,
		2901	vm_val_t retval, uint argc)
		2902	{
		2903	int places;
		2904	char *new_ext;
		2905	int post_idx;
		2906	int exp = get_exp(ext_);
		2907	size_t prec = get_prec(ext_);
		2908	static CVmNativeCodeDesc desc(1);
		2909
		2910	/* check arguments */
		2911	if (get_prop_check_argc(retval, argc, &desc))
		2912	return TRUE;
		2913
		2914	/* get the number of digits for rounding */
		2915	places = CVmBif::pop_int_val(vmg0_);
		2916
		2917	/* set up the return value */
		2918	if (setup_getp_retval(vmg_ self, retval, &new_ext, prec))
		2919	return TRUE;
		2920
		2921	/* make a copy in the new object */
		2922	memcpy(new_ext, ext_, calc_alloc(prec));
		2923
		2924	/*
		2925	* Determine if the first digit we're lopping off is actually
		2926	* represented in the number or not. This digit position is the
		2927	* exponent plus the number of decimal places after the decimal to
		2928	* keep - if this value is at least zero and less than the
		2929	* precision, it's part of the number.
		2930	*/
		2931	post_idx = places + exp;
		2932	if (post_idx < 0)
		2933	{
		2934	/*
		2935	* the digit after the last digit to keep is actually before the
		2936	* beginning of the number, so the result of the rounding is
		2937	* simply zero
		2938	*/
		2939	set_zero(new_ext);
		2940	}
		2941	else if (post_idx >= (int)prec)
		2942	{
		2943	/*
		2944	* the digit after the last digit to keep is past the end of the
		2945	* represented digits, so rounding has no effect at all - we'll
		2946	* simply return the same number
		2947	*/
		2948	}
		2949	else
		2950	{
		2951	int need_to_round;
		2952	size_t idx;
		2953
		2954	/*
		2955	* the digit after the last digit is part of the number - note
		2956	* it so we can tell if we need to round later
		2957	*/
		2958	need_to_round = (get_dig(new_ext, post_idx) >= 5);
		2959
		2960	/* set all of the digits to be elided to zero */
		2961	for (idx = (size_t)post_idx ; idx < prec ; ++idx)
		2962	set_dig(new_ext, idx, 0);
		2963
		2964	/* if we need to round, do so now */
		2965	if (need_to_round)
		2966	{
		2967	int carry;
		2968
		2969	/* increment the last digit, and apply carry as far as needed */
		2970	for (carry = TRUE, idx = (size_t)post_idx ; idx != 0 ; )
		2971	{
		2972	/* move to the next digit */
		2973	--idx;
		2974
		2975	/* check to see if we need to carry */
		2976	if (get_dig(new_ext, idx) == 9)
		2977	{
		2978	/* set it to zero, then keep going to carry */
		2979	set_dig(new_ext, idx, 0);
		2980	}
		2981	else
		2982	{
		2983	/* increment the digit */
		2984	set_dig(new_ext, idx, get_dig(new_ext, idx) + 1);
		2985
		2986	/* no need to carry */
		2987	carry = FALSE;
		2988	break;
		2989	}
		2990	}
		2991
		2992	/* if we needed to carry, insert a leading 1 */
		2993	if (carry)
		2994	{
		2995	/* shift the number right one place */
		2996	shift_right(new_ext, 1);
		2997
		2998	/* adjust the exponent upwards */
		2999	++exp;
		3000	set_exp(new_ext, exp);
		3001
		3002	/* insert the leading 1 */
		3003	set_dig(new_ext, 0, 1);
		3004	}
		3005	}
		3006
		3007	/* normalize the result */
		3008	normalize(new_ext);
		3009	}
		3010
		3011	/* remove my self-reference */
		3012	G_stk->discard();
		3013
		3014	/* handled */
		3015	return TRUE;
		3016	}
		3017
		3018	/*
		3019	* property eval - get the absolute value
		3020	*/
		3021	int CVmObjBigNum::getp_abs(VMG_ vm_obj_id_t self,
		3022	vm_val_t retval, uint argc)
		3023	{
		3024	char *new_ext;
		3025	size_t prec = get_prec(ext_);
		3026	static CVmNativeCodeDesc desc(0);
		3027
		3028	/* check arguments */
		3029	if (get_prop_check_argc(retval, argc, &desc))
		3030	return TRUE;
		3031
		3032	/*
		3033	* If I'm not an ordinary number or an infinity, or I'm already
		3034	* non-negative, return myself unchanged. Note that we change
		3035	* negative infinity to infinity, even though this might not make a
		3036	* great deal of sense mathematically.
		3037	*/
		3038	if (!get_neg(ext_)
		3039	\|\| (get_type(ext_) != VMBN_T_NUM && get_type(ext_) != VMBN_T_INF))
		3040	{
		3041	retval->set_obj(self);
		3042	return TRUE;
		3043	}
		3044
		3045	/* push a self-reference while we're working */
		3046	G_stk->push()->set_obj(self);
		3047
		3048	/*
		3049	* if I'm negative infinity, we don't need any precision in the new
		3050	* value
		3051	*/
		3052	if (get_type(ext_) == VMBN_T_INF)
		3053	prec = 1;
		3054
		3055	/* create a new number with the same precision as the original */
		3056	retval->set_obj(create(vmg_ FALSE, prec));
		3057	new_ext = get_objid_ext(vmg_ retval->val.obj);
		3058
		3059	/* make a copy in the new object */
		3060	memcpy(new_ext, ext_, calc_alloc(prec));
		3061
		3062	/* set the sign to positive */
		3063	set_neg(new_ext, FALSE);
		3064
		3065	/* remove my self-reference */
		3066	G_stk->discard();
		3067
		3068	/* handled */
		3069	return TRUE;
		3070	}
		3071
		3072	/*
		3073	* property eval - ceiling (least integer greater than or equal to self)
		3074	*/
		3075	int CVmObjBigNum::getp_ceil(VMG_ vm_obj_id_t self,
		3076	vm_val_t retval, uint argc)
		3077	{
		3078	char *new_ext;
		3079	size_t idx;
		3080	int exp = get_exp(ext_);
		3081	size_t prec = get_prec(ext_);
		3082	int frac_zero;
		3083	static CVmNativeCodeDesc desc(0);
		3084
		3085	/* check arguments */
		3086	if (get_prop_check_argc(retval, argc, &desc))
		3087	return TRUE;
		3088
		3089	/* check arguments and allocate the result value */
		3090	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		3091	return TRUE;
		3092
		3093	/* make a copy in the new object */
		3094	memcpy(new_ext, ext_, calc_alloc(prec));
		3095
		3096	/* determine if the fractional part is non-zero */
		3097	frac_zero = is_frac_zero(new_ext);
		3098
		3099	/* check what we have */
		3100	if (exp <= 0)
		3101	{
		3102	/*
		3103	* it's an entirely fractional number - the result is zero if
		3104	* the number is negative or zero, one if the number is positive
		3105	*/
		3106	if (get_neg(new_ext) \|\| frac_zero)
		3107	{
		3108	/* -1 < x <= 0 -> ceil(x) = 0 */
		3109	set_zero(new_ext);
		3110	}
		3111	else
		3112	{
		3113	/* 0 < x < 1 -> ceil(x) = 1 */
		3114	copy_val(new_ext, get_one(), FALSE);
		3115	}
		3116	}
		3117	else
		3118	{
		3119	/* clear digits after the decimal point */
		3120	for (idx = (size_t)exp ; idx < prec ; ++idx)
		3121	set_dig(new_ext, idx, 0);
		3122
		3123	/*
		3124	* if there's a fractional part and it's positive, increment the
		3125	* number
		3126	*/
		3127	if (!frac_zero && !get_neg(new_ext))
		3128	increment_abs(new_ext);
		3129	}
		3130
		3131	/* remove my self-reference */
		3132	G_stk->discard();
		3133
		3134	/* handled */
		3135	return TRUE;
		3136	}
		3137
		3138	/*
		3139	* property eval - floor (greatest integer <= self)
		3140	*/
		3141	int CVmObjBigNum::getp_floor(VMG_ vm_obj_id_t self,
		3142	vm_val_t retval, uint argc)
		3143	{
		3144	char *new_ext;
		3145	size_t idx;
		3146	int exp = get_exp(ext_);
		3147	size_t prec = get_prec(ext_);
		3148	int frac_zero;
		3149
		3150	/* check arguments and allocate the result value */
		3151	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		3152	return TRUE;
		3153
		3154	/* make a copy in the new object */
		3155	memcpy(new_ext, ext_, calc_alloc(prec));
		3156
		3157	/* determine if the fractional part is non-zero */
		3158	frac_zero = is_frac_zero(new_ext);
		3159
		3160	/* check what we have */
		3161	if (exp <= 0)
		3162	{
		3163	/*
		3164	* it's an entirely fractional number - the result is zero if
		3165	* the number is positive or zero, -1 if the number is negative
		3166	*/
		3167	if (!get_neg(new_ext) \|\| frac_zero)
		3168	{
		3169	/* 0 <= x < 1 -> floor(x) = 0 */
		3170	set_zero(new_ext);
		3171	}
		3172	else
		3173	{
		3174	/* -1 < x < 0 -> floor(x) = -1 */
		3175	copy_val(new_ext, get_one(), FALSE);
		3176	set_neg(new_ext, TRUE);
		3177	}
		3178	}
		3179	else
		3180	{
		3181	/* clear digits after the decimal point */
		3182	for (idx = (size_t)exp ; idx < prec ; ++idx)
		3183	set_dig(new_ext, idx, 0);
		3184
		3185	/*
		3186	* if there's a fractional part and the number is negative,
		3187	* increment the number's absolute value
		3188	*/
		3189	if (!frac_zero && get_neg(new_ext))
		3190	increment_abs(new_ext);
		3191	}
		3192
		3193	/* remove my self-reference */
		3194	G_stk->discard();
		3195
		3196	/* handled */
		3197	return TRUE;
		3198	}
		3199
		3200	/*
		3201	* property eval - getScale
		3202	*/
		3203	int CVmObjBigNum::getp_get_scale(VMG_ vm_obj_id_t self,
		3204	vm_val_t retval, uint argc)
		3205	{
		3206	static CVmNativeCodeDesc desc(0);
		3207
		3208	/* check arguments */
		3209	if (get_prop_check_argc(retval, argc, &desc))
		3210	return TRUE;
		3211
		3212	/* check the type */
		3213	if (is_nan(ext_))
		3214	{
		3215	/* it's not a number - return nil for the scale */
		3216	retval->set_nil();
		3217	}
		3218	else
		3219	{
		3220	/* return an integer giving the number's scale */
		3221	retval->set_int(get_exp(ext_));
		3222	}
		3223
		3224	/* handled */
		3225	return TRUE;
		3226	}
		3227
		3228	/*
		3229	* property eval - scale
		3230	*/
		3231	int CVmObjBigNum::getp_scale(VMG_ vm_obj_id_t self,
		3232	vm_val_t retval, uint argc)
		3233	{
		3234	char *new_ext;
		3235	size_t prec = get_prec(ext_);
		3236	int scale;
		3237	static CVmNativeCodeDesc desc(1);
		3238
		3239	/* check arguments */
		3240	if (get_prop_check_argc(retval, argc, &desc))
		3241	return TRUE;
		3242
		3243	/* get the scaling argument */
		3244	scale = CVmBif::pop_int_val(vmg0_);
		3245
		3246	/* set up the return value */
		3247	if (setup_getp_retval(vmg_ self, retval, &new_ext, prec))
		3248	return TRUE;
		3249
		3250	/* copy the value */
		3251	memcpy(new_ext, ext_, calc_alloc(prec));
		3252
		3253	/* adjust the exponent by the scale factor */
		3254	set_exp(new_ext, get_exp(new_ext) + scale);
		3255
		3256	/* discard the GC protection */
		3257	G_stk->discard();
		3258
		3259	/* handled */
		3260	return TRUE;
		3261	}
		3262
		3263	/*
		3264	* property eval - negate
		3265	*/
		3266	int CVmObjBigNum::getp_negate(VMG_ vm_obj_id_t self,
		3267	vm_val_t retval, uint argc)
		3268	{
		3269	static CVmNativeCodeDesc desc(0);
		3270
		3271	/* check arguments */
		3272	if (get_prop_check_argc(retval, argc, &desc))
		3273	return TRUE;
		3274
		3275	/* negate the value */
		3276	neg_val(vmg_ retval, self);
		3277
		3278	/* handled */
		3279	return TRUE;
		3280	}
		3281
		3282	/*
		3283	* property eval - copy sign
		3284	*/
		3285	int CVmObjBigNum::getp_copy_sign(VMG_ vm_obj_id_t self,
		3286	vm_val_t retval, uint argc)
		3287	{
		3288	vm_val_t val2;
		3289	char *new_ext;
		3290	const char *ext2;
		3291	size_t prec = get_prec(ext_);
		3292
		3293	if (setup_getp_1(vmg_ self, retval, argc, &new_ext,
		3294	&val2, &ext2, TRUE))
		3295	return TRUE;
		3296
		3297	/* make a copy of my value in the new object */
		3298	memcpy(new_ext, ext_, calc_alloc(prec));
		3299
		3300	/* set the sign from the other object */
		3301	set_neg(new_ext, get_neg(ext2));
		3302
		3303	/*
		3304	* normalize it (this is important when the value was zero to start
		3305	* with, since zero is always represented without a negative sign)
		3306	*/
		3307	normalize(new_ext);
		3308
		3309	/* remove the GC protection */
		3310	G_stk->discard(2);
		3311
		3312	/* handled */
		3313	return TRUE;
		3314	}
		3315
		3316	/*
		3317	* property eval - isNegative
		3318	*/
		3319	int CVmObjBigNum::getp_is_neg(VMG_ vm_obj_id_t self,
		3320	vm_val_t retval, uint argc)
		3321	{
		3322	static CVmNativeCodeDesc desc(0);
		3323
		3324	/* check arguments */
		3325	if (get_prop_check_argc(retval, argc, &desc))
		3326	return TRUE;
		3327
		3328	/* if I'm not an ordinary number or an infinity, I'm not negative */
		3329	if (get_type(ext_) != VMBN_T_NUM && get_type(ext_) != VMBN_T_INF)
		3330	{
		3331	/* I'm not negative, so return nil */
		3332	retval->set_nil();
		3333	}
		3334	else
		3335	{
		3336	/* set the return value to true if I'm negative, nil if not */
		3337	retval->set_logical(get_neg(ext_));
		3338	}
		3339
		3340	/* handled */
		3341	return TRUE;
		3342	}
		3343
		3344	/*
		3345	* property eval - remainder
		3346	*/
		3347	int CVmObjBigNum::getp_remainder(VMG_ vm_obj_id_t self,
		3348	vm_val_t retval, uint argc)
		3349	{
		3350	vm_val_t val2;
		3351	const char *ext2;
		3352	char *quo_ext;
		3353	char *rem_ext;
		3354	vm_val_t rem_val;
		3355	vm_val_t quo_val;
		3356	CVmObjList *lst;
		3357	static CVmNativeCodeDesc desc(1);
		3358
		3359	/* check arguments */
		3360	if (get_prop_check_argc(retval, argc, &desc))
		3361	return TRUE;
		3362
		3363	/* pop the divisor */
		3364	G_stk->pop(&val2);
		3365
		3366	/* convert it to BigNumber */
		3367	if (!cvt_to_bignum(vmg_ self, &val2))
		3368	{
		3369	/* it's not a BigNumber - throw an error */
		3370	err_throw(VMERR_BAD_TYPE_BIF);
		3371	}
		3372
		3373	/* get the divisor's extension */
		3374	ext2 = get_objid_ext(vmg_ val2.val.obj);
		3375
		3376	/* push 'self' and the other value to protect against GC */
		3377	G_stk->push()->set_obj(self);
		3378	G_stk->push(&val2);
		3379
		3380	/* create a quotient result value, and push it for safekeeping */
		3381	quo_ext = compute_init_2op(vmg_ &quo_val, ext_, ext2);
		3382	G_stk->push(&quo_val);
		3383
		3384	/* create a remainder result value, and push it for safekeeping */
		3385	rem_ext = compute_init_2op(vmg_ &rem_val, ext_, ext2);
		3386	G_stk->push(&rem_val);
		3387
		3388	/*
		3389	* create a list for the return value - it will have two elements:
		3390	* the quotient and the remainder
		3391	*/
		3392	retval->set_obj(CVmObjList::create(vmg_ FALSE, 2));
		3393	lst = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		3394
		3395	/* set the list elements */
		3396	lst->cons_set_element(0, &quo_val);
		3397	lst->cons_set_element(1, &rem_val);
		3398
		3399	/* calculate the quotient */
		3400	compute_quotient_into(vmg_ quo_ext, rem_ext, ext_, ext2);
		3401
		3402	/* remove the GC protection */
		3403	G_stk->discard(4);
		3404
		3405	/* handled */
		3406	return TRUE;
		3407	}
		3408
		3409	/*
		3410	* property eval - sine
		3411	*/
		3412	int CVmObjBigNum::getp_sin(VMG_ vm_obj_id_t self,
		3413	vm_val_t retval, uint argc)
		3414	{
		3415	char *new_ext;
		3416	size_t prec = get_prec(ext_);
		3417	uint hdl1, hdl2, hdl3, hdl4, hdl5, hdl6, hdl7;
		3418	char ext1, ext2, ext3, ext4, ext5, ext6, *ext7;
		3419	int neg_result;
		3420	const char *pi;
		3421
		3422	/* check arguments and set up the result */
		3423	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		3424	return TRUE;
		3425
		3426	/* cache pi */
		3427	pi = cache_pi(vmg_ prec + 3);
		3428
		3429	/*
		3430	* Allocate our temporary registers. We'll use 1 and 2 to calculate
		3431	* x^n - we'll start with x^(n-2) in one, and multiply by x^2 to put
		3432	* the result in the other. 3 we'll use to store n!. 4 we'll use
		3433	* to store the result of x^n/n!, and 5 and 6 we'll swap as the
		3434	* master accumulator. 7 we'll use to store x^2.
		3435	*
		3436	* Allocate the temporary registers with more digits of precision
		3437	* than we need in the result, to ensure that accumulated rounding
		3438	* errors don't affect the result.
		3439	*/
		3440	alloc_temp_regs(vmg_ prec + 3, 7,
		3441	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		3442	&ext4, &hdl4, &ext5, &hdl5, &ext6, &hdl6, &ext7, &hdl7);
		3443
		3444	/* protect against errors so we definitely free the registers */
		3445	err_try
		3446	{
		3447	char *tmp;
		3448
		3449	/* copy our initial value to ext1 */
		3450	copy_val(ext1, ext_, FALSE);
		3451
		3452	/*
		3453	* Note that sin(-x) = -sin(x). If x < 0, note the negative
		3454	* sign and then negate the value so that we calculate sin(x)
		3455	* and return the negative of the result.
		3456	*/
		3457	neg_result = get_neg(ext1);
		3458	set_neg(ext1, FALSE);
		3459
		3460	/* calculate 2pi /
		3461	copy_val(ext7, pi, TRUE);
		3462	mul_by_long(ext7, 2);
		3463
		3464	/*
		3465	* Because we'll use a Taylor series around 0 to calculate the
		3466	* result, we want our value as close to the expansion point (0)
		3467	* as possible to speed up convergence of the series.
		3468	* Fortunately this is especially easy for sin() because of the
		3469	* periodic nature of the function.
		3470	*
		3471	* First, note that sin(2pii + x) = sin(x) for all integers i,
		3472	* so we can reduce the argument mod 2*pi until it's in the
		3473	* range 0 <= x < 2*pi (we might have to do this multiple times
		3474	* if the number's scale exceeds its precision). Note that we
		3475	* already made sure the number is positive.
		3476	*/
		3477	while (compare_abs(ext1, ext7) > 0)
		3478	{
		3479	/* divide by 2pi, storing the remainder in r2 /
		3480	compute_quotient_into(vmg_ ext6, ext2, ext1, ext7);
		3481
		3482	/* swap r2 into r1 for the next round */
		3483	tmp = ext1;
		3484	ext1 = ext2;
		3485	ext2 = tmp;
		3486	}
		3487
		3488	/*
		3489	* Next, note that sin(x+pi) = -sin(x). If x > pi, negate the
		3490	* result (again if necessary) and reduce the argument by pi.
		3491	* This will reduce our range to 0 <= x <= pi.
		3492	*/
		3493	copy_val(ext7, pi, TRUE);
		3494	if (compare_abs(ext1, ext7) > 0)
		3495	{
		3496	/* negate the result */
		3497	neg_result = !neg_result;
		3498
		3499	/* subtract pi from the argument */
		3500	compute_abs_diff_into(ext2, ext1, ext7);
		3501
		3502	/* swap the result into r1 */
		3503	tmp = ext1;
		3504	ext1 = ext2;
		3505	ext2 = tmp;
		3506	}
		3507
		3508	/*
		3509	* Use the fact that sin(x + pi) = -sin(x) once again: if x >
		3510	* pi/2, subtract pi from x to adjust the range to -pi/2 <= x <=
		3511	* pi/2.
		3512	*/
		3513	div_by_long(ext7, 2);
		3514	if (compare_abs(ext1, ext7) > 0)
		3515	{
		3516	/* negate the result */
		3517	neg_result = !neg_result;
		3518
		3519	/* subtract pi from the argument */
		3520	copy_val(ext7, pi, TRUE);
		3521	compute_abs_diff_into(ext2, ext1, ext7);
		3522
		3523	/* swap the result into r1 */
		3524	tmp = ext1;
		3525	ext1 = ext2;
		3526	ext2 = tmp;
		3527	}
		3528
		3529	/*
		3530	* once again, reduce our range using the sign equivalence -
		3531	* this will limit our range to 0 <= x <= pi/2
		3532	*/
		3533	if (get_neg(ext1))
		3534	neg_result = !neg_result;
		3535	set_neg(ext1, FALSE);
		3536
		3537	/*
		3538	* Next, observe that sin(x+pi/2) = cos(x). If x > pi/4,
		3539	* calculate using the cosine series instead of the sine series.
		3540	*/
		3541	copy_val(ext7, pi, TRUE);
		3542	div_by_long(ext7, 4);
		3543	if (compare_abs(ext1, ext7) > 0)
		3544	{
		3545	/* calculate pi/2 */
		3546	copy_val(ext7, pi, TRUE);
		3547	div_by_long(ext7, 2);
		3548
		3549	/*
		3550	* subtract pi/2 - this will give us a value in the range
		3551	* -pi/4 <= x <= pi/4
		3552	*/
		3553	compute_abs_diff_into(ext2, ext1, ext7);
		3554
		3555	/* cos(-x) = cos(x), so we can ignore the sign */
		3556	set_neg(ext1, FALSE);
		3557
		3558	/* swap the result into r1 */
		3559	tmp = ext1;
		3560	ext1 = ext2;
		3561	ext2 = tmp;
		3562
		3563	/* calculate the cosine series */
		3564	calc_cos_series(vmg_ new_ext,
		3565	ext1, ext2, ext3, ext4, ext5, ext6, ext7);
		3566	}
		3567	else
		3568	{
		3569	/*
		3570	* We now have a value in the range 0 <= x <= pi/4, which
		3571	* will converge quickly with our Taylor series
		3572	*/
		3573	calc_sin_series(vmg_ new_ext,
		3574	ext1, ext2, ext3, ext4, ext5, ext6, ext7);
		3575	}
		3576
		3577	/* negate the result if necessary */
		3578	if (neg_result)
		3579	set_neg(new_ext, !get_neg(new_ext));
		3580
		3581	/* normalize the result */
		3582	normalize(new_ext);
		3583	}
		3584	err_finally
		3585	{
		3586	/* release our temporary registers */
		3587	release_temp_regs(vmg_ 7, hdl1, hdl2, hdl3, hdl4, hdl5, hdl6, hdl7);
		3588	}
		3589	err_end;
		3590
		3591	/* remove my self-reference */
		3592	G_stk->discard();
		3593
		3594	/* handled */
		3595	return TRUE;
		3596	}
		3597
		3598	/*
		3599	* property eval - cosine. This works very much the same way as
		3600	* getp_sin() - refer to the more extensive comments in that routine for
		3601	* more detail on the algorithm.
		3602	*/
		3603	int CVmObjBigNum::getp_cos(VMG_ vm_obj_id_t self,
		3604	vm_val_t retval, uint argc)
		3605	{
		3606	char *new_ext;
		3607	size_t prec = get_prec(ext_);
		3608	uint hdl1, hdl2, hdl3, hdl4, hdl5, hdl6, hdl7;
		3609	char ext1, ext2, ext3, ext4, ext5, ext6, *ext7;
		3610	int neg_result;
		3611	const char *pi;
		3612
		3613	/* check arguments and set up the result */
		3614	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		3615	return TRUE;
		3616
		3617	/* cache pi to our working precision */
		3618	pi = cache_pi(vmg_ prec + 3);
		3619
		3620	/* allocate our temporary registers, as per sin() */
		3621	alloc_temp_regs(vmg_ prec + 3, 7,
		3622	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		3623	&ext4, &hdl4, &ext5, &hdl5, &ext6, &hdl6, &ext7, &hdl7);
		3624
		3625	/* protect against errors so we definitely free the registers */
		3626	err_try
		3627	{
		3628	char *tmp;
		3629
		3630	/* presume the result sign will be correct */
		3631	neg_result = FALSE;
		3632
		3633	/* copy our initial value to ext1 */
		3634	copy_val(ext1, ext_, FALSE);
		3635
		3636	/* note that cos(-x) = cos(x) - if x < 0, use -x */
		3637	set_neg(ext1, FALSE);
		3638
		3639	/* reduce the argument modulo 2pi /
		3640	copy_val(ext7, pi, TRUE);
		3641	mul_by_long(ext7, 2);
		3642	while (compare_abs(ext1, ext7) > 0)
		3643	{
		3644	/* divide by 2pi, storing the remainder in r2 /
		3645	compute_quotient_into(vmg_ ext6, ext2, ext1, ext7);
		3646
		3647	/* swap r2 into r1 for the next round */
		3648	tmp = ext1;
		3649	ext1 = ext2;
		3650	ext2 = tmp;
		3651	}
		3652
		3653	/*
		3654	* Next, note that cos(x+pi) = -cos(x). If x > pi, negate the
		3655	* result (again if necessary) and reduce the argument by pi.
		3656	* This will reduce our range to 0 <= x <= pi.
		3657	*/
		3658	copy_val(ext7, pi, TRUE);
		3659	if (compare_abs(ext1, ext7) > 0)
		3660	{
		3661	/* negate the result */
		3662	neg_result = !neg_result;
		3663
		3664	/* subtract pi from the argument */
		3665	compute_abs_diff_into(ext2, ext1, ext7);
		3666
		3667	/* swap the result into r1 */
		3668	tmp = ext1;
		3669	ext1 = ext2;
		3670	ext2 = tmp;
		3671	}
		3672
		3673	/*
		3674	* Use the fact that cos(x + pi) = -cos(x) once again: if x >
		3675	* pi/2, subtract pi from x to adjust the range to -pi/2 <= x <=
		3676	* pi/2.
		3677	*/
		3678	div_by_long(ext7, 2);
		3679	if (compare_abs(ext1, ext7) > 0)
		3680	{
		3681	/* negate the result */
		3682	neg_result = !neg_result;
		3683
		3684	/* subtract pi from the argument */
		3685	copy_val(ext7, pi, TRUE);
		3686	compute_abs_diff_into(ext2, ext1, ext7);
		3687
		3688	/* swap the result into r1 */
		3689	tmp = ext1;
		3690	ext1 = ext2;
		3691	ext2 = tmp;
		3692	}
		3693
		3694	/*
		3695	* once again, reduce our range using the sign equivalence -
		3696	* this will limit our range to 0 <= x <= pi/2
		3697	*/
		3698	set_neg(ext1, FALSE);
		3699
		3700	/*
		3701	* Next, observe that cos(x+pi/2) = -sin(x). If x > pi/4,
		3702	* calculate using the sine series instead of the cosine series.
		3703	*/
		3704	copy_val(ext7, pi, TRUE);
		3705	div_by_long(ext7, 4);
		3706	if (compare_abs(ext1, ext7) > 0)
		3707	{
		3708	/* negate the result */
		3709	neg_result = !neg_result;
		3710
		3711	/* calculate pi/2 */
		3712	copy_val(ext7, pi, TRUE);
		3713	div_by_long(ext7, 2);
		3714
		3715	/*
		3716	* subtract pi/2 - this will give us a value in the range
		3717	* -pi/4 <= x <= pi/4
		3718	*/
		3719	compute_abs_diff_into(ext2, ext1, ext7);
		3720
		3721	/* sin(-x) = -sin(x) */
		3722	if (get_neg(ext1))
		3723	neg_result = !neg_result;
		3724	set_neg(ext1, FALSE);
		3725
		3726	/* swap the result into r1 */
		3727	tmp = ext1;
		3728	ext1 = ext2;
		3729	ext2 = tmp;
		3730
		3731	/* calculate the sine series */
		3732	calc_sin_series(vmg_ new_ext,
		3733	ext1, ext2, ext3, ext4, ext5, ext6, ext7);
		3734	}
		3735	else
		3736	{
		3737	/*
		3738	* We now have a value in the range 0 <= x <= pi/4, which
		3739	* will converge quickly with our Taylor series
		3740	*/
		3741	calc_cos_series(vmg_ new_ext,
		3742	ext1, ext2, ext3, ext4, ext5, ext6, ext7);
		3743	}
		3744
		3745	/* negate the result if necessary */
		3746	if (neg_result)
		3747	set_neg(new_ext, !get_neg(new_ext));
		3748
		3749	/* normalize the result */
		3750	normalize(new_ext);
		3751	}
		3752	err_finally
		3753	{
		3754	/* release our temporary registers */
		3755	release_temp_regs(vmg_ 7, hdl1, hdl2, hdl3, hdl4, hdl5, hdl6, hdl7);
		3756	}
		3757	err_end;
		3758
		3759	/* remove my self-reference */
		3760	G_stk->discard();
		3761
		3762	/* handled */
		3763	return TRUE;
		3764	}
		3765
		3766	/*
		3767	* property eval - tangent. We calculate the sine and cosine, then
		3768	* compute the quotient to determine the tangent. This routine works
		3769	* very much like the sin() and cos() routines; refer to getp_sin() for
		3770	* more thorough documentation.
		3771	*/
		3772	int CVmObjBigNum::getp_tan(VMG_ vm_obj_id_t self,
		3773	vm_val_t retval, uint argc)
		3774	{
		3775	char *new_ext;
		3776	size_t prec = get_prec(ext_);
		3777	uint hdl1, hdl2, hdl3, hdl4, hdl5, hdl6, hdl7, hdl8, hdl9;
		3778	char ext1, ext2, ext3, ext4, ext5, ext6, ext7, ext8, *ext9;
		3779	int neg_result;
		3780	int invert_result;
		3781	const char *pi;
		3782
		3783	/* check arguments and set up the result */
		3784	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		3785	return TRUE;
		3786
		3787	/* cache pi to the working precision */
		3788	pi = cache_pi(vmg_ prec + 3);
		3789
		3790	/*
		3791	* Allocate our temporary registers for sin() and cos()
		3792	* calculations, plus two extra: one to hold the sine while we're
		3793	* calculating the cosine, and the other to hold the cosine result.
		3794	*
		3795	* (We could make do with fewer registers by copying values around,
		3796	* but if the numbers are of very high precision it's much cheaper
		3797	* to allocate more registers, since the registers come out of the
		3798	* register cache and probably won't require any actual memory
		3799	* allocation.)
		3800	*/
		3801	alloc_temp_regs(vmg_ prec + 3, 9,
		3802	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		3803	&ext4, &hdl4, &ext5, &hdl5, &ext6, &hdl6,
		3804	&ext7, &hdl7, &ext8, &hdl8, &ext9, &hdl9);
		3805
		3806	/* protect against errors so we definitely free the registers */
		3807	err_try
		3808	{
		3809	char *tmp;
		3810
		3811	/* presume we won't have to invert our result */
		3812	invert_result = FALSE;
		3813
		3814	/* copy our initial value to ext1 */
		3815	copy_val(ext1, ext_, FALSE);
		3816
		3817	/* note that tan(-x) = -tan(x) - if x < 0, use -x */
		3818	neg_result = get_neg(ext1);
		3819	set_neg(ext1, FALSE);
		3820
		3821	/* reduce the argument modulo 2pi /
		3822	copy_val(ext7, pi, TRUE);
		3823	mul_by_long(ext7, 2);
		3824	while (compare_abs(ext1, ext7) > 0)
		3825	{
		3826	/* divide by 2pi, storing the remainder in r2 /
		3827	compute_quotient_into(vmg_ ext6, ext2, ext1, ext7);
		3828
		3829	/* swap r2 into r1 for the next round */
		3830	tmp = ext1;
		3831	ext1 = ext2;
		3832	ext2 = tmp;
		3833	}
		3834
		3835	/*
		3836	* Next, note that tan(x+pi) = tan(x). So, if x > pi, the
		3837	* argument by pi. This will reduce our range to 0 <= x <= pi.
		3838	*/
		3839	copy_val(ext7, pi, TRUE);
		3840	if (compare_abs(ext1, ext7) > 0)
		3841	{
		3842	/* subtract pi from the argument */
		3843	compute_abs_diff_into(ext2, ext1, ext7);
		3844
		3845	/* swap the result into r1 */
		3846	tmp = ext1;
		3847	ext1 = ext2;
		3848	ext2 = tmp;
		3849	}
		3850
		3851	/*
		3852	* Use the fact that tan(x + pi) = tan(x) once again: if x >
		3853	* pi/2, subtract pi from x to adjust the range to -pi/2 <= x <=
		3854	* pi/2.
		3855	*/
		3856	div_by_long(ext7, 2);
		3857	if (compare_abs(ext1, ext7) > 0)
		3858	{
		3859	/* subtract pi from the argument */
		3860	copy_val(ext7, pi, TRUE);
		3861	compute_abs_diff_into(ext2, ext1, ext7);
		3862
		3863	/* swap the result into r1 */
		3864	tmp = ext1;
		3865	ext1 = ext2;
		3866	ext2 = tmp;
		3867	}
		3868
		3869	/*
		3870	* once again, reduce our range using the sign equivalence -
		3871	* this will limit our range to 0 <= x <= pi/2
		3872	*/
		3873	if (get_neg(ext1))
		3874	neg_result = !neg_result;
		3875	set_neg(ext1, FALSE);
		3876
		3877	/*
		3878	* Next, observe that tan(x+pi/2) = 1/tan(x). If x > pi/4,
		3879	* invert the result.
		3880	*/
		3881	copy_val(ext7, pi, TRUE);
		3882	div_by_long(ext7, 4);
		3883	if (compare_abs(ext1, ext7) > 0)
		3884	{
		3885	/* calculate pi/2 */
		3886	copy_val(ext7, pi, TRUE);
		3887	div_by_long(ext7, 2);
		3888
		3889	/* subtract pi/2 to get into range -pi/4 <= x <= pi/4 */
		3890	compute_abs_diff_into(ext2, ext1, ext7);
		3891
		3892	/* sin(-x) = -sin(x) */
		3893	if (get_neg(ext1))
		3894	neg_result = !neg_result;
		3895	set_neg(ext1, FALSE);
		3896
		3897	/* swap the result into r1 */
		3898	tmp = ext1;
		3899	ext1 = ext2;
		3900	ext2 = tmp;
		3901
		3902	/* note that we must invert the result */
		3903	invert_result = TRUE;
		3904	}
		3905
		3906	/*
		3907	* make a copy of our argument value in ext9 for safekeeping
		3908	* while we're calculating the sine
		3909	*/
		3910	copy_val(ext9, ext1, FALSE);
		3911
		3912	/*
		3913	* We now have a value in the range 0 <= x <= pi/4, which will
		3914	* converge quickly with our Taylor series for sine and cosine.
		3915	* This will also ensure that both sin and cos are non-negative,
		3916	* so the sign we calculated for the tangent is all that matters
		3917	* for the sign.
		3918	*
		3919	* First, Calculate the sine and store the result in r8.
		3920	*/
		3921	calc_sin_series(vmg_ ext8,
		3922	ext1, ext2, ext3, ext4, ext5, ext6, ext7);
		3923
		3924	/*
		3925	* Calculate the cosine and store the result in r1. Note that
		3926	* we saved the argument value in ext9 while we were working on
		3927	* the sine, so we can now use that value as the argument here.
		3928	* ext1 was trashed by the sine calculation, so just use it as
		3929	* the output register here.
		3930	*/
		3931	calc_cos_series(vmg_ ext1,
		3932	ext9, ext2, ext3, ext4, ext5, ext6, ext7);
		3933
		3934	/* calculate the quotient sin/cos, or cos/sin if inverted */
		3935	if (invert_result)
		3936	compute_quotient_into(vmg_ new_ext, 0, ext1, ext8);
		3937	else
		3938	compute_quotient_into(vmg_ new_ext, 0, ext8, ext1);
		3939
		3940	/* negate the result if necessary */
		3941	set_neg(new_ext, neg_result);
		3942
		3943	/* normalize the result */
		3944	normalize(new_ext);
		3945	}
		3946	err_finally
		3947	{
		3948	/* release our temporary registers */
		3949	release_temp_regs(vmg_ 9, hdl1, hdl2, hdl3, hdl4,
		3950	hdl5, hdl6, hdl7, hdl8, hdl9);
		3951	}
		3952	err_end;
		3953
		3954	/* remove my self-reference */
		3955	G_stk->discard();
		3956
		3957	/* handled */
		3958	return TRUE;
		3959	}
		3960
		3961	/*
		3962	* property evaluator - convert degrees to radians
		3963	*/
		3964	int CVmObjBigNum::getp_deg2rad(VMG_ vm_obj_id_t self,
		3965	vm_val_t retval, uint argc)
		3966	{
		3967	char *new_ext;
		3968	size_t prec = get_prec(ext_);
		3969	uint hdl1;
		3970	char *ext1;
		3971	const char *pi;
		3972
		3973	/* check arguments and set up the result */
		3974	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		3975	return TRUE;
		3976
		3977	/* cache pi to our required precision */
		3978	pi = cache_pi(vmg_ prec + 2);
		3979
		3980	/*
		3981	* allocate a temporary register for pi/180 - give it some extra
		3982	* precision
		3983	*/
		3984	alloc_temp_regs(vmg_ prec + 2, 1, &ext1, &hdl1);
		3985
		3986	/* get pi to our precision */
		3987	copy_val(ext1, pi, TRUE);
		3988
		3989	/* divide pi by 180 */
		3990	div_by_long(ext1, 180);
		3991
		3992	/* go back to our working precision, rounding if necessary */
		3993	set_prec(ext1, prec);
		3994	if (get_dig(ext1, prec) >= 5)
		3995	round_up_abs(ext1);
		3996
		3997	/* multiply our value by pi/180 */
		3998	compute_prod_into(new_ext, ext_, ext1);
		3999
		4000	/* release our temporary registers */
		4001	release_temp_regs(vmg_ 1, hdl1);
		4002
		4003	/* remove my self-reference */
		4004	G_stk->discard();
		4005
		4006	/* handled */
		4007	return TRUE;
		4008	}
		4009
		4010	/*
		4011	* property evaluator - convert radians to degrees
		4012	*/
		4013	int CVmObjBigNum::getp_rad2deg(VMG_ vm_obj_id_t self,
		4014	vm_val_t retval, uint argc)
		4015	{
		4016	char *new_ext;
		4017	size_t prec = get_prec(ext_);
		4018	uint hdl1;
		4019	char *ext1;
		4020	const char *pi;
		4021
		4022	/* check arguments and set up the result */
		4023	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4024	return TRUE;
		4025
		4026	/* cache pi to our working precision */
		4027	pi = cache_pi(vmg_ prec + 2);
		4028
		4029	/* allocate a temporary register for pi/180 */
		4030	alloc_temp_regs(vmg_ prec + 2, 1, &ext1, &hdl1);
		4031
		4032	/* catch errors so we can be sure to free registers */
		4033	err_try
		4034	{
		4035	/* get pi to our precision */
		4036	copy_val(ext1, pi, TRUE);
		4037
		4038	/* divide pi by 180 */
		4039	div_by_long(ext1, 180);
		4040
		4041	/* go back to our working precision, rounding if necessary */
		4042	set_prec(ext1, prec);
		4043	if (get_dig(ext1, prec) >= 5)
		4044	round_up_abs(ext1);
		4045
		4046	/* divide by pi/180 */
		4047	compute_quotient_into(vmg_ new_ext, 0, ext_, ext1);
		4048	}
		4049	err_finally
		4050	{
		4051	/* release our temporary registers */
		4052	release_temp_regs(vmg_ 1, hdl1);
		4053	}
		4054	err_end;
		4055
		4056	/* remove my self-reference */
		4057	G_stk->discard();
		4058
		4059	/* handled */
		4060	return TRUE;
		4061	}
		4062
		4063	/*
		4064	* property evaluator - arcsine
		4065	*/
		4066	int CVmObjBigNum::getp_asin(VMG_ vm_obj_id_t self,
		4067	vm_val_t retval, uint argc)
		4068	{
		4069	/* calculate and return the arcsine */
		4070	return calc_asincos(vmg_ self, retval, argc, FALSE);
		4071	}
		4072
		4073	/*
		4074	* property evaluator - arccosine
		4075	*/
		4076	int CVmObjBigNum::getp_acos(VMG_ vm_obj_id_t self,
		4077	vm_val_t retval, uint argc)
		4078	{
		4079	/* calculate and return the arcsine */
		4080	return calc_asincos(vmg_ self, retval, argc, TRUE);
		4081	}
		4082
		4083	/*
		4084	* Common property evaluator routine - arcsine and arccosine. arcsin
		4085	* and arccos are related by arccos(x) = pi/2 - arcsin(x). So, to
		4086	* calculate an arccos, we can simply calculate the arcsin, then
		4087	* subtract the result from pi/2.
		4088	*/
		4089	int CVmObjBigNum::calc_asincos(VMG_ vm_obj_id_t self,
		4090	vm_val_t retval, uint argc, int is_acos)
		4091	{
		4092	char *new_ext;
		4093
		4094	/* check arguments and set up the result */
		4095	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4096	return TRUE;
		4097
		4098	/* calculate the arcsin/arccos into the result */
		4099	calc_asincos_into(vmg_ new_ext, ext_, is_acos);
		4100
		4101	/* remove my self-reference */
		4102	G_stk->discard();
		4103
		4104	/* handled */
		4105	return TRUE;
		4106	}
		4107
		4108	/*
		4109	* Calculate the arcsine or arccosine into the given result variable
		4110	*/
		4111	void CVmObjBigNum::calc_asincos_into(VMG_ char dst, const char src,
		4112	int is_acos)
		4113	{
		4114	size_t prec = get_prec(dst);
		4115	uint hdl1, hdl2, hdl3, hdl4, hdl5;
		4116	char ext1, ext2, ext3, ext4, *ext5;
		4117	const char *pi;
		4118
		4119	/* cache pi to our working precision */
		4120	pi = cache_pi(vmg_ prec + 3);
		4121
		4122	/*
		4123	* allocate our temporary registers - use some extra precision over
		4124	* what we need for the result, to reduce the effect of accumulated
		4125	* rounding error
		4126	*/
		4127	alloc_temp_regs(vmg_ prec + 3, 5,
		4128	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		4129	&ext4, &hdl4, &ext5, &hdl5);
		4130
		4131	/* catch errors so we release our temp registers */
		4132	err_try
		4133	{
		4134	char *tmp;
		4135	static const unsigned char one_over_sqrt2[] =
		4136	{
		4137	/* precision = 10, scale = 0, flags = 0 */
		4138	10, 0, 0, 0, 0,
		4139	0x70, 0x71, 0x06, 0x78, 0x14
		4140	};
		4141	int use_sqrt;
		4142	int sqrt_neg;
		4143
		4144	/* get the initial value of x into our accumulator, r1 */
		4145	copy_val(ext1, src, FALSE);
		4146
		4147	/*
		4148	* check to see if the absolute value of the argument is greater
		4149	* than 1 - if it is, it's not valid
		4150	*/
		4151	copy_val(ext2, get_one(), FALSE);
		4152	if (compare_abs(ext1, ext2) > 0)
		4153	err_throw(VMERR_OUT_OF_RANGE);
		4154
		4155	/* presume we won't need to use the sqrt(1-x^2) method */
		4156	use_sqrt = FALSE;
		4157
		4158	/*
		4159	* Check to see if the absolute value of the argument is greater
		4160	* than 1/sqrt(2). If it is, the series expansion converges too
		4161	* slowly (as slowly as never, if the value is exactly 1). To
		4162	* speed things up, in these cases calculate pi/2 -
		4163	* asin(sqrt(1-x^2)) instead, which is equivalent but gives us a
		4164	* smaller asin() argument for quicker series convergence.
		4165	*
		4166	* We don't need to compare to 1/sqrt(2) in great precision;
		4167	* just use a few digits.
		4168	*/
		4169	copy_val(ext2, (const char *)one_over_sqrt2, TRUE);
		4170	if (compare_abs(ext1, ext2) > 0)
		4171	{
		4172	/* flag that we're using the sqrt method */
		4173	use_sqrt = TRUE;
		4174
		4175	/* note the sign - we'll need to apply this to the result */
		4176	sqrt_neg = get_neg(ext1);
		4177
		4178	/* compute x^2 into r2 */
		4179	compute_prod_into(ext2, ext1, ext1);
		4180
		4181	/* subtract r2 from 1 (by adding -r2 to 1), storing in r4 */
		4182	copy_val(ext3, get_one(), FALSE);
		4183	make_negative(ext2);
		4184	compute_sum_into(ext4, ext3, ext2);
		4185
		4186	/* compute sqrt(1-x^2) (which is sqrt(r4)) into r1 */
		4187	compute_sqrt_into(vmg_ ext1, ext4);
		4188	}
		4189
		4190	/* compute the arcsine */
		4191	ext1 = calc_asin_series(ext1, ext2, ext3, ext4, ext5);
		4192
		4193	/* if we're using the sqrt method, finish the sqrt calculation */
		4194	if (use_sqrt)
		4195	{
		4196	/* calculate pi/2 */
		4197	copy_val(ext2, pi, TRUE);
		4198	div_by_long(ext2, 2);
		4199
		4200	/* compute pi/2 - r1 by negating r1 and adding it */
		4201	negate(ext1);
		4202	compute_sum_into(ext3, ext2, ext1);
		4203
		4204	/* negate the result if the original value was negative */
		4205	if (sqrt_neg)
		4206	negate(ext3);
		4207
		4208	/* swap the result back into r1 */
		4209	tmp = ext1;
		4210	ext1 = ext3;
		4211	ext3 = tmp;
		4212	}
		4213
		4214	/*
		4215	* We now have the arcsine in r1. If we actually wanted the
		4216	* arccosine, subtract the arcsine from pi/2 to yield the
		4217	* arccosine.
		4218	*/
		4219	if (is_acos)
		4220	{
		4221	/* get pi/2 into r2 */
		4222	copy_val(ext2, pi, TRUE);
		4223	div_by_long(ext2, 2);
		4224
		4225	/* negate r1 to get -asin */
		4226	negate(ext1);
		4227
		4228	/* add -asin to r2 to yield the arccosine in r3 */
		4229	compute_sum_into(ext3, ext2, ext1);
		4230
		4231	/* swap the result back into ext1 */
		4232	tmp = ext3;
		4233	ext3 = ext1;
		4234	ext1 = tmp;
		4235	}
		4236
		4237	/* store the result, rounding if necessary */
		4238	copy_val(dst, ext1, TRUE);
		4239	}
		4240	err_finally
		4241	{
		4242	/* release our temporary registers */
		4243	release_temp_regs(vmg_ 5, hdl1, hdl2, hdl3, hdl4, hdl5);
		4244	}
		4245	err_end;
		4246	}
		4247
		4248	/*
		4249	* Calculate the asin series expansion. This should only be called with
		4250	* argument values with absolute value less than 1/sqrt(2), because the
		4251	* series converges very slowly for larger values. For operands above
		4252	* 1/sqrt(2), the caller should instead compute the equivalent value
		4253	*
		4254	* +/- (pi/2 - asin(sqrt(1-x^2))).
		4255	*
		4256	* (+ if x > 0, - if x < 0).
		4257	*
		4258	* The argument value is in ext1, and we return a pointer to the
		4259	* register that contains the result (which will be one of the input
		4260	* registers). We use all of the input registers as scratchpads, so
		4261	* their values are not retained.
		4262	*/
		4263	char CVmObjBigNum::calc_asin_series(char ext1, char *ext2,
		4264	char ext3, char ext4, char *ext5)
		4265	{
		4266	ulong n;
		4267
		4268	/* get the current power of x (1) into the x power register, r2 */
		4269	copy_val(ext2, ext1, FALSE);
		4270
		4271	/*
		4272	* compute x^2 into r3 - we'll multiply the previous power by this
		4273	* to get the next power (we need x^1, x^3, x^5, etc)
		4274	*/
		4275	compute_prod_into(ext3, ext1, ext1);
		4276
		4277	/* start at the first term */
		4278	n = 1;
		4279
		4280	/* keep going until we have enough precision in the result */
		4281	for (;;)
		4282	{
		4283	ulong i;
		4284	char *tmp;
		4285
		4286	/* move on to the next term */
		4287	n += 2;
		4288
		4289	/*
		4290	* compute the next weirdness factor into r4:
		4291	*
		4292	* 135...(n-2)
		4293	*. -----------------
		4294	. 246...(n-1)n
		4295	*/
		4296
		4297	/* start out with 1 in r4 */
		4298	copy_val(ext4, get_one(), FALSE);
		4299
		4300	/* multiply by odd numbers up to but not including 'n' */
		4301	for (i = 3 ; i < n ; i += 2)
		4302	mul_by_long(ext4, i);
		4303
		4304	/* divide by even numbers up to and including n-1 */
		4305	for (i = 2 ; i < n ; i += 2)
		4306	div_by_long(ext4, i);
		4307
		4308	/* divide by n */
		4309	div_by_long(ext4, n);
		4310
		4311	/*
		4312	* compute the next power of x - multiply our current power of x
		4313	* (r2) by x^2 (r3)
		4314	*/
		4315	compute_prod_into(ext5, ext2, ext3);
		4316
		4317	/* swap r5 into r2 - this new power of x is now current */
		4318	tmp = ext5;
		4319	ext5 = ext2;
		4320	ext2 = tmp;
		4321
		4322	/*
		4323	* multiply the current x power by the current weirdness factor
		4324	* - this will yield the current term into r5
		4325	*/
		4326	compute_prod_into(ext5, ext2, ext4);
		4327
		4328	/*
		4329	* if this value is too small to show up in our accumulator,
		4330	* we're done
		4331	*/
		4332	if (is_zero(ext5)
		4333	\|\| get_exp(ext1) - get_exp(ext5) > (int)get_prec(ext1))
		4334	break;
		4335
		4336	/*
		4337	* we can trash the weird factor now - use it as a scratch pad
		4338	* for adding the accumulator so far (r1) to this term
		4339	*/
		4340	compute_sum_into(ext4, ext1, ext5);
		4341
		4342	/* swap the result into r1, since it's the new accumulator */
		4343	tmp = ext4;
		4344	ext4 = ext1;
		4345	ext1 = tmp;
		4346	}
		4347
		4348	/* return the accumulator register */
		4349	return ext1;
		4350	}
		4351
		4352	/*
		4353	* property evaluator - arctangent
		4354	*/
		4355	int CVmObjBigNum::getp_atan(VMG_ vm_obj_id_t self,
		4356	vm_val_t retval, uint argc)
		4357	{
		4358	char *new_ext;
		4359	size_t prec = get_prec(ext_);
		4360	uint hdl1, hdl2, hdl3, hdl4, hdl5;
		4361	char ext1, ext2, ext3, ext4, *ext5;
		4362	const char *pi;
		4363
		4364	/* check arguments and set up the result */
		4365	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4366	return TRUE;
		4367
		4368	/* cache pi to our working precision */
		4369	pi = cache_pi(vmg_ prec + 3);
		4370
		4371	/* allocate some temporary registers */
		4372	alloc_temp_regs(vmg_ prec + 3, 5,
		4373	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		4374	&ext4, &hdl4, &ext5, &hdl5);
		4375
		4376	/* catch errors so we can be sure to free registers */
		4377	err_try
		4378	{
		4379	/*
		4380	* If x has absolute value close to 1, either above or below,
		4381	* our two series don't converge very rapidly. Happily, we can
		4382	* fall back on an alternative in these case by using the
		4383	* relation
		4384	*
		4385	* arctan(x) = (+/-)arccos(1/sqrt(x^2+1))
		4386	*
		4387	* (The sign of the result is the same as the sign of x.) Since
		4388	* we already have routines for arccosine and square root, this
		4389	* calculation is easy.
		4390	*
		4391	* If x doesn't have absolute value close to 1, use the
		4392	* appropriate series, since they converge rapidly.
		4393	*/
		4394	if (get_exp(ext_) < -1 \|\| get_exp(ext_) > 2)
		4395	{
		4396	int term_neg;
		4397	ulong n;
		4398
		4399	/*
		4400	* exponent less than -1 -> the number has a small absolute
		4401	* value - use the small-x series expansion:
		4402	*
		4403	* x - x^3/3 + x^5/5 - x^7/7 ...
		4404	*
		4405	* OR
		4406	*
		4407	* exponent greater than 2 -> the number has a large
		4408	* absolute value, so the large-x series expansion should
		4409	* converge quickly:
		4410	*
		4411	* +/- pi/2 - 1/x + 1/3x^3 - 1/5x^5 ...
		4412	*
		4413	* (the sign of the leading pi/2 term is positive if x is
		4414	* positive, negative if x is negative)
		4415	*
		4416	* We can commonize these expressions by defining x' = x for
		4417	* small x and x' = 1/x for large x, defining C as 0 for
		4418	* small x and +/-pi/2 for large X, defining N as +1 for
		4419	* small x and -1 for large x, and rewriting the series as:
		4420	*
		4421	* C + Nx' - Nx'^3/3 + Nx'^5/5 + ...
		4422	*/
		4423
		4424	/* check for large or small value */
		4425	if (get_exp(ext_) < 0)
		4426	{
		4427	/* small number - start with zero in the accumulator (r1) */
		4428	set_zero(ext1);
		4429
		4430	/* get the current power of x' into r2 - this is simply x */
		4431	copy_val(ext2, ext_, FALSE);
		4432
		4433	/* the first term (x) is positive */
		4434	term_neg = FALSE;
		4435	}
		4436	else
		4437	{
		4438	/* large number - start with pi/2 in the accumulator (r1) */
		4439	copy_val(ext1, pi, TRUE);
		4440	div_by_long(ext1, 2);
		4441
		4442	/* if x is negative, make that -pi/2 */
		4443	set_neg(ext1, get_neg(ext_));
		4444
		4445	/* get 1/x into r2 - this is our x' term value */
		4446	compute_quotient_into(vmg_ ext2, 0, get_one(), ext_);
		4447
		4448	/* the first term (1/x) is negative */
		4449	term_neg = TRUE;
		4450	}
		4451
		4452	/* start at the first term */
		4453	n = 1;
		4454
		4455	/*
		4456	* get x'^2 into r3 - we'll use this to calculate each
		4457	* subsequent term (we need x', x'^3, x'^5, etc)
		4458	*/
		4459	compute_prod_into(ext3, ext2, ext2);
		4460
		4461	/* iterate until we reach the desired precision */
		4462	for (;;)
		4463	{
		4464	char *tmp;
		4465
		4466	/* copy the current power term from r2 into r4 */
		4467	copy_val(ext4, ext2, FALSE);
		4468
		4469	/* divide by the current term constant */
		4470	div_by_long(ext4, n);
		4471
		4472	/* negate this term if necessary */
		4473	if (term_neg)
		4474	set_neg(ext4, !get_neg(ext4));
		4475
		4476	/*
		4477	* if we're under the radar on precision, stop looping
		4478	* (don't stop on the first term, since the accumulator
		4479	* hasn't been fully primed yet)
		4480	*/
		4481	if (n != 1
		4482	&& (is_zero(ext4)
		4483	\|\| (get_exp(ext1) - get_exp(ext4)
		4484	> (int)get_prec(ext1))))
		4485	break;
		4486
		4487	/* compute the sum of the accumulator and this term */
		4488	compute_sum_into(ext5, ext1, ext4);
		4489
		4490	/* swap the result back into the accumulator */
		4491	tmp = ext1;
		4492	ext1 = ext5;
		4493	ext5 = tmp;
		4494
		4495	/*
		4496	* move on to the next term - advance n by 2 and swap
		4497	* the term sign
		4498	*/
		4499	n += 2;
		4500	term_neg = !term_neg;
		4501
		4502	/*
		4503	* compute the next power term - multiply r2 (the latest
		4504	* x' power) by r3 (x'^2)
		4505	*/
		4506	compute_prod_into(ext4, ext2, ext3);
		4507
		4508	/* swap r4 back into r2 - this is now the latest power */
		4509	tmp = ext2;
		4510	ext2 = ext4;
		4511	ext4 = tmp;
		4512	}
		4513
		4514	/* store the result, rounding as needed */
		4515	copy_val(new_ext, ext1, TRUE);
		4516	}
		4517	else
		4518	{
		4519	/*
		4520	* We have a value of x from .01 to 10 - in this range, the
		4521	* rewrite using arccosine will give us excellent precision.
		4522	*/
		4523
		4524	/* calculate x^2 into r1 */
		4525	compute_prod_into(ext1, ext_, ext_);
		4526
		4527	/* add one (x^2 has to be positive, so don't worry about sign) */
		4528	increment_abs(ext1);
		4529
		4530	/* take the square root and put the result in r2 */
		4531	compute_sqrt_into(vmg_ ext2, ext1);
		4532
		4533	/* divide that into 1, and put the result back in r1 */
		4534	compute_quotient_into(vmg_ ext1, 0, get_one(), ext2);
		4535
		4536	/*
		4537	* Compute the arccosine of this value - the result is the
		4538	* arctangent, so we can store it directly in the output
		4539	* register.
		4540	*/
		4541	calc_asincos_into(vmg_ new_ext, ext1, TRUE);
		4542
		4543	/* if the input was negative, invert the sign of the result */
		4544	if (get_neg(ext_))
		4545	negate(new_ext);
		4546	}
		4547	}
		4548	err_finally
		4549	{
		4550	/* release our temporary registers */
		4551	release_temp_regs(vmg_ 5, hdl1, hdl2, hdl3, hdl4, hdl5);
		4552	}
		4553	err_end;
		4554
		4555	/* discard the GC protection */
		4556	G_stk->discard();
		4557
		4558	/* handled */
		4559	return TRUE;
		4560	}
		4561
		4562	/*
		4563	* property evaluator - square root
		4564	*/
		4565	int CVmObjBigNum::getp_sqrt(VMG_ vm_obj_id_t self,
		4566	vm_val_t retval, uint argc)
		4567	{
		4568	char *new_ext;
		4569
		4570	/* check arguments and set up the result */
		4571	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4572	return TRUE;
		4573
		4574	/* compute the square root into the result */
		4575	compute_sqrt_into(vmg_ new_ext, ext_);
		4576
		4577	/* discard the GC protection */
		4578	G_stk->discard();
		4579
		4580	/* handled */
		4581	return TRUE;
		4582	}
		4583
		4584	/*
		4585	* property evaluator - natural logarithm
		4586	*/
		4587	int CVmObjBigNum::getp_ln(VMG_ vm_obj_id_t self,
		4588	vm_val_t retval, uint argc)
		4589	{
		4590	char *new_ext;
		4591
		4592	/* zero or negative values are not allowed */
		4593	if (is_zero(ext_) \|\| get_neg(ext_))
		4594	err_throw(VMERR_OUT_OF_RANGE);
		4595
		4596	/* check arguments and set up the result */
		4597	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4598	return TRUE;
		4599
		4600	/* compute the natural logarithm */
		4601	compute_ln_into(vmg_ new_ext, ext_);
		4602
		4603	/* discard the GC protection */
		4604	G_stk->discard();
		4605
		4606	/* handled */
		4607	return TRUE;
		4608	}
		4609
		4610	/*
		4611	* property evaluator - exp (exponentiate e, the base of the natural
		4612	* logarithm, to the power of this number)
		4613	*/
		4614	int CVmObjBigNum::getp_exp(VMG_ vm_obj_id_t self,
		4615	vm_val_t retval, uint argc)
		4616	{
		4617	char *new_ext;
		4618
		4619	/* check arguments and set up the result */
		4620	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4621	return TRUE;
		4622
		4623	/* compute exp(x) */
		4624	compute_exp_into(vmg_ new_ext, ext_);
		4625
		4626	/* discard the GC protection */
		4627	G_stk->discard();
		4628
		4629	/* handled */
		4630	return TRUE;
		4631	}
		4632
		4633	/*
		4634	* property evaluator - log10 (base-10 logarithm)
		4635	*/
		4636	int CVmObjBigNum::getp_log10(VMG_ vm_obj_id_t self,
		4637	vm_val_t retval, uint argc)
		4638	{
		4639	char *new_ext;
		4640	size_t prec = get_prec(ext_);
		4641	uint hdl1, hdl2, hdl3;
		4642	char ext1, ext2, *ext3;
		4643	const char *ln10;
		4644
		4645	/* check arguments and set up the result */
		4646	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4647	return TRUE;
		4648
		4649	/* cache ln(10) to the required precision */
		4650	ln10 = cache_ln10(vmg_ prec + 3);
		4651
		4652	/* allocate some temporary registers */
		4653	alloc_temp_regs(vmg_ prec + 3, 3,
		4654	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3);
		4655
		4656	/* catch errors so we can be sure to free registers */
		4657	err_try
		4658	{
		4659	/* compute the natural logarithm of the number */
		4660	compute_ln_into(vmg_ ext1, ext_);
		4661
		4662	/* get ln(10), properly rounded */
		4663	copy_val(ext2, ln10, TRUE);
		4664
		4665	/* compute ln(x)/ln(10) to yield log10(x) */
		4666	compute_quotient_into(vmg_ ext3, 0, ext1, ext2);
		4667
		4668	/* store the result, rounding as needed */
		4669	copy_val(new_ext, ext3, TRUE);
		4670	}
		4671	err_finally
		4672	{
		4673	/* release our temporary registers */
		4674	release_temp_regs(vmg_ 3, hdl1, hdl2, hdl3);
		4675	}
		4676	err_end;
		4677
		4678	/* discard the GC protection */
		4679	G_stk->discard();
		4680
		4681	/* handled */
		4682	return TRUE;
		4683	}
		4684
		4685	/*
		4686	* property evaluator - pow(y) - calculate x^y
		4687	*/
		4688	int CVmObjBigNum::getp_pow(VMG_ vm_obj_id_t self,
		4689	vm_val_t retval, uint argc)
		4690	{
		4691	vm_val_t val2;
		4692	const char *val2_ext;
		4693	char *new_ext;
		4694	size_t prec;
		4695	uint hdl1, hdl2;
		4696	char ext1, ext2;
		4697
		4698	/* check arguments and allocate the result value */
		4699	if (setup_getp_1(vmg_ self, retval, argc, &new_ext,
		4700	&val2, &val2_ext, FALSE))
		4701	return TRUE;
		4702
		4703	/* use the precision of the result */
		4704	prec = get_prec(new_ext);
		4705
		4706	/*
		4707	* Check for a special case: if the number we're exponentiating is
		4708	* zero, the result is 0 for any positive exponent, and an error for
		4709	* any non-positive exponent (0^0 is undefined, and 0^n where n<0 is
		4710	* equivalent to 1/0^n == 1/0, which is a divide-by-zero error).
		4711	*/
		4712	if (is_zero(ext_))
		4713	{
		4714	/* 0^0 is undefined */
		4715	if (is_zero(val2_ext))
		4716	err_throw(VMERR_OUT_OF_RANGE);
		4717
		4718	/* 0^negative is a divide by zero error */
		4719	if (get_neg(val2_ext))
		4720	err_throw(VMERR_DIVIDE_BY_ZERO);
		4721
		4722	/* set the result to one, and we're done */
		4723	set_zero(new_ext);
		4724	goto done;
		4725	}
		4726
		4727	/* allocate some temporary registers */
		4728	alloc_temp_regs(vmg_ prec + 3, 2,
		4729	&ext1, &hdl1, &ext2, &hdl2);
		4730
		4731	/* catch errors so we can be sure to free registers */
		4732	err_try
		4733	{
		4734	int result_neg;
		4735
		4736	/*
		4737	* If a = e^b, then b = ln(a). This means that x^y = e^ln(x^y)
		4738	* = e^(y * ln(x)). So, we can compute the result in terms of
		4739	* natural logarithm and exponentiation of 'e', for which we
		4740	* have primitives we can call.
		4741	*/
		4742
		4743	/*
		4744	* If x is negative, we can only exponentiate the value to
		4745	* integer powers. In this case, we can substitute x' = -x
		4746	* (hence x' will be positive), and rewrite the expression as
		4747	*
		4748	* (-1)^y * (x')^y
		4749	*
		4750	* We can only calculate (-1)^y for integer values of y, since
		4751	* the result is complex if y is not an integer.
		4752	*/
		4753	if (get_neg(ext_))
		4754	{
		4755	size_t idx;
		4756	int units_dig;
		4757
		4758	/* copy x into r2 */
		4759	copy_val(ext2, ext_, FALSE);
		4760
		4761	/*
		4762	* calculate x' = (-x) - since x is negative, this will
		4763	* guarantee that x' is positive
		4764	*/
		4765	set_neg(ext2, FALSE);
		4766
		4767	/*
		4768	* make sure y is an integer - start at the first digit
		4769	* after the decimal point and check for any non-zero digits
		4770	*/
		4771	idx = (get_exp(val2_ext) < 0 ? 0 : (size_t)get_exp(val2_ext));
		4772	for ( ; idx < get_prec(val2_ext) ; ++idx)
		4773	{
		4774	/* if this digit isn't a zero, it's not an integer */
		4775	if (get_dig(val2_ext, idx) != 0)
		4776	{
		4777	/* y isn't an integer, so we can't calculate (-1)^y */
		4778	err_throw(VMERR_OUT_OF_RANGE);
		4779	}
		4780	}
		4781
		4782	/* get the first digit to the left of the decimal point */
		4783	if (get_exp(val2_ext) <= 0
		4784	\|\| (size_t)get_exp(val2_ext) > get_prec(val2_ext))
		4785	{
		4786	/* the units digit isn't represented - zero is implied */
		4787	units_dig = 0;
		4788	}
		4789	else
		4790	{
		4791	/* get the digit */
		4792	units_dig = get_dig(val2_ext, (size_t)get_exp(val2_ext) - 1);
		4793	}
		4794
		4795	/*
		4796	* if the units digit is even, the result will be positive;
		4797	* if it's odd, the result will be negative
		4798	*/
		4799	result_neg = ((units_dig & 1) != 0);
		4800
		4801	/* calculate ln(x') into r1 */
		4802	compute_ln_into(vmg_ ext1, ext2);
		4803	}
		4804	else
		4805	{
		4806	/* calculate ln(x) into r1 */
		4807	compute_ln_into(vmg_ ext1, ext_);
		4808
		4809	/* the result will be positive */
		4810	result_neg = FALSE;
		4811	}
		4812
		4813	/* calculate y * ln(x) into r2 */
		4814	compute_prod_into(ext2, val2_ext, ext1);
		4815
		4816	/* calculate exp(r2) = exp(yln(x)) = x^y into r1 /
		4817	compute_exp_into(vmg_ ext1, ext2);
		4818
		4819	/* negate the result if we had a negative x and an odd power */
		4820	if (result_neg)
		4821	negate(ext1);
		4822
		4823	/* save the result, rounding as needed */
		4824	copy_val(new_ext, ext1, TRUE);
		4825	}
		4826	err_finally
		4827	{
		4828	/* release our temporary registers */
		4829	release_temp_regs(vmg_ 2, hdl1, hdl2);
		4830	}
		4831	err_end;
		4832
		4833	done:
		4834	/* discard the GC protection */
		4835	G_stk->discard(2);
		4836
		4837	/* handled */
		4838	return TRUE;
		4839	}
		4840
		4841	/*
		4842	* property evaluator - sinh
		4843	*/
		4844	int CVmObjBigNum::getp_sinh(VMG_ vm_obj_id_t self,
		4845	vm_val_t retval, uint argc)
		4846	{
		4847	/* calculate the hyperbolic sine using the common evaluator */
		4848	return calc_sinhcosh(vmg_ self, retval, argc, FALSE, FALSE);
		4849	}
		4850
		4851	/*
		4852	* property evaluator - cosh
		4853	*/
		4854	int CVmObjBigNum::getp_cosh(VMG_ vm_obj_id_t self,
		4855	vm_val_t retval, uint argc)
		4856	{
		4857	/* calculate the hyperbolic cosine using the common evaluator */
		4858	return calc_sinhcosh(vmg_ self, retval, argc, TRUE, FALSE);
		4859	}
		4860
		4861	int CVmObjBigNum::getp_tanh(VMG_ vm_obj_id_t self,
		4862	vm_val_t retval, uint argc)
		4863	{
		4864	/* calculate the hyperbolic tangent using the common evaluator */
		4865	return calc_sinhcosh(vmg_ self, retval, argc, FALSE, TRUE);
		4866	}
		4867
		4868	/*
		4869	* common property evaluator - compute a hyperbolic sine or cosine, or
		4870	* do both to calculate a hyperbolic tangent
		4871	*/
		4872	int CVmObjBigNum::calc_sinhcosh(VMG_ vm_obj_id_t self,
		4873	vm_val_t retval, uint argc,
		4874	int is_cosh, int is_tanh)
		4875	{
		4876	char *new_ext;
		4877
		4878	/* check arguments and allocate the return value */
		4879	if (setup_getp_0(vmg_ self, retval, argc, &new_ext))
		4880	return TRUE;
		4881
		4882	/* calculate the result */
		4883	compute_sinhcosh_into(vmg_ new_ext, ext_, is_cosh, is_tanh);
		4884
		4885	/* discard the GC protection */
		4886	G_stk->discard();
		4887
		4888	/* handled */
		4889	return TRUE;
		4890	}
		4891
		4892	/* ------------------------------------------------------------------------ */
		4893	/*
		4894	* Compute a natural logarithm
		4895	*/
		4896	void CVmObjBigNum::compute_ln_into(VMG_ char dst, const char src)
		4897	{
		4898	uint hdl1, hdl2, hdl3, hdl4, hdl5;
		4899	char ext1, ext2, ext3, ext4, *ext5;
		4900	size_t prec = get_prec(dst);
		4901	const char *ln10;
		4902
		4903	/* cache the value of ln(10) */
		4904	ln10 = cache_ln10(vmg_ prec + 3);
		4905
		4906	/* if the source value is zero, it's an error */
		4907	if (is_zero(src))
		4908	err_throw(VMERR_OUT_OF_RANGE);
		4909
		4910	/* allocate some temporary registers */
		4911	alloc_temp_regs(vmg_ prec + 3, 5,
		4912	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		4913	&ext4, &hdl4, &ext5, &hdl5);
		4914
		4915	/* catch errors so we can be sure to free registers */
		4916	err_try
		4917	{
		4918	int src_exp;
		4919
		4920	/*
		4921	* Observe that we store our values as x = a*10^b. We can thus
		4922	* rewrite ln(x) as ln(a*10^b) = ln(a)+ln(10^b) =
		4923	* log(a)+b*ln(10). a is the mantissa, which due to
		4924	* normalization is in the range 0.1 <= a < 1.0. Thus, a is an
		4925	* ideal argument for the Taylor series. So, we can simply
		4926	* compute ln(mantissa), then add it to ln(10)*exponent.
		4927	*/
		4928
		4929	/* copy our argument into r1 */
		4930	copy_val(ext1, src, FALSE);
		4931
		4932	/*
		4933	* remember the original exponent, and set the exponent of the
		4934	* series argument to zero - we'll correct for this later by
		4935	* adding the log of the exponent to the series result
		4936	*/
		4937	src_exp = get_exp(ext1);
		4938	set_exp(ext1, 0);
		4939
		4940	/*
		4941	* if the lead digit of the mantissa is 1, multiply the number
		4942	* by ten and adjust the exponent accordingly - the series is
		4943	* especially good at values near 1
		4944	*/
		4945	if (get_dig(ext1, 0) == 1)
		4946	{
		4947	set_exp(ext1, 1);
		4948	--src_exp;
		4949	}
		4950
		4951	/* compute the series expansion */
		4952	ext1 = compute_ln_series_into(vmg_ ext1, ext2, ext3, ext4, ext5);
		4953
		4954	/* add in the input exponent, properly adjusted */
		4955	if (src_exp != 0)
		4956	{
		4957	/* get ln10 into r2 */
		4958	copy_val(ext2, ln10, TRUE);
		4959
		4960	/* apply the exponent's sign if it's negative */
		4961	if (src_exp < 0)
		4962	{
		4963	set_neg(ext2, TRUE);
		4964	src_exp = -src_exp;
		4965	}
		4966
		4967	/* multiply by the exponent */
		4968	mul_by_long(ext2, src_exp);
		4969
		4970	/* add this value to the series expansion value */
		4971	compute_sum_into(ext3, ext1, ext2);
		4972
		4973	/* use this as the result */
		4974	ext1 = ext3;
		4975	}
		4976
		4977	/* copy the result, rounding if needed */
		4978	copy_val(dst, ext1, TRUE);
		4979	}
		4980	err_finally
		4981	{
		4982	/* release our temporary registers */
		4983	release_temp_regs(vmg_ 5, hdl1, hdl2, hdl3, hdl4, hdl5);
		4984	}
		4985	err_end;
		4986	}
		4987
		4988	/*
		4989	* Compute the natural log series. The argument value, initially in
		4990	* ext1, should be adjusted to a small value before this is called to
		4991	* ensure quick series convergence.
		4992	*/
		4993	char CVmObjBigNum::compute_ln_series_into(VMG_ char ext1, char *ext2,
		4994	char ext3, char ext4,
		4995	char *ext5)
		4996	{
		4997	ulong n;
		4998	char *tmp;
		4999
		5000	/* start at the first term of the series */
		5001	n = 1;
		5002
		5003	/* subtract one from r1 to yield (x-1) in r2 */
		5004	compute_abs_diff_into(ext2, ext1, get_one());
		5005
		5006	/* add one to r1 to yield (x+1) */
		5007	increment_abs(ext1);
		5008
		5009	/* compute (x-1)/(x+1) into r3 - this will be our current power */
		5010	compute_quotient_into(vmg_ ext3, 0, ext2, ext1);
		5011
		5012	/*
		5013	* compute ((x-1)/(x+1))^2 into r4 - we'll multiply r3 by this on
		5014	* each iteration to produce the next required power, since we only
		5015	* need the odd powers
		5016	*/
		5017	compute_prod_into(ext4, ext3, ext3);
		5018
		5019	/* start out with the first power in our accumulator (r1) */
		5020	copy_val(ext1, ext3, FALSE);
		5021
		5022	/* iterate until we have a good enough answer */
		5023	for (;;)
		5024	{
		5025	/* compute the next power into r2 */
		5026	compute_prod_into(ext2, ext3, ext4);
		5027
		5028	/* copy the result into our current power register, r3 */
		5029	copy_val(ext3, ext2, FALSE);
		5030
		5031	/* advance n */
		5032	n += 2;
		5033
		5034	/* divide the power by n */
		5035	div_by_long(ext2, n);
		5036
		5037	/* if it's too small to notice, we're done */
		5038	if (is_zero(ext2)
		5039	\|\| get_exp(ext1) - get_exp(ext2) > (int)get_prec(ext1))
		5040	break;
		5041
		5042	/* compute the sum with our accumulator into r5 */
		5043	compute_sum_into(ext5, ext1, ext2);
		5044
		5045	/* swap r5 and r1 - the new sum is our new accumulator */
		5046	tmp = ext5;
		5047	ext5 = ext1;
		5048	ext1 = tmp;
		5049	}
		5050
		5051	/* multiply the result of the series by 2 */
		5052	mul_by_long(ext1, 2);
		5053
		5054	/* return the register containing the result */
		5055	return ext1;
		5056	}
		5057
		5058	/*
		5059	* Compute e^x, where e is the base of the natural logarithm (2.818...)
		5060	*/
		5061	void CVmObjBigNum::compute_exp_into(VMG_ char dst, const char src)
		5062	{
		5063	uint hdl1, hdl2, hdl3, hdl4, hdl5, hdl6;
		5064	char ext1, ext2, ext3, ext4, ext5, ext6;
		5065	size_t prec = get_prec(dst);
		5066	const char *ln10;
		5067
		5068	/* get the constant value of ln10 to the required precision */
		5069	ln10 = cache_ln10(vmg_ prec + 3);
		5070
		5071	/* allocate some temporary registers */
		5072	alloc_temp_regs(vmg_ prec + 3, 6,
		5073	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		5074	&ext4, &hdl4, &ext5, &hdl5, &ext6, &hdl6);
		5075
		5076	/* catch errors so we can be sure to free registers */
		5077	err_try
		5078	{
		5079	char *tmp;
		5080	ulong n;
		5081	ulong n_fact;
		5082	int use_int_fact;
		5083	long new_exp;
		5084	size_t idx;
		5085	size_t decpt_idx;
		5086	int twos;
		5087
		5088	/*
		5089	* We want to calculate e^x. Observe that a^x = e^(x*ln(x)), so
		5090	* 10^x = e^(x*ln(10)). We can rewrite our desired expression
		5091	* e^x as
		5092	*
		5093	* e^[(x/ln(10)) * ln(10)]
		5094	*
		5095	* which is thus
		5096	*
		5097	* 10^(x / ln(10))
		5098	*
		5099	* We store our numbers as a mantissa times 10 raised to an
		5100	* integer exponent. Clearly the exponent of 10 in the formula
		5101	* above is not always an integer (in fact, it's extremely rare
		5102	* that it would be an integer), so we still have more work to
		5103	* do. What we must do is obtain an integer exponent. So, let
		5104	* us define y = x/ln(10); we can now rewrite the above as
		5105	*
		5106	* 10^(int(y) + frac(y))
		5107	*
		5108	* where int(y) is the integer portion of y and frac(y) is the
		5109	* fractional portion (y - int(y)). We can rewrite the above as
		5110	*
		5111	* 10^frac(y) * 10^int(y)
		5112	*
		5113	* which we can further rewrite as
		5114	*
		5115	* e^(frac(y)ln(10)) 10^int(y)
		5116	*
		5117	* We haven't made the problem of finding an exponential
		5118	* disappear, but we've reduced the argument to a very
		5119	* manageable range, which is important because it makes the
		5120	* Taylor series converge quickly. Furthermore, it's extremely
		5121	* inexpensive to separate out the problem like this, since it
		5122	* falls quite naturally out of the representation we use, so it
		5123	* doesn't add much overhead to do this preparation work.
		5124	*/
		5125
		5126	/* first, calculate x/ln(10) into r1 */
		5127	compute_quotient_into(vmg_ ext1, 0, src, ln10);
		5128
		5129	/*
		5130	* compute the integer portion of x/ln(10) - it has to fit in a
		5131	* 16-bit integer, (-32768 to +32767), because this is going to
		5132	* be the exponent of the result (or roughly so, anyway)
		5133	*/
		5134	decpt_idx = get_exp(ext1) >= 0 ? (size_t)get_exp(ext1) : 0;
		5135	for (new_exp = 0, idx = 0 ; idx < decpt_idx ; ++idx)
		5136	{
		5137	int dig;
		5138
		5139	/*
		5140	* get this digit if it's represented; if not, it's an
		5141	* implied trailing zero
		5142	*/
		5143	dig = (idx < get_prec(ext1) ? get_dig(ext1, idx) : 0);
		5144
		5145	/* add this digit into the accumulator */
		5146	new_exp *= 10;
		5147	new_exp += dig;
		5148
		5149	/*
		5150	* Make sure we're still in range. Note that, because our
		5151	* representation is 0.dddd*10^x, we need one more factor of
		5152	* ten than you'd think here, the adjust of the range from
		5153	* the expected -32768..32767
		5154	*/
		5155	if (new_exp > (get_neg(ext1) ? 32769L : 32766L))
		5156	err_throw(VMERR_NUM_OVERFLOW);
		5157
		5158	/*
		5159	* zero out this digit, so that when we're done r1 has the
		5160	* fractional part only
		5161	*/
		5162	if (idx < get_prec(ext1))
		5163	set_dig(ext1, idx, 0);
		5164	}
		5165
		5166	/* negate the exponent value if the source value is negative */
		5167	if (get_neg(ext1))
		5168	new_exp = -new_exp;
		5169
		5170	/* normalize the fractional part, which remains in ext1 */
		5171	normalize(ext1);
		5172
		5173	/*
		5174	* Multiply it by ln10, storing the result in r3. This is the
		5175	* value we will use with the Taylor series.
		5176	*/
		5177	compute_prod_into(ext3, ext1, ln10);
		5178
		5179	/*
		5180	* While our input value is greater than 0.5, divide it by two
		5181	* to make it smaller than 0.5. This will speed up the series
		5182	* convergence. When we're done, we'll correct for the
		5183	* divisions my squaring the result: e^2x = (e^x)^2
		5184	*/
		5185	copy_val(ext1, get_one(), FALSE);
		5186	div_by_long(ext1, 2);
		5187	for (twos = 0 ; compare_abs(ext3, ext1) > 0 ; ++twos)
		5188	div_by_long(ext3, 2);
		5189
		5190	/* start with 1 in our accumulator (r1) */
		5191	copy_val(ext1, get_one(), FALSE);
		5192
		5193	/* copy our series argument into the current-power register (r2) */
		5194	copy_val(ext2, ext3, FALSE);
		5195
		5196	/* start with 1 in our factorial register (r4) */
		5197	copy_val(ext4, get_one(), FALSE);
		5198
		5199	/* start at the first term */
		5200	n = 1;
		5201	n_fact = 1;
		5202	use_int_fact = TRUE;
		5203
		5204	/* go until we reach the required precision */
		5205	for (;;)
		5206	{
		5207	/* for efficiency, try integer division */
		5208	if (use_int_fact)
		5209	{
		5210	/*
		5211	* we can still fit the factorial in an integer - divide
		5212	* by the integer value of n!, since it's a lot faster
		5213	*/
		5214	copy_val(ext5, ext2, FALSE);
		5215	div_by_long(ext5, n_fact);
		5216
		5217	/* calculate the next n! integer, if it'll fit in a long */
		5218	if (n_fact > LONG_MAX/(n+1))
		5219	{
		5220	/*
		5221	* it'll be too big next time - we'll have to start
		5222	* using the full quotient calculation
		5223	*/
		5224	use_int_fact = FALSE;
		5225	}
		5226	else
		5227	{
		5228	/* it'll still fit - calculate the next n! */
		5229	n_fact *= (n+1);
		5230	}
		5231	}
		5232	else
		5233	{
		5234	/* compute x^n/n! (r2/r4) into r5 */
		5235	compute_quotient_into(vmg_ ext5, 0, ext2, ext4);
		5236	}
		5237
		5238	/* if we're below the required precision, we're done */
		5239	if (is_zero(ext5)
		5240	\|\| get_exp(ext1) - get_exp(ext5) > (int)get_prec(ext1))
		5241	break;
		5242
		5243	/* compute the sum of the accumulator and this term into r6 */
		5244	compute_sum_into(ext6, ext1, ext5);
		5245
		5246	/* swap the result into the accumulator */
		5247	tmp = ext1;
		5248	ext1 = ext6;
		5249	ext6 = tmp;
		5250
		5251	/* on to the next term */
		5252	++n;
		5253
		5254	/* compute the next factorial value */
		5255	mul_by_long(ext4, n);
		5256
		5257	/* compute the next power of x' into r5 */
		5258	compute_prod_into(ext5, ext2, ext3);
		5259
		5260	/* swap the result into our current-power register (r2) */
		5261	tmp = ext2;
		5262	ext2 = ext5;
		5263	ext5 = tmp;
		5264	}
		5265
		5266	/* square the result as many times as we halved the argument */
		5267	for ( ; twos != 0 ; --twos)
		5268	{
		5269	/* compute the square of r1 into r2 */
		5270	compute_prod_into(ext2, ext1, ext1);
		5271
		5272	/* swap the result back into r1 */
		5273	tmp = ext1;
		5274	ext1 = ext2;
		5275	ext2 = tmp;
		5276	}
		5277
		5278	/*
		5279	* set up our 10's exponent value - this is simply 1*10^new_exp,
		5280	* which we calculated earlier (which we represent as
		5281	* 0.1*10^(new_exp+1)
		5282	*/
		5283	copy_val(ext2, get_one(), FALSE);
		5284	set_exp(ext2, (int)(new_exp + 1));
		5285
		5286	/* multiply by the 10's exponent value */
		5287	compute_prod_into(ext3, ext1, ext2);
		5288
		5289	/* copy the result into the output register, rounding as needed */
		5290	copy_val(dst, ext3, TRUE);
		5291	}
		5292	err_finally
		5293	{
		5294	/* release our temporary registers */
		5295	release_temp_regs(vmg_ 6, hdl1, hdl2, hdl3, hdl4, hdl5, hdl6);
		5296	}
		5297	err_end;
		5298	}
		5299
		5300	/* ------------------------------------------------------------------------ */
		5301	/*
		5302	* Compute a hyperbolic sine or cosine
		5303	*/
		5304	void CVmObjBigNum::compute_sinhcosh_into(VMG_ char dst, const char src,
		5305	int is_cosh, int is_tanh)
		5306	{
		5307	size_t prec = get_prec(dst);
		5308	uint hdl1, hdl2, hdl3, hdl4;
		5309	char ext1, ext2, ext3, ext4;
		5310
		5311	/* allocate some temporary registers */
		5312	alloc_temp_regs(vmg_ prec + 3, 4,
		5313	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		5314	&ext4, &hdl4);
		5315
		5316	/* catch errors so we can be sure to free registers */
		5317	err_try
		5318	{
		5319	/*
		5320	* sinh(x) = (e^x - e^(-x))/2
		5321	*
		5322	* cosh(x) = (e^x + e^(-x))/2
		5323	*
		5324	* The two differ only in the sign of the e^(-x) term, so most
		5325	* of the calculation is the same for both.
		5326	*/
		5327
		5328	/* compute e^x into r1 */
		5329	compute_exp_into(vmg_ ext1, src);
		5330
		5331	/*
		5332	* rather than calculating e^-x separately, simply invert our
		5333	* e^x value to yield e^-x (a simple division is much quicker
		5334	* than calculating another exponent, which involves an entire
		5335	* taylor series expansion)
		5336	*/
		5337	copy_val(ext3, get_one(), FALSE);
		5338	compute_quotient_into(vmg_ ext2, 0, ext3, ext1);
		5339
		5340	/*
		5341	* if we're calculating the tanh, we'll want both the sinh and
		5342	* cosh values
		5343	*/
		5344	if (is_tanh)
		5345	{
		5346	/* add the terms to get the cosh */
		5347	compute_sum_into(ext4, ext1, ext2);
		5348
		5349	/* subtract ext2 to get the sinh */
		5350	negate(ext2);
		5351	compute_sum_into(ext3, ext1, ext2);
		5352
		5353	/* tanh is the quotient of sinh/cosh */
		5354	compute_quotient_into(vmg_ ext1, 0, ext3, ext4);
		5355
		5356	/* our result is in ext1 - set ext3 to point there */
		5357	ext3 = ext1;
		5358	}
		5359	else
		5360	{
		5361	/*
		5362	* if this is sinh, the e^-x term is subtracted; if it's
		5363	* cosh, it's added
		5364	*/
		5365	if (!is_cosh)
		5366	negate(ext2);
		5367
		5368	/* compute r1 + r2 into r3 (e^x +/- e^(-x)) */
		5369	compute_sum_into(ext3, ext1, ext2);
		5370
		5371	/* halve the result */
		5372	div_by_long(ext3, 2);
		5373	}
		5374
		5375	/* store the result */
		5376	copy_val(dst, ext3, TRUE);
		5377	}
		5378	err_finally
		5379	{
		5380	/* release our temporary registers */
		5381	release_temp_regs(vmg_ 4, hdl1, hdl2, hdl3, hdl4);
		5382	}
		5383	err_end;
		5384	}
		5385
		5386	/* ------------------------------------------------------------------------ */
		5387	/*
		5388	* Cache the natural logarithm of 10 to the given precision and return
		5389	* the value
		5390	*/
		5391	const char *CVmObjBigNum::cache_ln10(VMG_ size_t prec)
		5392	{
		5393	char *ext;
		5394	int expanded;
		5395	uint hdl1, hdl2, hdl3, hdl4, hdl5;
		5396	char ext1, ext2, ext3, ext4, *ext5;
		5397	static const unsigned char ten[] =
		5398	{
		5399	/* number of digits */
		5400	0x01, 0x00,
		5401
		5402	/* exponent (0.1 * 10^2 = 10) */
		5403	0x02, 0x00,
		5404
		5405	/* flags */
		5406	0x00,
		5407
		5408	/* mantissa */
		5409	0x10
		5410	};
		5411
		5412	/*
		5413	* round up the precision a bit to ensure that we don't have to
		5414	* repeatedly recalculate this value if we're asked for a cluster of
		5415	* similar precisions
		5416	*/
		5417	prec = (prec + 7) & ~7;
		5418
		5419	/* get the ln10 cache register */
		5420	ext = G_bignum_cache->get_ln10_reg(calc_alloc(prec), &expanded);
		5421
		5422	/* if that failed, throw an error */
		5423	if (ext == 0)
		5424	err_throw(VMERR_OUT_OF_MEMORY);
		5425
		5426	/*
		5427	* if we didn't have to allocate more memory, and the value in the
		5428	* register has at least the required precision, return the cached
		5429	* value
		5430	*/
		5431	if (!expanded && get_prec(ext) >= prec)
		5432	return ext;
		5433
		5434	/*
		5435	* we have reallocated the register, or we just didn't have enough
		5436	* precision in the old value - set the new precision
		5437	*/
		5438	set_prec(ext, prec);
		5439
		5440	/* allocate some temporary registers */
		5441	alloc_temp_regs(vmg_ prec + 3, 5,
		5442	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		5443	&ext4, &hdl4, &ext5, &hdl5);
		5444
		5445	/* catch errors so we can be sure to free registers */
		5446	err_try
		5447	{
		5448	/*
		5449	* Compute sqrt(10) - 10 is too large for the series to
		5450	* converge, but sqrt(10) is good. We'll correct for this later
		5451	* by doubling the result of the series expansion, which gives
		5452	* us the correct result: ln(a^b) = b*ln(a), and sqrt(x) =
		5453	* x^(1/2), hence ln(sqrt(x)) = ln(x)/2, which means that ln(x)
		5454	* = 2*ln(sqrt(x)).
		5455	*/
		5456
		5457	/* compute sqrt(10), for quick series convergence */
		5458	copy_val(ext2, (const char *)ten, FALSE);
		5459	compute_sqrt_into(vmg_ ext1, ext2);
		5460
		5461	/* compute the series expansion */
		5462	ext1 = compute_ln_series_into(vmg_ ext1, ext2, ext3, ext4, ext5);
		5463
		5464	/* double the result (to adjust for the sqrt) */
		5465	mul_by_long(ext1, 2);
		5466
		5467	/* store the result in the cache */
		5468	copy_val(ext, ext1, TRUE);
		5469	}
		5470	err_finally
		5471	{
		5472	/* release our temporary registers */
		5473	release_temp_regs(vmg_ 5, hdl1, hdl2, hdl3, hdl4, hdl5);
		5474	}
		5475	err_end;
		5476
		5477	/* return the register pointer */
		5478	return ext;
		5479	}
		5480
		5481	/* ------------------------------------------------------------------------ */
		5482	/*
		5483	* Cache pi to the required precision
		5484	*/
		5485	const char *CVmObjBigNum::cache_pi(VMG_ size_t prec)
		5486	{
		5487	char *ext;
		5488	int expanded;
		5489	uint hdl1, hdl2, hdl3, hdl4, hdl5;
		5490	char ext1, ext2, ext3, ext4, *ext5;
		5491
		5492	/*
		5493	* round up the precision a bit to ensure that we don't have to
		5494	* repeatedly recalculate this value if we're asked for a cluster of
		5495	* similar precisions
		5496	*/
		5497	prec = (prec + 7) & ~7;
		5498
		5499	/* get the pi cache register */
		5500	ext = G_bignum_cache->get_pi_reg(calc_alloc(prec), &expanded);
		5501
		5502	/* if that failed, throw an error */
		5503	if (ext == 0)
		5504	err_throw(VMERR_OUT_OF_MEMORY);
		5505
		5506	/*
		5507	* if we didn't have to allocate more memory, and the value in the
		5508	* register has at least the required precision, return the cached
		5509	* value
		5510	*/
		5511	if (!expanded && get_prec(ext) >= prec)
		5512	return ext;
		5513
		5514	/*
		5515	* we have reallocated the register, or we just didn't have enough
		5516	* precision in the old value - set the new precision
		5517	*/
		5518	set_prec(ext, prec);
		5519
		5520	/* allocate some temporary registers */
		5521	alloc_temp_regs(vmg_ prec + 3, 5,
		5522	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		5523	&ext4, &hdl4, &ext5, &hdl5);
		5524
		5525	/* catch errors so we can be sure to free registers */
		5526	err_try
		5527	{
		5528	/*
		5529	* Compute the arctangent of 1. To do this, rewrite arctan(x) =
		5530	* arccos(1/sqrt(1+x^2)), so x=1 gives us arccos(1/sqrt(2)).
		5531	*
		5532	* Now, arccos(x) = pi/2 - arcsin(x), but this would defeat the
		5533	* purpose since we want to calculate pi, thus we don't want to
		5534	* depend upon pi in our calculations. Fortunately, arcsin(x) =
		5535	* pi/2 - arcsin(sqrt(1-x^2)), hence
		5536	*
		5537	* pi/2 - arcsin(x) = pi/2 - (pi/2 - arcsin(sqrt(1-x^2)))
		5538	*. = arcsin(sqrt(1-x^2))
		5539	*
		5540	* So, we can rewrite arccos(1/sqrt(2)) as arcsin(sqrt(1/2)).
		5541	*/
		5542
		5543	/* compute 1/2 into r2 */
		5544	copy_val(ext2, get_one(), FALSE);
		5545	div_by_long(ext2, 2);
		5546
		5547	/* compute sqrt(1/2) into r1 */
		5548	compute_sqrt_into(vmg_ ext1, ext2);
		5549
		5550	/* calculate the arcsin series for sqrt(1/2) */
		5551	ext1 = calc_asin_series(ext1, ext2, ext3, ext4, ext5);
		5552
		5553	/* multiply the result by 4 */
		5554	mul_by_long(ext1, 4);
		5555
		5556	/* store the result in the cache */
		5557	copy_val(ext, ext1, TRUE);
		5558	}
		5559	err_finally
		5560	{
		5561	/* release our temporary registers */
		5562	release_temp_regs(vmg_ 5, hdl1, hdl2, hdl3, hdl4, hdl5);
		5563	}
		5564	err_end;
		5565
		5566	/* return the register pointer */
		5567	return ext;
		5568	}
		5569
		5570	/* ------------------------------------------------------------------------ */
		5571	/*
		5572	* Cache e to the required precision
		5573	*/
		5574	const char *CVmObjBigNum::cache_e(VMG_ size_t prec)
		5575	{
		5576	char *ext;
		5577	int expanded;
		5578
		5579	/*
		5580	* round up the precision a bit to ensure that we don't have to
		5581	* repeatedly recalculate this value if we're asked for a cluster of
		5582	* similar precisions
		5583	*/
		5584	prec = (prec + 7) & ~7;
		5585
		5586	/* get the e cache register */
		5587	ext = G_bignum_cache->get_e_reg(calc_alloc(prec), &expanded);
		5588
		5589	/* if that failed, throw an error */
		5590	if (ext == 0)
		5591	err_throw(VMERR_OUT_OF_MEMORY);
		5592
		5593	/*
		5594	* if we didn't have to allocate more memory, and the value in the
		5595	* register has at least the required precision, return the cached
		5596	* value
		5597	*/
		5598	if (!expanded && get_prec(ext) >= prec)
		5599	return ext;
		5600
		5601	/*
		5602	* we have reallocated the register, or we just didn't have enough
		5603	* precision in the old value - set the new precision
		5604	*/
		5605	set_prec(ext, prec);
		5606
		5607	/* exponentiate the base of the natural logarithm to the power 1 */
		5608	compute_exp_into(vmg_ ext, get_one());
		5609
		5610	/* return the register pointer */
		5611	return ext;
		5612	}
		5613
		5614	/* ------------------------------------------------------------------------ */
		5615	/*
		5616	* Compute a square root. We use Newton's method (a reliable old method
		5617	* for extracting square roots, made better by the fact that, unlike the
		5618	* method's inventor, we are fortunate to have an electronic computer to
		5619	* carry out the tedious parts of the calculation for us).
		5620	*/
		5621	void CVmObjBigNum::compute_sqrt_into(VMG_ char dst, const char src)
		5622	{
		5623	uint hdl1, hdl2, hdl3, hdl4;
		5624	char ext1, ext2, ext3, ext4;
		5625	size_t dst_prec = get_prec(dst);
		5626
		5627	/* if the value is negative, it's an error */
		5628	if (get_neg(src))
		5629	err_throw(VMERR_OUT_OF_RANGE);
		5630
		5631	/* allocate our scratchpad registers */
		5632	alloc_temp_regs(vmg_ get_prec(dst) + 3, 4,
		5633	&ext1, &hdl1, &ext2, &hdl2, &ext3, &hdl3,
		5634	&ext4, &hdl4);
		5635
		5636	/* catch errors so we can free our registers */
		5637	err_try
		5638	{
		5639	/*
		5640	* Compute our initial guess. Since our number is represented as
		5641	*
		5642	* (n * 10^exp),
		5643	*
		5644	* the square root can be written as
		5645	*
		5646	* sqrt(n) * sqrt(10^exp) = sqrt(n) * 10^(exp/2)
		5647	*
		5648	* Approximate sqrt(n) as simply n for our initial guess. This
		5649	* will get us to the right order of magnitude plus or minus
		5650	* one, so we should converge pretty quickly.
		5651	*
		5652	* If we have an odd exponent, round up and divide the mantissa
		5653	* by 2 - this will be something like 0.456e7, which can be
		5654	* written as 4.56e6, whose square root is about 2e3, or .2e4.
		5655	*
		5656	* If we have an even exponent, multiply the mantissa by 2.
		5657	* This will be something like .456e8, whose square root is
		5658	* about .67e4.
		5659	*
		5660	* Note that it's well worth the trouble to make a good initial
		5661	* approximation, even with the multiply/divide, because these
		5662	* operations with longs are much more efficient than the full
		5663	* divide we will have to do on each iteration.
		5664	*/
		5665	copy_val(ext1, src, TRUE);
		5666	if ((get_exp(ext1) & 1) != 0)
		5667	{
		5668	/* odd exponent - round up and divide the mantissa by two */
		5669	set_exp(ext1, (get_exp(ext1) + 1)/2);
		5670	div_by_long(ext1, 2);
		5671	}
		5672	else
		5673	{
		5674	/* even exponent - multiply mantissa by two */
		5675	set_exp(ext1, get_exp(ext1)/2);
		5676	mul_by_long(ext1, 2);
		5677	}
		5678
		5679	/* iterate until we get close enough to the solution */
		5680	for (;;)
		5681	{
		5682	char *tmp;
		5683	size_t idx;
		5684
		5685	/*
		5686	* Calculate the next iteration's approximation, noting that r1
		5687	* contains the current iteration's value p:
		5688	*
		5689	* p' = p/2 + src/2p = (p + src/p)/2
		5690	*
		5691	* Note that if p == 0, we can't compute src/p, so we can't
		5692	* iterate any further.
		5693	*/
		5694	if (is_zero(ext1))
		5695	break;
		5696
		5697	/* calculate src/p into r3 */
		5698	compute_quotient_into(vmg_ ext3, 0, src, ext1);
		5699
		5700	/* compute p + src/p into r4 */
		5701	compute_sum_into(ext4, ext1, ext3);
		5702
		5703	/* compute (p + src/p)/2 into r4 */
		5704	div_by_long(ext4, 2);
		5705
		5706	/*
		5707	* check for convergence - if the new value equals the old
		5708	* value to the precision requested for the result, we are
		5709	* at the limit of our ability to distinguish differences in
		5710	* future terms, so we can stop
		5711	*/
		5712	if (get_neg(ext1) == get_neg(ext4)
		5713	&& get_exp(ext1) == get_exp(ext4))
		5714	{
		5715	/*
		5716	* they're the same sign and magnitude - compare the
		5717	* digits to see where they first differ
		5718	*/
		5719	for (idx = 0 ; idx < dst_prec + 1 ; ++idx)
		5720	{
		5721	/* if they differ here, stop scanning */
		5722	if (get_dig(ext1, idx) != get_dig(ext4, idx))
		5723	break;
		5724	}
		5725
		5726	/*
		5727	* if we didn't find any difference up to the output
		5728	* precision plus one digit (for rounding), further
		5729	* iteration will be of no value
		5730	*/
		5731	if (idx >= dst_prec + 1)
		5732	break;
		5733	}
		5734
		5735	/* swap the new value into r1 for the next round */
		5736	tmp = ext1;
		5737	ext1 = ext4;
		5738	ext4 = tmp;
		5739	}
		5740
		5741	/*
		5742	* copy the last iteration's value into the destination,
		5743	* rounding as needed
		5744	*/
		5745	copy_val(dst, ext1, TRUE);
		5746	}
		5747	err_finally
		5748	{
		5749	/* release our temporary registers */
		5750	release_temp_regs(vmg_ 4, hdl1, hdl2, hdl3, hdl4);
		5751	}
		5752	err_end;
		5753	}
		5754
		5755	/* ------------------------------------------------------------------------ */
		5756	/*
		5757	* Calculate a Taylor expansion for sin(). The argument is in ext1, and
		5758	* we'll store the result in new_ext. ext1 through ext7 are temporary
		5759	* registers that we'll overwrite with intermediate values.
		5760	*
		5761	* Before calling this function, the caller should reduce the value in
		5762	* ext1 to the range -pi/4 <= ext1 <= pi/4 to ensure quick convergence
		5763	* of the series.
		5764	*/
		5765	void CVmObjBigNum::calc_sin_series(VMG_ char new_ext, char ext1,
		5766	char ext2, char ext3, char *ext4,
		5767	char ext5, char ext6, char *ext7)
		5768	{
		5769	ulong n;
		5770	int neg_term;
		5771	char *tmp;
		5772
		5773	/* start with 1! (i.e., 1) in r3 */
		5774	copy_val(ext3, get_one(), FALSE);
		5775
		5776	/*
		5777	* calculate x^2 into r7 - we need x, x^3, x^5, etc, so we can just
		5778	* multiply the last value by x^2 to get the next power we need
		5779	*/
		5780	compute_prod_into(ext7, ext1, ext1);
		5781
		5782	/* start with x (reduced mod 2pi) in r5 (our accumulator) */
		5783	copy_val(ext5, ext1, FALSE);
		5784
		5785	/* start at term n=1 in our expansion */
		5786	n = 1;
		5787
		5788	/* the first term is positive */
		5789	neg_term = FALSE;
		5790
		5791	/* go until we have a precise enough value */
		5792	for (;;)
		5793	{
		5794	/*
		5795	* move on to the next term: multiply r1 by x^2 into r2 to yield
		5796	* the next power of x that we require
		5797	*/
		5798	compute_prod_into(ext2, ext1, ext7);
		5799
		5800	/* swap r1 and r2 - r2 has the next power we need now */
		5801	tmp = ext1;
		5802	ext1 = ext2;
		5803	ext2 = tmp;
		5804
		5805	/*
		5806	* multiply r3 by (n+1)*(n+2) - it currently has n!, so this
		5807	* will yield (n+2)!
		5808	*/
		5809	mul_by_long(ext3, (n+1)*(n+2));
		5810
		5811	/* advance n to the next term */
		5812	n += 2;
		5813
		5814	/* each term swaps signs */
		5815	neg_term = !neg_term;
		5816
		5817	/* divide r1 by r3 to yield the next term in our series in r4 */
		5818	compute_quotient_into(vmg_ ext4, 0, ext1, ext3);
		5819
		5820	/*
		5821	* if this value is too small to count in our accumulator, we're
		5822	* done
		5823	*/
		5824	if (is_zero(ext4)
		5825	\|\| get_exp(ext5) - get_exp(ext4) > (int)get_prec(ext4))
		5826	break;
		5827
		5828	/*
		5829	* invert the sign of the term in r4 if this is a negative term
		5830	*/
		5831	if (neg_term)
		5832	set_neg(ext4, !get_neg(ext4));
		5833
		5834	/* add r4 to our running accumulator in r5, yielding r6 */
		5835	compute_sum_into(ext6, ext5, ext4);
		5836
		5837	/* swap r5 and r6 to put the accumulated value back into r5 */
		5838	tmp = ext5;
		5839	ext5 = ext6;
		5840	ext6 = tmp;
		5841	}
		5842
		5843	/* we're done - store the result, rounding if necessary */
		5844	copy_val(new_ext, ext5, TRUE);
		5845	}
		5846
		5847	/*
		5848	* Calculate a Taylor expansion for cos(). The argument is in ext1, and
		5849	* we'll store the result in new_ext. ext1 through ext7 are temporary
		5850	* registers that we'll overwrite with intermediate values.
		5851	*
		5852	* Before calling this function, the caller should reduce the value in
		5853	* ext1 to the range -pi/4 <= ext1 <= pi/4 to ensure quick convergence
		5854	* of the series.
		5855	*/
		5856	void CVmObjBigNum::calc_cos_series(VMG_ char new_ext, char ext1,
		5857	char ext2, char ext3, char *ext4,
		5858	char ext5, char ext6, char *ext7)
		5859	{
		5860	ulong n;
		5861	int neg_term;
		5862	char *tmp;
		5863
		5864	/* start with 2! (i.e., 2) in r3 */
		5865	copy_val(ext3, get_one(), FALSE);
		5866	set_dig(ext3, 0, 2);
		5867
		5868	/*
		5869	* calculate x^2 into r7 - we need x^2, x^4, x^6, etc, so we can
		5870	* just multiply the last value by x^2 to get the next power we need
		5871	*/
		5872	compute_prod_into(ext7, ext1, ext1);
		5873
		5874	/*
		5875	* the first power we need is x^2, so copy it into r1 (our current
		5876	* power of x register)
		5877	*/
		5878	copy_val(ext1, ext7, FALSE);
		5879
		5880	/*
		5881	* start with 1 in r5, the accumulator (the first term of the series
		5882	* is the constant value 1)
		5883	*/
		5884	copy_val(ext5, get_one(), FALSE);
		5885
		5886	/*
		5887	* start at term n=2 in our expansion (the first term is just the
		5888	* constant value 1, so we can start at the second term)
		5889	*/
		5890	n = 2;
		5891
		5892	/*
		5893	* the first term we calculate (i.e., the second term in the actual
		5894	* series) is negative
		5895	*/
		5896	neg_term = TRUE;
		5897
		5898	/* go until we have a precise enough value */
		5899	for (;;)
		5900	{
		5901	/* divide r1 by r3 to yield the next term in our series in r4 */
		5902	compute_quotient_into(vmg_ ext4, 0, ext1, ext3);
		5903
		5904	/*
		5905	* if this value is too small to count in our accumulator, we're
		5906	* done
		5907	*/
		5908	if (is_zero(ext4)
		5909	\|\| get_exp(ext5) - get_exp(ext4) > (int)get_prec(ext4))
		5910	break;
		5911
		5912	/*
		5913	* invert the sign of the term in r4 if this is a negative term
		5914	*/
		5915	if (neg_term)
		5916	set_neg(ext4, !get_neg(ext4));
		5917
		5918	/* add r4 to our running accumulator in r5, yielding r6 */
		5919	compute_sum_into(ext6, ext5, ext4);
		5920
		5921	/* swap r5 and r6 to put the accumulated value back into r5 */
		5922	tmp = ext5;
		5923	ext5 = ext6;
		5924	ext6 = tmp;
		5925
		5926	/*
		5927	* move on to the next term: multiply r1 by x^2 into r2 to yield
		5928	* the next power of x that we require
		5929	*/
		5930	compute_prod_into(ext2, ext1, ext7);
		5931
		5932	/* swap r1 and r2 to put our next required power back in r1 */
		5933	tmp = ext1;
		5934	ext1 = ext2;
		5935	ext2 = tmp;
		5936
		5937	/*
		5938	* multiply r3 by (n+1)*(n+2) - it currently has n!, so this
		5939	* will yield (n+2)!
		5940	*/
		5941	mul_by_long(ext3, (n+1)*(n+2));
		5942
		5943	/* advance n to the next term */
		5944	n += 2;
		5945
		5946	/* each term swaps signs */
		5947	neg_term = !neg_term;
		5948	}
		5949
		5950	/* we're done - store the result, rounding if necessary */
		5951	copy_val(new_ext, ext5, TRUE);
		5952	}
		5953
		5954	/* ------------------------------------------------------------------------ */
		5955	/*
		5956	* add a value
		5957	*/
		5958	void CVmObjBigNum::add_val(VMG_ vm_val_t *result,
		5959	vm_obj_id_t self, const vm_val_t *val)
		5960	{
		5961	vm_val_t val2;
		5962
		5963	/* convert it */
		5964	val2 = *val;
		5965	if (!cvt_to_bignum(vmg_ self, &val2))
		5966	{
		5967	/* this type is not convertible to BigNumber, so we can't add it */
		5968	err_throw(VMERR_BAD_TYPE_ADD);
		5969	}
		5970
		5971	/* push 'self' and the other value to protect against GC */
		5972	G_stk->push()->set_obj(self);
		5973	G_stk->push(&val2);
		5974
		5975	/* compute the sum */
		5976	compute_sum(vmg_ result, ext_, get_objid_ext(vmg_ val2.val.obj));
		5977
		5978	/* discard the GC protection items */
		5979	G_stk->discard(2);
		5980	}
		5981
		5982	/*
		5983	* subtract a value
		5984	*/
		5985	void CVmObjBigNum::sub_val(VMG_ vm_val_t *result,
		5986	vm_obj_id_t self, const vm_val_t *val)
		5987	{
		5988	vm_val_t val2;
		5989
		5990	/* convert it */
		5991	val2 = *val;
		5992	if (!cvt_to_bignum(vmg_ self, &val2))
		5993	{
		5994	/* this type is not convertible to BigNumber, so we can't use it */
		5995	err_throw(VMERR_BAD_TYPE_SUB);
		5996	}
		5997
		5998	/* push 'self' and the other value to protect against GC */
		5999	G_stk->push()->set_obj(self);
		6000	G_stk->push(&val2);
		6001
		6002	/* compute the difference */
		6003	compute_diff(vmg_ result, ext_, get_objid_ext(vmg_ val2.val.obj));
		6004
		6005	/* discard the GC protection items */
		6006	G_stk->discard(2);
		6007	}
		6008
		6009	/*
		6010	* multiply a value
		6011	*/
		6012	void CVmObjBigNum::mul_val(VMG_ vm_val_t *result,
		6013	vm_obj_id_t self, const vm_val_t *val)
		6014	{
		6015	vm_val_t val2;
		6016
		6017	/* convert it */
		6018	val2 = *val;
		6019	if (!cvt_to_bignum(vmg_ self, &val2))
		6020	{
		6021	/* this type is not convertible to BigNumber, so we can't add it */
		6022	err_throw(VMERR_BAD_TYPE_ADD);
		6023	}
		6024
		6025	/* push 'self' and the other value to protect against GC */
		6026	G_stk->push()->set_obj(self);
		6027	G_stk->push(&val2);
		6028
		6029	/* compute the product */
		6030	compute_prod(vmg_ result, ext_, get_objid_ext(vmg_ val2.val.obj));
		6031
		6032	/* discard the GC protection items */
		6033	G_stk->discard(2);
		6034	}
		6035
		6036	/*
		6037	* divide a value
		6038	*/
		6039	void CVmObjBigNum::div_val(VMG_ vm_val_t *result,
		6040	vm_obj_id_t self, const vm_val_t *val)
		6041	{
		6042	vm_val_t val2;
		6043
		6044	/* convert it */
		6045	val2 = *val;
		6046	if (!cvt_to_bignum(vmg_ self, &val2))
		6047	{
		6048	/* this type is not convertible to BigNumber, so we can't add it */
		6049	err_throw(VMERR_BAD_TYPE_ADD);
		6050	}
		6051
		6052	/* push 'self' and the other value to protect against GC */
		6053	G_stk->push()->set_obj(self);
		6054	G_stk->push(&val2);
		6055
		6056	/* compute the quotient */
		6057	compute_quotient(vmg_ result, ext_, get_objid_ext(vmg_ val2.val.obj));
		6058
		6059	/* discard the GC protection items */
		6060	G_stk->discard(2);
		6061	}
		6062
		6063	/*
		6064	* negate the number
		6065	*/
		6066	void CVmObjBigNum::neg_val(VMG_ vm_val_t *result, vm_obj_id_t self)
		6067	{
		6068	char *new_ext;
		6069	size_t prec = get_prec(ext_);
		6070
		6071	/*
		6072	* If I'm not an ordinary number or an infinity, return myself
		6073	* unchanged. Note that we change sign for an infinity, even though
		6074	* this might not make a great deal of sense mathematically.
		6075	*
		6076	* If I'm zero, likewise return myself unchanged. Negative zero is
		6077	* still zero.
		6078	*/
		6079	if ((get_type(ext_) != VMBN_T_NUM && get_type(ext_) != VMBN_T_INF)
		6080	\|\| is_zero(ext_))
		6081	{
		6082	/* return myself unchanged */
		6083	result->set_obj(self);
		6084	return;
		6085	}
		6086
		6087	/* push a self-reference while we're working */
		6088	G_stk->push()->set_obj(self);
		6089
		6090	/* if I'm an infinity, we don't need any precision in the result */
		6091	if (get_type(ext_) == VMBN_T_INF)
		6092	prec = 1;
		6093
		6094	/* create a new number with the same precision as the original */
		6095	result->set_obj(create(vmg_ FALSE, prec));
		6096	new_ext = get_objid_ext(vmg_ result->val.obj);
		6097
		6098	/* make a copy in the new object */
		6099	memcpy(new_ext, ext_, calc_alloc(prec));
		6100
		6101	/* reverse the sign */
		6102	set_neg(new_ext, !get_neg(new_ext));
		6103
		6104	/* remove my self-reference */
		6105	G_stk->discard();
		6106	}
		6107
		6108	/* ------------------------------------------------------------------------ */
		6109	/*
		6110	* check a value for equality
		6111	*/
		6112	int CVmObjBigNum::equals(VMG_ vm_obj_id_t self, const vm_val_t *val,
		6113	int /depth/) const
		6114	{
		6115	vm_val_t val2;
		6116	int ret;
		6117
		6118	/* if the other value is a reference to self, we certainly match */
		6119	if (val->typ == VM_OBJ && val->val.obj == self)
		6120	return TRUE;
		6121
		6122	/* convert it */
		6123	val2 = *val;
		6124	if (!cvt_to_bignum(vmg_ self, &val2))
		6125	{
		6126	/* this type is not convertible to BigNumber - it's not equal */
		6127	return FALSE;
		6128	}
		6129
		6130	/* push our values for safekeeping from the garbage collector */
		6131	G_stk->push()->set_obj(self);
		6132	G_stk->push(&val2);
		6133
		6134	/* check for equality and return the result */
		6135	ret = compute_eq_exact(ext_, get_objid_ext(vmg_ val2.val.obj));
		6136
		6137	/* discard the stacked values */
		6138	G_stk->discard(2);
		6139
		6140	/* return the result */
		6141	return ret;
		6142	}
		6143
		6144	/*
		6145	* Hash value calculation
		6146	*/
		6147	uint CVmObjBigNum::calc_hash(VMG_ vm_obj_id_t self, int /depth/) const
		6148	{
		6149	uint i;
		6150	uint hash;
		6151
		6152	/* add up the digits in the number */
		6153	for (hash = 0, i = 0 ; i < get_prec(ext_) ; ++i)
		6154	{
		6155	/* add this digit into the hash so far */
		6156	hash += get_dig(ext_, i);
		6157	}
		6158
		6159	/* add in the exponent as well */
		6160	hash += (uint)get_exp(ext_);
		6161
		6162	/* return the combined hash */
		6163	return hash;
		6164	}
		6165
		6166	/*
		6167	* compare to another value
		6168	*/
		6169	int CVmObjBigNum::compare_to(VMG_ vm_obj_id_t self,
		6170	const vm_val_t *val) const
		6171	{
		6172	vm_val_t val2;
		6173	const char *ext2;
		6174	int ret;
		6175
		6176	/* convert it */
		6177	val2 = *val;
		6178	if (!cvt_to_bignum(vmg_ self, &val2))
		6179	{
		6180	/* this type is not convertible to BigNumber - it's not comparable */
		6181	err_throw(VMERR_INVALID_COMPARISON);
		6182	}
		6183
		6184	/* get the other object's extension */
		6185	ext2 = get_objid_ext(vmg_ val2.val.obj);
		6186
		6187	/* if either one is not a number, they can't be compared */
		6188	if (is_nan(ext_) \|\| is_nan(ext2))
		6189	err_throw(VMERR_INVALID_COMPARISON);
		6190
		6191	/* if the signs differ, the positive one is greater */
		6192	if (get_neg(ext_) != get_neg(ext2))
		6193	{
		6194	/*
		6195	* if I'm negative, I'm the lesser number; otherwise I'm the
		6196	* greater number
		6197	*/
		6198	return (get_neg(ext_) ? -1 : 1);
		6199	}
		6200
		6201	/* the signs are the same - compare the absolute values */
		6202	ret = compare_abs(ext_, ext2);
		6203
		6204	/*
		6205	* If the numbers are negative, and my absolute value is greater,
		6206	* I'm actually the lesser number; if they're negative and my
		6207	* absolute value is lesser, I'm the greater number. So, if I'm
		6208	* negative, invert the sense of the result. Otherwise, both
		6209	* numbers are positive, so the sense of the absolute value
		6210	* comparison is the same as the sense of the actual comparison, so
		6211	* just return the result directly.
		6212	*/
		6213	return (get_neg(ext_) ? -ret : ret);
		6214	}
		6215
		6216
		6217	/* ------------------------------------------------------------------------ */
		6218	/*
		6219	* Initialize for a computation involving two operands. Checks the
		6220	* operands for non-number values; if either is NAN or INF, allocates a
		6221	* result value that is the same non-number type and returns null. If
		6222	* both are valid numbers, we'll allocate a result value with precision
		6223	* equal to the greater of the precisions of the operands, and we'll
		6224	* return a pointer to the new object's extension buffer.
		6225	*/
		6226	char CVmObjBigNum::compute_init_2op(VMG_ vm_val_t result,
		6227	const char ext1, const char ext2)
		6228	{
		6229	size_t new_prec;
		6230	char *new_ext;
		6231
		6232	/* get the greater precision - this is the precision of the result */
		6233	new_prec = get_prec(ext1);
		6234	if (get_prec(ext2) > new_prec)
		6235	new_prec = get_prec(ext2);
		6236
		6237	/*
		6238	* if either operand is not an ordinary number, we need minimal
		6239	* precision to represent the result, since we don't actually need
		6240	* to store a number
		6241	*/
		6242	if (is_nan(ext1) \|\| is_nan(ext2))
		6243	new_prec = 1;
		6244
		6245	/* allocate a new object with the required precision */
		6246	result->set_obj(create(vmg_ FALSE, new_prec));
		6247
		6248	/* get the extension buffer */
		6249	new_ext = get_objid_ext(vmg_ result->val.obj);
		6250
		6251	/* check the first value for NAN/INF conditions */
		6252	if (get_type(ext1) != VMBN_T_NUM)
		6253	{
		6254	/* set the result to the same non-number type and sign */
		6255	set_type(new_ext, get_type(ext1));
		6256	set_neg(new_ext, get_neg(ext1));
		6257
		6258	/* indicate that no further calculation is necessary */
		6259	return 0;
		6260	}
		6261
		6262	/* check the second number for NAN/INF conditions */
		6263	if (get_type(ext2) != VMBN_T_NUM)
		6264	{
		6265	/* set the result to the same non-number type and sign */
		6266	set_type(new_ext, get_type(ext2));
		6267	set_neg(new_ext, get_neg(ext2));
		6268
		6269	/* indicate that no further calculation is necessary */
		6270	return 0;
		6271	}
		6272
		6273	/* the operands are valid - return the new extension buffer */
		6274	return new_ext;
		6275	}
		6276
		6277	/*
		6278	* Compute a sum
		6279	*/
		6280	void CVmObjBigNum::compute_sum(VMG_ vm_val_t *result,
		6281	const char ext1, const char ext2)
		6282	{
		6283	char *new_ext;
		6284
		6285	/* allocate our result value */
		6286	new_ext = compute_init_2op(vmg_ result, ext1, ext2);
		6287
		6288	/* we're done if we had a non-number operand */
		6289	if (new_ext == 0)
		6290	return;
		6291
		6292	/* compute the sum into the result */
		6293	compute_sum_into(new_ext, ext1, ext2);
		6294	}
		6295
		6296	/*
		6297	* Compute a sum into the given buffer
		6298	*/
		6299	void CVmObjBigNum::compute_sum_into(char *new_ext,
		6300	const char ext1, const char ext2)
		6301	{
		6302	/* check to see if the numbers have the same sign */
		6303	if (get_neg(ext1) == get_neg(ext2))
		6304	{
		6305	/*
		6306	* the two numbers have the same sign, so the sum has the same
		6307	* sign as the two values, and the magnitude is the sum of the
		6308	* absolute values of the operands
		6309	*/
		6310
		6311	/* compute the sum of the absolute values */
		6312	compute_abs_sum_into(new_ext, ext1, ext2);
		6313
		6314	/* set the sign to match that of the operand */
		6315	set_neg(new_ext, get_neg(ext1));
		6316	}
		6317	else
		6318	{
		6319	/*
		6320	* one is positive and the other is negative - subtract the
		6321	* absolute value of the negative one from the absolute value of
		6322	* the positive one; the sign will be set correctly by the
		6323	* differencing
		6324	*/
		6325	if (get_neg(ext1))
		6326	compute_abs_diff_into(new_ext, ext2, ext1);
		6327	else
		6328	compute_abs_diff_into(new_ext, ext1, ext2);
		6329	}
		6330	}
		6331
		6332	/*
		6333	* Compute a difference
		6334	*/
		6335	void CVmObjBigNum::compute_diff(VMG_ vm_val_t *result,
		6336	const char ext1, const char ext2)
		6337	{
		6338	char *new_ext;
		6339
		6340	/* allocate our result value */
		6341	new_ext = compute_init_2op(vmg_ result, ext1, ext2);
		6342
		6343	/* we're done if we had a non-number operand */
		6344	if (new_ext == 0)
		6345	return;
		6346
		6347	/* check to see if the numbers have the same sign */
		6348	if (get_neg(ext1) == get_neg(ext2))
		6349	{
		6350	/*
		6351	* The two numbers have the same sign, so the difference is the
		6352	* difference in the magnitudes, and has a sign depending on the
		6353	* order of the difference and the signs of the original values.
		6354	* If both values are positive, the difference is negative if
		6355	* the second value is larger than the first. If both values
		6356	* are negative, the difference is negative if the second value
		6357	* has larger absolute value than the first.
		6358	*/
		6359
		6360	/* compute the difference in magnitudes */
		6361	compute_abs_diff_into(new_ext, ext1, ext2);
		6362
		6363	/*
		6364	* if the original values were negative, then the sign of the
		6365	* result is the opposite of the sign of the difference of the
		6366	* absolute values; otherwise, it's the same as the sign of the
		6367	* difference of the absolute values
		6368	*/
		6369	if (get_neg(ext1))
		6370	negate(new_ext);
		6371	}
		6372	else
		6373	{
		6374	/*
		6375	* one is positive and the other is negative - the result has
		6376	* the sign of the first operand, and has magnitude equal to the
		6377	* sum of the absolute values
		6378	*/
		6379
		6380	/* compute the sum of the absolute values */
		6381	compute_abs_sum_into(new_ext, ext1, ext2);
		6382
		6383	/* set the sign of the result to that of the first operand */
		6384	if (!is_zero(new_ext))
		6385	set_neg(new_ext, get_neg(ext1));
		6386	}
		6387	}
		6388
		6389	/*
		6390	* Compute a product
		6391	*/
		6392	void CVmObjBigNum::compute_prod(VMG_ vm_val_t *result,
		6393	const char ext1, const char ext2)
		6394	{
		6395	char *new_ext;
		6396
		6397	/* allocate our result value */
		6398	new_ext = compute_init_2op(vmg_ result, ext1, ext2);
		6399
		6400	/* we're done if we had a non-number operand */
		6401	if (new_ext == 0)
		6402	return;
		6403
		6404	/* compute the product */
		6405	compute_prod_into(new_ext, ext1, ext2);
		6406	}
		6407
		6408	/*
		6409	* Compute a quotient
		6410	*/
		6411	void CVmObjBigNum::compute_quotient(VMG_ vm_val_t *result,
		6412	const char ext1, const char ext2)
		6413	{
		6414	char *new_ext;
		6415
		6416	/* allocate our result value */
		6417	new_ext = compute_init_2op(vmg_ result, ext1, ext2);
		6418
		6419	/* we're done if we had a non-number operand */
		6420	if (new_ext == 0)
		6421	return;
		6422
		6423	/* compute the quotient */
		6424	compute_quotient_into(vmg_ new_ext, 0, ext1, ext2);
		6425	}
		6426
		6427	/*
		6428	* Determine if two values are equal, rounding the value with greater
		6429	* precision to the shorter precision if the two are not of equal
		6430	* precision
		6431	*/
		6432	int CVmObjBigNum::compute_eq_round(VMG_ const char ext1, const char ext2)
		6433	{
		6434	size_t prec1 = get_prec(ext1);
		6435	size_t prec2 = get_prec(ext2);
		6436	const char *shorter;
		6437	const char *longer;
		6438	char *tmp_ext;
		6439	uint tmp_hdl;
		6440	int ret;
		6441
		6442	/*
		6443	* allocate a temporary register with a rounded copy of the more
		6444	* precise of the values
		6445	*/
		6446	if (prec1 > prec2)
		6447	{
		6448	/* the first one is longer */
		6449	longer = ext1;
		6450	shorter = ext2;
		6451	}
		6452	else if (prec1 < prec2)
		6453	{
		6454	/* the second one is longer */
		6455	longer = ext2;
		6456	shorter = ext1;
		6457	}
		6458	else
		6459	{
		6460	/* they're the same - do an exact comparison */
		6461	return compute_eq_exact(ext1, ext2);
		6462	}
		6463
		6464	/* get a temp register for rounding the longer value */
		6465	alloc_temp_regs(vmg_ get_prec(shorter), 1, &tmp_ext, &tmp_hdl);
		6466
		6467	/* make a rounded copy */
		6468	copy_val(tmp_ext, longer, TRUE);
		6469
		6470	/* compare the rounded copy of the longer value to the shorter value */
		6471	ret = compute_eq_exact(shorter, tmp_ext);
		6472
		6473	/* release the temporary register */
		6474	release_temp_regs(vmg_ 1, tmp_hdl);
		6475
		6476	/* return the result */
		6477	return ret;
		6478	}
		6479
		6480	/*
		6481	* Make an exact comparison for equality. If one value is more precise
		6482	* than the other, we'll implicitly extend the shorter value to the
		6483	* right with trailing zeroes.
		6484	*/
		6485	int CVmObjBigNum::compute_eq_exact(const char ext1, const char ext2)
		6486	{
		6487	const char *longer;
		6488	size_t min_prec;
		6489	size_t max_prec;
		6490	size_t prec1;
		6491	size_t prec2;
		6492	size_t idx;
		6493
		6494	/*
		6495	* if either is not an ordinary number, they are never equal to any
		6496	* other value (note that this means INF != INF and NAN != NAN,
		6497	* which is reasonable because these values cannot be meaningfully
		6498	* compared; one NAN might mean something totally different from
		6499	* another, and likewise various infinities are not comparable)
		6500	*/
		6501	if (is_nan(ext1) \|\| is_nan(ext2))
		6502	return FALSE;
		6503
		6504	/* figure out if one is more precise than the other */
		6505	prec1 = get_prec(ext1);
		6506	prec2 = get_prec(ext2);
		6507	if (prec1 > prec2)
		6508	{
		6509	/* ext1 is longer */
		6510	longer = ext1;
		6511	max_prec = prec1;
		6512	min_prec = prec2;
		6513	}
		6514	else if (prec2 > prec1)
		6515	{
		6516	/* ext2 is longer */
		6517	longer = ext2;
		6518	max_prec = prec2;
		6519	min_prec = prec1;
		6520	}
		6521	else
		6522	{
		6523	/* they're the same */
		6524	longer = 0;
		6525	min_prec = max_prec = prec1;
		6526	}
		6527
		6528	/* if the signs aren't the same, the numbers are not equal */
		6529	if (get_neg(ext1) != get_neg(ext2))
		6530	return FALSE;
		6531
		6532	/* if the exponents aren't equal, the numbers are not equal */
		6533	if (get_exp(ext1) != get_exp(ext2))
		6534	return FALSE;
		6535
		6536	/*
		6537	* compare digits up to the smaller precision, then make sure that
		6538	* the larger-precision value's digits are all zeroes from there out
		6539	*/
		6540	for (idx = 0 ; idx < min_prec ; ++idx)
		6541	{
		6542	/* if they don't match, return not-equal */
		6543	if (get_dig(ext1, idx) != get_dig(ext2, idx))
		6544	return FALSE;
		6545	}
		6546
		6547	/* check the longer one to make sure it's all zeroes */
		6548	if (longer != 0)
		6549	{
		6550	/* scan the remainder of the longer one */
		6551	for ( ; idx < max_prec ; ++idx)
		6552	{
		6553	/* if this digit is non-zero, it's not a match */
		6554	if (get_dig(longer, idx) != 0)
		6555	return FALSE;
		6556	}
		6557	}
		6558
		6559	/* it's a match */
		6560	return TRUE;
		6561	}
		6562
		6563	/* ------------------------------------------------------------------------ */
		6564	/*
		6565	* Compute the sum of two absolute values into the given buffer
		6566	*/
		6567	void CVmObjBigNum::compute_abs_sum_into(char *new_ext,
		6568	const char ext1, const char ext2)
		6569	{
		6570	int max_exp;
		6571	int lo1, hi1;
		6572	int lo2, hi2;
		6573	int lo3, hi3;
		6574	int pos;
		6575	int carry;
		6576	int trail_dig;
		6577
		6578	/* if one or the other is identically zero, return the other value */
		6579	if (is_zero(ext1))
		6580	{
		6581	/* ext1 is zero - return ext2 */
		6582	copy_val(new_ext, ext2, TRUE);
		6583	return;
		6584	}
		6585	else if (is_zero(ext2))
		6586	{
		6587	/* ext2 is zero - return ext1 */
		6588	copy_val(new_ext, ext1, TRUE);
		6589	return;
		6590	}
		6591
		6592	/*
		6593	* start the new value with the larger of the two exponents - this
		6594	* will have the desired effect of dropping the least significant
		6595	* digits if any digits must be dropped
		6596	*/
		6597	max_exp = get_exp(ext1);
		6598	if (get_exp(ext2) > max_exp)
		6599	max_exp = get_exp(ext2);
		6600	set_exp(new_ext, max_exp);
		6601
		6602	/* compute the digit positions at the bounds of each of our values */
		6603	hi1 = get_exp(ext1) - 1;
		6604	lo1 = get_exp(ext1) - get_prec(ext1);
		6605
		6606	hi2 = get_exp(ext2) - 1;
		6607	lo2 = get_exp(ext2) - get_prec(ext2);
		6608
		6609	hi3 = get_exp(new_ext) - 1;
		6610	lo3 = get_exp(new_ext) - get_prec(new_ext);
		6611
		6612	/*
		6613	* If one of the values provides a digit one past the end of our
		6614	* result, remember that as the trailing digit that we're going to
		6615	* drop. We'll check this when we're done to see if we need to
		6616	* round the number. Since the result has precision at least as
		6617	* large as the larger of the two inputs, we can only be dropping
		6618	* significant digits from one of the two inputs - we can't be
		6619	* cutting off both inputs.
		6620	*/
		6621	trail_dig = 0;
		6622	if (lo3-1 >= lo1 && lo3-1 <= hi1)
		6623	{
		6624	/* remember the digit */
		6625	trail_dig = get_dig(ext1, get_exp(ext1) - (lo3-1) - 1);
		6626	}
		6627	else if (lo3-1 >= lo2 && lo3-1 <= hi2)
		6628	{
		6629	/* remember the digit */
		6630	trail_dig = get_dig(ext2, get_exp(ext2) - (lo3-1) - 1);
		6631	}
		6632
		6633	/* no carry yet */
		6634	carry = 0;
		6635
		6636	/* add the digits */
		6637	for (pos = lo3 ; pos <= hi3 ; ++pos)
		6638	{
		6639	int acc;
		6640
		6641	/* start with the carry */
		6642	acc = carry;
		6643
		6644	/* add the first value digit if it's in range */
		6645	if (pos >= lo1 && pos <= hi1)
		6646	acc += get_dig(ext1, get_exp(ext1) - pos - 1);
		6647
		6648	/* add the second value digit if it's in range */
		6649	if (pos >= lo2 && pos <= hi2)
		6650	acc += get_dig(ext2, get_exp(ext2) - pos - 1);
		6651
		6652	/* check for carry */
		6653	if (acc > 9)
		6654	{
		6655	/* reduce the accumulator and set the carry */
		6656	acc -= 10;
		6657	carry = 1;
		6658	}
		6659	else
		6660	{
		6661	/* no carry */
		6662	carry = 0;
		6663	}
		6664
		6665	/* set the digit in the result */
		6666	set_dig(new_ext, get_exp(new_ext) - pos - 1, acc);
		6667	}
		6668
		6669	/*
		6670	* If we have a carry at the end, we must carry it out to a new
		6671	* digit. In order to do this, we must shift the whole number right
		6672	* one place, then insert the one.
		6673	*/
		6674	if (carry)
		6675	{
		6676	/*
		6677	* remember the last digit of the result, which we won't have
		6678	* space to store after the shift
		6679	*/
		6680	trail_dig = get_dig(new_ext, get_prec(new_ext) - 1);
		6681
		6682	/* shift the result right */
		6683	shift_right(new_ext, 1);
		6684
		6685	/* increase the exponent to compensate for the shift */
		6686	set_exp(new_ext, get_exp(new_ext) + 1);
		6687
		6688	/* set the leading 1 */
		6689	set_dig(new_ext, 0, 1);
		6690	}
		6691
		6692	/* the sum of two absolute values is always positive */
		6693	set_neg(new_ext, FALSE);
		6694
		6695	/* round up the value if the trailing digit is 5 or higher */
		6696	if (trail_dig >= 5)
		6697	round_up_abs(new_ext);
		6698
		6699	/* normalize the number */
		6700	normalize(new_ext);
		6701	}
		6702
		6703	/*
		6704	* Compute the difference of two absolute values into the given buffer
		6705	*/
		6706	void CVmObjBigNum::compute_abs_diff_into(char *new_ext,
		6707	const char ext1, const char ext2)
		6708	{
		6709	int max_exp;
		6710	int lo1, hi1;
		6711	int lo2, hi2;
		6712	int lo3, hi3;
		6713	int pos;
		6714	int result_neg = FALSE;
		6715	int borrow;
		6716
		6717	/* if we're subtracting zero or from zero, it's easy */
		6718	if (is_zero(ext2))
		6719	{
		6720	/*
		6721	* we're subtracting zero from another value - the result is
		6722	* simply the first value
		6723	*/
		6724	copy_val(new_ext, ext1, TRUE);
		6725	return;
		6726	}
		6727	else if (is_zero(ext1))
		6728	{
		6729	/*
		6730	* We're subtracting a value from zero - we know the value we're
		6731	* subtracting is non-zero (we already checked for that case
		6732	* above), and we're only considering the absolute values, so
		6733	* simply return the negative of the absolute value of the
		6734	* second operand.
		6735	*/
		6736	copy_val(new_ext, ext2, TRUE);
		6737	set_neg(new_ext, TRUE);
		6738	return;
		6739	}
		6740
		6741	/*
		6742	* Compare the absolute values of the two operands. If the first
		6743	* value is larger than the second, subtract them in the given
		6744	* order. Otherwise, reverse the order and note that the result is
		6745	* negative.
		6746	*/
		6747	if (compare_abs(ext1, ext2) < 0)
		6748	{
		6749	const char *tmp;
		6750
		6751	/* the result will be negative */
		6752	result_neg = TRUE;
		6753
		6754	/* swap the order of the subtraction */
		6755	tmp = ext1;
		6756	ext1 = ext2;
		6757	ext2 = tmp;
		6758	}
		6759
		6760	/*
		6761	* start the new value with the larger of the two exponents - this
		6762	* will have the desired effect of dropping the least significant
		6763	* digits if any digits must be dropped
		6764	*/
		6765	max_exp = get_exp(ext1);
		6766	if (get_exp(ext2) > max_exp)
		6767	max_exp = get_exp(ext2);
		6768	set_exp(new_ext, max_exp);
		6769
		6770	/* compute the digit positions at the bounds of each of our values */
		6771	hi1 = get_exp(ext1) - 1;
		6772	lo1 = get_exp(ext1) - get_prec(ext1);
		6773
		6774	hi2 = get_exp(ext2) - 1;
		6775	lo2 = get_exp(ext2) - get_prec(ext2);
		6776
		6777	hi3 = get_exp(new_ext) - 1;
		6778	lo3 = get_exp(new_ext) - get_prec(new_ext);
		6779
		6780	/* start off with no borrow */
		6781	borrow = 0;
		6782
		6783	/*
		6784	* Check for borrowing from before the least significant digit
		6785	* position in common to both numbers
		6786	*/
		6787	if (lo3-1 >= lo1 && lo3-1 <= hi1)
		6788	{
		6789	/*
		6790	* In this case, we would be dropping precision from the end of
		6791	* the top number. This case should never happen - the only way
		6792	* it could happen is for the bottom number to extend to the
		6793	* left of the top number at the most significant end. This
		6794	* cannot happen because the bottom number always has small
		6795	* magnitude by this point (we guarantee this above). So, we
		6796	* should never get here.
		6797	*/
		6798	assert(FALSE);
		6799	}
		6800	else if (lo3-1 >= lo2 && lo3-1 <= hi2)
		6801	{
		6802	size_t idx;
		6803
		6804	/*
		6805	* We're dropping precision from the bottom number, so we want
		6806	* to borrow into the subtraction if the rest of the number is
		6807	* greater than 5xxxx. If it's exactly 5000..., do not borrow,
		6808	* since the result would end in 5 and we'd round up.
		6809	*
		6810	* If the next digit is 6 or greater, we know for a fact we'll
		6811	* have to borrow. If the next digit is 4 or less, we know for
		6812	* a fact we won't have to borrow. If the next digit is 5,
		6813	* though, we must look at the rest of the number to see if
		6814	* there's anything but trailing zeroes.
		6815	*/
		6816	idx = (size_t)(get_exp(ext2) - (lo3-1) - 1);
		6817	if (get_dig(ext2, idx) >= 6)
		6818	{
		6819	/* definitely borrow */
		6820	borrow = 1;
		6821	}
		6822	else if (get_dig(ext2, idx) == 5)
		6823	{
		6824	/* borrow only if we have something non-zero following */
		6825	for (++idx ; idx < get_prec(ext2) ; ++idx)
		6826	{
		6827	/* if it's non-zero, we must borrow */
		6828	if (get_dig(ext2, idx) != 0)
		6829	{
		6830	/* note the borrow */
		6831	borrow = 1;
		6832
		6833	/* no need to keep scanning */
		6834	break;
		6835	}
		6836	}
		6837	}
		6838	}
		6839
		6840	/* subtract the digits from least to most significant */
		6841	for (pos = lo3 ; pos <= hi3 ; ++pos)
		6842	{
		6843	int acc;
		6844
		6845	/* start with zero in the accumulator */
		6846	acc = 0;
		6847
		6848	/* start with the top-line value if it's represented here */
		6849	if (pos >= lo1 && pos <= hi1)
		6850	acc = get_dig(ext1, get_exp(ext1) - pos - 1);
		6851
		6852	/* subtract the second value digit if it's represented here */
		6853	if (pos >= lo2 && pos <= hi2)
		6854	acc -= get_dig(ext2, get_exp(ext2) - pos - 1);
		6855
		6856	/* subtract the borrow */
		6857	acc -= borrow;
		6858
		6859	/* check for borrow */
		6860	if (acc < 0)
		6861	{
		6862	/* increase the accumulator */
		6863	acc += 10;
		6864
		6865	/* we must borrow from the next digit up */
		6866	borrow = 1;
		6867	}
		6868	else
		6869	{
		6870	/* we're in range - no need to borrow */
		6871	borrow = 0;
		6872	}
		6873
		6874	/* set the digit in the result */
		6875	set_dig(new_ext, get_exp(new_ext) - pos - 1, acc);
		6876	}
		6877
		6878	/* set the sign of the result as calculated earlier */
		6879	set_neg(new_ext, result_neg);
		6880
		6881	/* normalize the number */
		6882	normalize(new_ext);
		6883	}
		6884
		6885	/*
		6886	* Compute the product of the values into the given buffer
		6887	*/
		6888	void CVmObjBigNum::compute_prod_into(char *new_ext,
		6889	const char ext1, const char ext2)
		6890	{
		6891	size_t prec1 = get_prec(ext1);
		6892	size_t prec2 = get_prec(ext2);
		6893	size_t new_prec = get_prec(new_ext);
		6894	size_t idx1;
		6895	size_t idx2;
		6896	size_t out_idx;
		6897	size_t start_idx;
		6898	int out_exp;
		6899	int trail_dig;
		6900
		6901	/* start out with zero in the accumulator */
		6902	memset(new_ext + VMBN_MANT, 0, (new_prec + 1)/2);
		6903
		6904	/*
		6905	* Initially write output in the same 'column' where the top number
		6906	* ends, so we start out with the same scale as the top number.
		6907	*/
		6908	start_idx = get_prec(ext1);
		6909
		6910	/*
		6911	* initial result exponent is the sum of the exponents, minus the
		6912	* number of digits in the bottom number (effectively, this lets us
		6913	* treat the bottom number as a whole number by scaling it enough to
		6914	* make it whole, soaking up the factors of ten into decimal point
		6915	* relocation)
		6916	*/
		6917	out_exp = get_exp(ext1) + get_exp(ext2) - prec2;
		6918
		6919	/* there's no trailing accumulator digit yet */
		6920	trail_dig = 0;
		6921
		6922	/*
		6923	* Loop over digits in the bottom number, from least significant to
		6924	* most significant - we'll multiply each digit of the bottom number
		6925	* by the top number and add the result into the accumulator.
		6926	*/
		6927	for (idx2 = prec2 ; idx2 != 0 ; )
		6928	{
		6929	int carry;
		6930	int dig;
		6931	int ext2_dig;
		6932
		6933	/* no carry yet on this round */
		6934	carry = 0;
		6935
		6936	/* start writing this round at the output start index */
		6937	out_idx = start_idx;
		6938
		6939	/* move to the next digit */
		6940	--idx2;
		6941
		6942	/* get this digit of ext2 */
		6943	ext2_dig = get_dig(ext2, idx2);
		6944
		6945	/*
		6946	* if this digit of ext2 is non-zero, multiply the digits of
		6947	* ext1 by the digit (obviously if the digit is zero, there's no
		6948	* need to iterate over the digits of ext1)
		6949	*/
		6950	if (ext2_dig != 0)
		6951	{
		6952	/*
		6953	* loop over digits in the top number, from least to most
		6954	* significant
		6955	*/
		6956	for (idx1 = prec1 ; idx1 != 0 ; )
		6957	{
		6958	/* move to the next digit of the top number */
		6959	--idx1;
		6960
		6961	/* move to the next digit of the accumulator */
		6962	--out_idx;
		6963
		6964	/*
		6965	* compute the product of the current digits, and add in
		6966	* the carry from the last digit, then add in the
		6967	* current accumulator digit in this position
		6968	*/
		6969	dig = (get_dig(ext1, idx1) * ext2_dig)
		6970	+ carry
		6971	+ get_dig(new_ext, out_idx);
		6972
		6973	/* figure the carry to the next digit */
		6974	carry = (dig / 10);
		6975	dig = dig % 10;
		6976
		6977	/* store the new digit */
		6978	set_dig(new_ext, out_idx, dig);
		6979	}
		6980	}
		6981
		6982	/*
		6983	* Shift the result accumulator right in preparation for the
		6984	* next round. One exception: if this is the last (most
		6985	* significant) digit of the bottom number, and there's no
		6986	* carry, there's no need to shift the number, since we'd just
		6987	* normalize away the leading zero anyway
		6988	*/
		6989	if (idx2 != 0 \|\| carry != 0)
		6990	{
		6991	/* remember the trailing digit that we're going to drop */
		6992	trail_dig = get_dig(new_ext, new_prec - 1);
		6993
		6994	/* shift the accumulator */
		6995	shift_right(new_ext, 1);
		6996
		6997	/* increase the output exponent */
		6998	++out_exp;
		6999
		7000	/* insert the carry as the lead digit */
		7001	set_dig(new_ext, 0, carry);
		7002	}
		7003	}
		7004
		7005	/* set the result exponent */
		7006	set_exp(new_ext, out_exp);
		7007
		7008	/*
		7009	* set the sign - if both inputs have the same sign, the output is
		7010	* positive, otherwise it's negative
		7011	*/
		7012	set_neg(new_ext, get_neg(ext1) != get_neg(ext2));
		7013
		7014	/* if the trailing digit is 5 or greater, round up */
		7015	if (trail_dig >= 5)
		7016	round_up_abs(new_ext);
		7017
		7018	/* normalize the number */
		7019	normalize(new_ext);
		7020	}
		7021
		7022	/*
		7023	* Compute a quotient into the given buffer. If new_rem_ext is
		7024	* non-null, we'll save the remainder into this buffer. We calculate
		7025	* the remainder only to the precision of the quotient.
		7026	*/
		7027	void CVmObjBigNum::compute_quotient_into(VMG_ char *new_ext,
		7028	char *new_rem_ext,
		7029	const char ext1, const char ext2)
		7030	{
		7031	char *rem_ext;
		7032	uint rem_hdl;
		7033	char *rem_ext2;
		7034	uint rem_hdl2;
		7035	int quo_exp;
		7036	size_t quo_idx;
		7037	size_t quo_prec = get_prec(new_ext);
		7038	size_t dvd_prec = get_prec(ext1);
		7039	size_t dvs_prec = get_prec(ext2);
		7040	char *dvs_ext;
		7041	uint dvs_hdl;
		7042	char *dvs_ext2;
		7043	uint dvs_hdl2;
		7044	int lead_dig_set;
		7045	int zero_remainder;
		7046	int acc;
		7047	size_t rem_prec;
		7048
		7049	/* if the divisor is zero, throw an error */
		7050	if (is_zero(ext2))
		7051	err_throw(VMERR_DIVIDE_BY_ZERO);
		7052
		7053	/* if the dividend is zero, the result is zero */
		7054	if (is_zero(ext1))
		7055	{
		7056	/* set the result to zero */
		7057	set_zero(new_ext);
		7058
		7059	/* if they want the remainder, it's zero also */
		7060	if (new_rem_ext != 0)
		7061	set_zero(new_rem_ext);
		7062
		7063	/* we're done */
		7064	return;
		7065	}
		7066
		7067	/*
		7068	* Calculate the precision we need for the running remainder. We
		7069	* must retain in the remainder enough precision to calculate exact
		7070	* differences, so we need the greater of the precisions of the
		7071	* dividend and the divisor, plus enough extra digits for the
		7072	* maximum relative shifting. We will have to shift at most one
		7073	* extra digit, but use two to be extra safe.
		7074	*/
		7075	rem_prec = dvd_prec;
		7076	if (rem_prec < dvs_prec)
		7077	rem_prec = dvs_prec;
		7078	rem_prec += 2;
		7079
		7080	/*
		7081	* Make sure the precision is at least three, since it simplifies
		7082	* our digit approximation calculation.
		7083	*/
		7084	if (rem_prec < 3)
		7085	rem_prec = 3;
		7086
		7087	/*
		7088	* Allocate two temporary registers for the running remainder, and
		7089	* one more for the multiplied divisor. Note that we allocate the
		7090	* multiplied divisor at our higher precision so that we don't lose
		7091	* digits in our multiplier calculations.
		7092	*/
		7093	alloc_temp_regs(vmg_ rem_prec, 3,
		7094	&rem_ext, &rem_hdl, &rem_ext2, &rem_hdl2,
		7095	&dvs_ext2, &dvs_hdl2);
		7096
		7097	/*
		7098	* Allocate another temp register for the shifted divisor. Note
		7099	* that we need a different precision here, which is why we must
		7100	* make a separate allocation call
		7101	*/
		7102	err_try
		7103	{
		7104	/* make the additional allocation */
		7105	alloc_temp_regs(vmg_ dvs_prec, 1, &dvs_ext, &dvs_hdl);
		7106	}
		7107	err_catch(exc)
		7108	{
		7109	/* delete the first group of registers we allocated */
		7110	release_temp_regs(vmg_ 2, rem_hdl, rem_hdl2);
		7111
		7112	/* re-throw the exception */
		7113	err_rethrow();
		7114	}
		7115	err_end;
		7116
		7117	/* the dividend is the initial value of the running remainder */
		7118	copy_val(rem_ext, ext1, TRUE);
		7119
		7120	/* copy the initial divisor into our temp register */
		7121	copy_val(dvs_ext, ext2, TRUE);
		7122
		7123	/* we haven't set a non-zero leading digit yet */
		7124	lead_dig_set = FALSE;
		7125
		7126	/*
		7127	* scale the divisor so that the divisor and dividend have the same
		7128	* exponent, and absorb the multiplier in the quotient
		7129	*/
		7130	quo_exp = get_exp(ext1) - get_exp(ext2) + 1;
		7131	set_exp(dvs_ext, get_exp(ext1));
		7132
		7133	/* we don't have a zero remainder yet */
		7134	zero_remainder = FALSE;
		7135
		7136	/*
		7137	* if the quotient is going to be entirely fractional, the dividend
		7138	* is the remainder, and the quotient is zero
		7139	*/
		7140	if (new_rem_ext != 0 && quo_exp <= 0)
		7141	{
		7142	/* copy the initial remainder into the output remainder */
		7143	copy_val(new_rem_ext, rem_ext, TRUE);
		7144
		7145	/* set the quotient to zero */
		7146	set_zero(new_ext);
		7147
		7148	/* we have the result - no need to do any more work */
		7149	goto done;
		7150	}
		7151
		7152	/*
		7153	* Loop over each digit of precision of the quotient.
		7154	*/
		7155	for (quo_idx = 0 ; ; )
		7156	{
		7157	int rem_approx, dvs_approx;
		7158	int dig_approx;
		7159	char *tmp;
		7160	int exp_diff;
		7161
		7162	/* start out with 0 in our digit accumulator */
		7163	acc = 0;
		7164
		7165	/*
		7166	* Get the first few digits of the remainder, and the first few
		7167	* digits of the divisor, rounding up the divisor and rounding
		7168	* down the remainder. Compute the quotient - this will give us
		7169	* a rough guess and a lower bound for the current digit's
		7170	* value.
		7171	*/
		7172	rem_approx = (get_dig(rem_ext, 0)*100
		7173	+ get_dig(rem_ext, 1)*10
		7174	+ get_dig(rem_ext, 2));
		7175	dvs_approx = (get_dig(dvs_ext, 0)*100
		7176	+ (dvs_prec >= 2 ? get_dig(dvs_ext, 1) : 0)*10
		7177	+ (dvs_prec >= 3 ? get_dig(dvs_ext, 2) : 0)
		7178	+ 1);
		7179
		7180	/* adjust for differences in the scale */
		7181	exp_diff = get_exp(rem_ext) - get_exp(dvs_ext);
		7182	if (exp_diff > 0)
		7183	{
		7184	/* the remainder is larger - scale it up */
		7185	for ( ; exp_diff > 0 ; --exp_diff)
		7186	rem_approx *= 10;
		7187	}
		7188	else if (exp_diff <= -3)
		7189	{
		7190	/*
		7191	* The divisor is larger by more than 10^3, which means that
		7192	* the result of our integer division is definitely going to
		7193	* be zero, so there's no point in actually doing the
		7194	* calculation. This is only a special case because, for
		7195	* sufficiently large negative differences, we'd have to
		7196	* multiply our divisor approximation by 10 so many times
		7197	* that we'd overflow a native int type, at which point we'd
		7198	* get 0 in the divisor, which would result in a
		7199	* divide-by-zero. To avoid this, just put 1000 in our
		7200	* divisor, which is definitely larger than anything we can
		7201	* have in rem_ext at this point (since it was just three
		7202	* decimal digits, after all).
		7203	*/
		7204	dvs_approx = 1000;
		7205	}
		7206	else if (exp_diff < 0)
		7207	{
		7208	/* the divisor is larger - scale it up */
		7209	for ( ; exp_diff < 0 ; ++exp_diff)
		7210	dvs_approx *= 10;
		7211	}
		7212
		7213	/* calculate our initial guess for this digit */
		7214	dig_approx = rem_approx / dvs_approx;
		7215
		7216	/*
		7217	* If this digit is above 2, it'll save us a lot of work to
		7218	* subtract digit*divisor once, rather than iteratively
		7219	* deducting the divisor one time per iteration. (It costs us a
		7220	* little to calculate the digit*divisor product, so we don't
		7221	* want to do this for very small digit values.)
		7222	*/
		7223	if (dig_approx > 2)
		7224	{
		7225	/* put the approximate digit in the accumulator */
		7226	acc = dig_approx;
		7227
		7228	/* make a copy of the divisor */
		7229	copy_val(dvs_ext2, dvs_ext, FALSE);
		7230
		7231	/*
		7232	* multiply it by the guess for the digit - we know this
		7233	* will always be less than or equal to the real value
		7234	* because of the way we did the rounding
		7235	*/
		7236	mul_by_long(dvs_ext2, (ulong)dig_approx);
		7237
		7238	/* subtract it from the running remainder */
		7239	compute_abs_diff_into(rem_ext2, rem_ext, dvs_ext2);
		7240
		7241	/* if that leaves zero in the remainder, note it */
		7242	if (is_zero(rem_ext2))
		7243	{
		7244	zero_remainder = TRUE;
		7245	break;
		7246	}
		7247
		7248	/*
		7249	* swap the remainder registers, since rem_ext2 is now the
		7250	* new running remainder value
		7251	*/
		7252	tmp = rem_ext;
		7253	rem_ext = rem_ext2;
		7254	rem_ext2 = tmp;
		7255
		7256	/*
		7257	* Now we'll finish up the job by subtracting the divisor
		7258	* from the remainder as many more times as necessary for
		7259	* the remainder to fall below the divisor. We can't be
		7260	* exact at this step because we're not considering all of
		7261	* the digits, but we should only have one more subtraction
		7262	* remaining at this point.
		7263	*/
		7264	}
		7265
		7266	/*
		7267	* subtract the divisor from the running remainder as many times
		7268	* as we can
		7269	*/
		7270	for ( ; ; ++acc)
		7271	{
		7272	int comp_res;
		7273
		7274	/* compare the running remainder to the divisor */
		7275	comp_res = compare_abs(rem_ext, dvs_ext);
		7276	if (comp_res < 0)
		7277	{
		7278	/*
		7279	* the remainder is smaller than the divisor - we have
		7280	* our result for this digit
		7281	*/
		7282	break;
		7283	}
		7284	else if (comp_res == 0)
		7285	{
		7286	/* note that we have a zero remainder */
		7287	zero_remainder = TRUE;
		7288
		7289	/* count one more subtraction */
		7290	++acc;
		7291
		7292	/* we have our result for this digit */
		7293	break;
		7294	}
		7295
		7296	/* subtract it */
		7297	compute_abs_diff_into(rem_ext2, rem_ext, dvs_ext);
		7298
		7299	/*
		7300	* swap the remainder registers, since rem_ext2 is now the
		7301	* new running remainder value
		7302	*/
		7303	tmp = rem_ext;
		7304	rem_ext = rem_ext2;
		7305	rem_ext2 = tmp;
		7306	}
		7307
		7308	/* store this digit of the quotient */
		7309	if (quo_idx < quo_prec)
		7310	{
		7311	/* store the digit */
		7312	set_dig(new_ext, quo_idx, acc);
		7313	}
		7314	else if (quo_idx == quo_prec)
		7315	{
		7316	/* set the quotient's exponent */
		7317	set_exp(new_ext, quo_exp);
		7318
		7319	/*
		7320	* this is the last digit, which we calculated for rounding
		7321	* purposes only - if it's 5 or greater, round up the value,
		7322	* otherwise leave it as it is
		7323	*/
		7324	if (acc >= 5)
		7325	round_up_abs(new_ext);
		7326
		7327	/* we've reached the rounding digit - we can stop now */
		7328	break;
		7329	}
		7330
		7331	/*
		7332	* if this is a non-zero digit, we've found a significant
		7333	* leading digit
		7334	*/
		7335	if (acc != 0)
		7336	lead_dig_set = TRUE;
		7337
		7338	/*
		7339	* if we've found a significant leading digit, move to the next
		7340	* digit of the quotient; if not, adjust the quotient exponent
		7341	* down one, and keep preparing to write the first digit at the
		7342	* first "column" of the quotient
		7343	*/
		7344	if (lead_dig_set)
		7345	++quo_idx;
		7346	else
		7347	--quo_exp;
		7348
		7349	/*
		7350	* If we have an exact result (a zero remainder), we're done.
		7351	*
		7352	* Similarly, if we've reached the units digit, and the caller
		7353	* wants the remainder, stop now - the caller wants an integer
		7354	* result for the quotient, which we now have.
		7355	*
		7356	* Similarly, if we've reached the rounding digit, and the
		7357	* caller wants the remainder, skip the rounding step - the
		7358	* caller wants an unrounded result for the quotient so that the
		7359	* quotient times the divisor plus the remainder equals the
		7360	* dividend.
		7361	*/
		7362	if (zero_remainder
		7363	\|\| (new_rem_ext != 0
		7364	&& ((int)quo_idx == quo_exp \|\| quo_idx == quo_prec)))
		7365	{
		7366	/* zero any remaining digits of the quotient */
		7367	for ( ; quo_idx < quo_prec ; ++quo_idx)
		7368	set_dig(new_ext, quo_idx, 0);
		7369
		7370	/* set the quotient's exponent */
		7371	set_exp(new_ext, quo_exp);
		7372
		7373	/* that's it */
		7374	break;
		7375	}
		7376
		7377	/* divide the divisor by ten */
		7378	set_exp(dvs_ext, get_exp(dvs_ext) - 1);
		7379	}
		7380
		7381	/* store the remainder if the caller wants the value */
		7382	if (new_rem_ext != 0)
		7383	{
		7384	/* save the remainder into the caller's buffer */
		7385	if (zero_remainder)
		7386	{
		7387	/* the remainder is exactly zero */
		7388	set_zero(new_rem_ext);
		7389	}
		7390	else
		7391	{
		7392	/* copy the running remainder */
		7393	copy_val(new_rem_ext, rem_ext, TRUE);
		7394
		7395	/* the remainder has the same sign as the dividend */
		7396	set_neg(new_rem_ext, get_neg(ext1));
		7397
		7398	/* normalize the remainder */
		7399	normalize(new_rem_ext);
		7400	}
		7401	}
		7402
		7403	/*
		7404	* the quotient is positive if both the divisor and dividend have
		7405	* the same sign, negative if they're different
		7406	*/
		7407	set_neg(new_ext, get_neg(ext1) != get_neg(ext2));
		7408
		7409	/* normalize the quotient */
		7410	normalize(new_ext);
		7411
		7412	done:
		7413	/* release the temporary registers */
		7414	release_temp_regs(vmg_ 4, rem_hdl, rem_hdl2, dvs_hdl, dvs_hdl2);
		7415	}
		7416
		7417	/*
		7418	* Compare the absolute values of two numbers
		7419	*/
		7420	int CVmObjBigNum::compare_abs(const char ext1, const char ext2)
		7421	{
		7422	size_t idx;
		7423	int zero1 = is_zero(ext1);
		7424	int zero2 = is_zero(ext2);
		7425	size_t prec1 = get_prec(ext1);
		7426	size_t prec2 = get_prec(ext2);
		7427	size_t max_prec;
		7428	size_t min_prec;
		7429	const char *max_ext;
		7430	int result;
		7431
		7432	/*
		7433	* if one is zero and the other is not, the one that's not zero has
		7434	* a larger absolute value
		7435	*/
		7436	if (zero1)
		7437	return (zero2 ? 0 : -1);
		7438	if (zero2)
		7439	return (zero1 ? 0 : 1);
		7440
		7441	/*
		7442	* if the exponents differ, the one with the larger exponent is the
		7443	* larger number (this is necessarily true because we keep all
		7444	* numbers normalized)
		7445	*/
		7446	if (get_exp(ext1) > get_exp(ext2))
		7447	return 1;
		7448	else if (get_exp(ext1) < get_exp(ext2))
		7449	return -1;
		7450
		7451	/*
		7452	* The exponents are equal, so we must compare the mantissas digit
		7453	* by digit
		7454	*/
		7455
		7456	/* get the larger of the two precisions */
		7457	min_prec = prec2;
		7458	max_prec = prec1;
		7459	max_ext = ext1;
		7460	if (prec2 > max_prec)
		7461	{
		7462	min_prec = prec1;
		7463	max_prec = prec2;
		7464	max_ext = ext2;
		7465	}
		7466
		7467	/*
		7468	* The digits are in order from most significant to least
		7469	* significant, which means we can use memcmp to compare the common
		7470	* parts. However, we can only compare an even number of digits
		7471	* this way, so round down the common precision if it's odd.
		7472	*/
		7473	if (min_prec > 1
		7474	&& (result = memcmp(ext1 + VMBN_MANT, ext2 + VMBN_MANT,
		7475	min_prec/2)) != 0)
		7476	{
		7477	/*
		7478	* they're different in the common memcmp-able parts, so return
		7479	* the memcmp result
		7480	*/
		7481	return result;
		7482	}
		7483
		7484	/* if the common precision is odd, compare the final common digit */
		7485	if ((min_prec & 1) != 0
		7486	&& (result = ((int)get_dig(ext1, min_prec-1)
		7487	- (int)get_dig(ext2, min_prec-1))) != 0)
		7488	return result;
		7489
		7490	/*
		7491	* the common parts of the mantissas are identical; check each
		7492	* remaining digit of the longer one to see if any are non-zero
		7493	*/
		7494	for (idx = min_prec ; idx < max_prec ; ++idx)
		7495	{
		7496	/*
		7497	* if this digit is non-zero, the longer one is greater, because
		7498	* the shorter one has an implied zero in this position
		7499	*/
		7500	if (get_dig(max_ext, idx) != 0)
		7501	return (int)prec1 - (int)prec2;
		7502	}
		7503
		7504	/* they're identical */
		7505	return 0;
		7506	}
		7507
		7508	/* ------------------------------------------------------------------------ */
		7509	/*
		7510	* Round a value
		7511	*/
		7512	const char CVmObjBigNum::round_val(VMG_ vm_val_t new_val, const char *ext,
		7513	size_t digits, int always_create)
		7514	{
		7515	char *new_ext;
		7516	int idx;
		7517	int need_carry;
		7518	int need_round;
		7519
		7520	/* presume we need rounding */
		7521	need_round = TRUE;
		7522
		7523	/*
		7524	* if the value is already no longer than the requested precision,
		7525	* return the original value; similarly, if we don't have to do any
		7526	* rounding to truncate to the requested precision, do not change
		7527	* the original object; likewise, don't bother changing anything if
		7528	* it's not a number
		7529	*/
		7530	if (digits >= get_prec(ext) \|\| get_dig(ext, digits) < 5
		7531	\|\| get_type(ext) != VMBN_T_NUM)
		7532	{
		7533	if (always_create)
		7534	{
		7535	/*
		7536	* we must create a new object regardless, but it won't need
		7537	* rounding
		7538	*/
		7539	need_round = FALSE;
		7540	}
		7541	else
		7542	{
		7543	/* return the original value */
		7544	new_val->set_nil();
		7545	return ext;
		7546	}
		7547	}
		7548
		7549	/* allocate a new object with the requested precision */
		7550	new_val->set_obj(create(vmg_ FALSE, digits));
		7551	new_ext = get_objid_ext(vmg_ new_val->val.obj);
		7552
		7553	/* copy the sign, exponent, and type information */
		7554	set_prec(new_ext, digits);
		7555	set_neg(new_ext, get_neg(ext));
		7556	set_exp(new_ext, get_exp(ext));
		7557	set_type(new_ext, get_type(ext));
		7558
		7559	/*
		7560	* if we don't need rounding, just truncate the old mantissa and
		7561	* return the result
		7562	*/
		7563	if (!need_round)
		7564	{
		7565	/* if the new size is smaller, truncate it */
		7566	if (digits <= get_prec(ext))
		7567	{
		7568	/* copy the mantissa up to the requested new size */
		7569	memcpy(new_ext + VMBN_MANT, ext + VMBN_MANT, (digits + 1)/2);
		7570	}
		7571	else
		7572	{
		7573	/* it's growing - simply copy the old value */
		7574	copy_val(new_ext, ext, FALSE);
		7575	}
		7576
		7577	/* return the new value */
		7578	return new_ext;
		7579	}
		7580
		7581	/* copy the mantissa up to the requested new precision */
		7582	memcpy(new_ext + VMBN_MANT, ext + VMBN_MANT, (digits + 1)/2);
		7583
		7584	/* apply the rounding */
		7585	for (need_carry = TRUE, idx = digits ; idx != 0 ; )
		7586	{
		7587	/* move to the previous index value */
		7588	--idx;
		7589
		7590	/* round up - if it's a 9, we need to carry */
		7591	if (get_dig(new_ext, idx) == 9)
		7592	{
		7593	/* make it a zero, and keep going to carry it */
		7594	set_dig(new_ext, idx, 0);
		7595	}
		7596	else
		7597	{
		7598	/* bump it up */
		7599	set_dig(new_ext, idx, get_dig(new_ext, idx) + 1);
		7600
		7601	/* no carrying required, so we can stop now */
		7602	need_carry = FALSE;
		7603	break;
		7604	}
		7605	}
		7606
		7607	/*
		7608	* if we need to carry, we must have had all nines, in which case we
		7609	* now have all zeroes - put a 1 in for the first digit, and
		7610	* increase the exponent to account for the change
		7611	*/
		7612	if (need_carry)
		7613	{
		7614	/* set the lead digit to 1 */
		7615	set_dig(new_ext, 0, 1);
		7616
		7617	/* increase the exponent */
		7618	set_exp(new_ext, get_exp(new_ext) + 1);
		7619	}
		7620
		7621	/* return the new extension */
		7622	return new_ext;
		7623	}
		7624
		7625	/*
		7626	* Convert a value to a big number value
		7627	*/
		7628	int CVmObjBigNum::cvt_to_bignum(VMG_ vm_obj_id_t self, vm_val_t *val) const
		7629	{
		7630	/* if it's an integer, convert it to a BigNum value */
		7631	if (val->typ == VM_INT)
		7632	{
		7633	/*
		7634	* put my own value on the stack to ensure I'm not garbage
		7635	* collected when creating the new object
		7636	*/
		7637	G_stk->push()->set_obj(self);
		7638
		7639	/* it's an integer - convert it to a BigNum */
		7640	val->set_obj(create(vmg_ FALSE, val->val.intval, 32));
		7641
		7642	/* done protecting my object reference */
		7643	G_stk->discard();
		7644	}
		7645
		7646	/* if it's not a BigNumberobject, we can't handle it */
		7647	if (val->typ != VM_OBJ
		7648	\|\| (vm_objp(vmg_ val->val.obj)->get_metaclass_reg()
		7649	!= metaclass_reg_))
		7650	{
		7651	/* indicate that conversion was unsuccessful */
		7652	return FALSE;
		7653	}
		7654
		7655	/* successful conversion */
		7656	return TRUE;
		7657	}
		7658
		7659	/*
		7660	* Allocate a temporary register
		7661	*/
		7662	char CVmObjBigNum::alloc_temp_reg(VMG_ size_t prec, uint hdl)
		7663	{
		7664	char *p;
		7665
		7666	/* allocate a register with enough space for the desired precision */
		7667	p = G_bignum_cache->alloc_reg(calc_alloc(prec), hdl);
		7668
		7669	/* if that succeeded, initialize the memory */
		7670	if (p != 0)
		7671	{
		7672	/* set the desired precision */
		7673	set_prec(p, prec);
		7674
		7675	/* initialize the flags */
		7676	p[VMBN_FLAGS] = 0;
		7677	}
		7678
		7679	/* return the register memory */
		7680	return p;
		7681	}
		7682
		7683	/*
		7684	* release a temporary register
		7685	*/
		7686	void CVmObjBigNum::release_temp_reg(VMG_ uint hdl)
		7687	{
		7688	/* release the register to the cache */
		7689	G_bignum_cache->release_reg(hdl);
		7690	}
		7691
		7692	/*
		7693	* Allocate a group of temporary registers
		7694	*/
		7695	void CVmObjBigNum::alloc_temp_regs(VMG_ size_t prec, size_t cnt, ...)
		7696	{
		7697	va_list marker;
		7698	size_t i;
		7699	int failed;
		7700	char **ext_ptr;
		7701	uint *hdl_ptr;
		7702
		7703	/* set up to read varargs */
		7704	va_start(marker, cnt);
		7705
		7706	/* no failures yet */
		7707	failed = FALSE;
		7708
		7709	/* scan the varargs list */
		7710	for (i = 0 ; i < cnt ; ++i)
		7711	{
		7712	/* get the next argument */
		7713	ext_ptr = va_arg(marker, char **);
		7714	hdl_ptr = va_arg(marker, uint *);
		7715
		7716	/* allocate a register */
		7717	*ext_ptr = alloc_temp_reg(vmg_ prec, hdl_ptr);
		7718
		7719	/* if this allocation failed, note it, but keep going for now */
		7720	if (*ext_ptr == 0)
		7721	failed = TRUE;
		7722	}
		7723
		7724	/* done reading argument */
		7725	va_end(marker);
		7726
		7727	/* if we had any failures, free all of the registers we allocated */
		7728	if (failed)
		7729	{
		7730	/* restart reading the varargs */
		7731	va_start(marker, cnt);
		7732
		7733	/* scan the varargs and free the successfully allocated registers */
		7734	for (i = 0 ; i < cnt ; ++i)
		7735	{
		7736	/* get the next argument */
		7737	ext_ptr = va_arg(marker, char **);
		7738	hdl_ptr = va_arg(marker, uint *);
		7739
		7740	/* free this register if we successfully allocated it */
		7741	if (*ext_ptr != 0)
		7742	release_temp_reg(vmg_ *hdl_ptr);
		7743	}
		7744
		7745	/* done reading varargs */
		7746	va_end(marker);
		7747
		7748	/* throw the error */
		7749	err_throw(VMERR_BIGNUM_NO_REGS);
		7750	}
		7751	}
		7752
		7753	/*
		7754	* Release a block of temporary registers
		7755	*/
		7756	void CVmObjBigNum::release_temp_regs(VMG_ size_t cnt, ...)
		7757	{
		7758	size_t i;
		7759	va_list marker;
		7760
		7761	/* start reading the varargs */
		7762	va_start(marker, cnt);
		7763
		7764	/* scan the varargs and free the listed registers */
		7765	for (i = 0 ; i < cnt ; ++i)
		7766	{
		7767	uint hdl;
		7768
		7769	/* get the next handle */
		7770	hdl = va_arg(marker, uint);
		7771
		7772	/* free this register */
		7773	release_temp_reg(vmg_ hdl);
		7774	}
		7775
		7776	/* done reading varargs */
		7777	va_end(marker);
		7778	}
		7779
		7780
		7781	/* ------------------------------------------------------------------------ */
		7782	/*
		7783	* Register cache
		7784	*/
		7785
		7786	/*
		7787	* initialize
		7788	*/
		7789	CVmBigNumCache::CVmBigNumCache(size_t max_regs)
		7790	{
		7791	CVmBigNumCacheReg *p;
		7792	size_t i;
		7793
		7794	/* allocate our register array */
		7795	reg_ = (CVmBigNumCacheReg )t3malloc(max_regs sizeof(reg_[0]));
		7796
		7797	/* remember the number of registers */
		7798	max_regs_ = max_regs;
		7799
		7800	/* clear the list heads */
		7801	free_reg_ = 0;
		7802	unalloc_reg_ = 0;
		7803
		7804	/* we haven't actually allocated any registers yet - clear them out */
		7805	for (p = reg_, i = max_regs ; i != 0 ; ++p, --i)
		7806	{
		7807	/* clear this register descriptor */
		7808	p->clear();
		7809
		7810	/* link it into the unallocated list */
		7811	p->nxt_ = unalloc_reg_;
		7812	unalloc_reg_ = p;
		7813	}
		7814
		7815	/* we haven't allocated the constants registers yet */
		7816	ln10_.clear();
		7817	pi_.clear();
		7818	e_.clear();
		7819	}
		7820
		7821	/*
		7822	* delete
		7823	*/
		7824	CVmBigNumCache::~CVmBigNumCache()
		7825	{
		7826	CVmBigNumCacheReg *p;
		7827	size_t i;
		7828
		7829	/* delete each of our allocated registers */
		7830	for (p = reg_, i = max_regs_ ; i != 0 ; ++p, --i)
		7831	p->free_mem();
		7832
		7833	/* free the register list array */
		7834	t3free(reg_);
		7835
		7836	/* free the constant value registers */
		7837	ln10_.free_mem();
		7838	pi_.free_mem();
		7839	e_.free_mem();
		7840	}
		7841
		7842	/*
		7843	* Allocate a register
		7844	*/
		7845	char CVmBigNumCache::alloc_reg(size_t siz, uint hdl)
		7846	{
		7847	CVmBigNumCacheReg *p;
		7848	CVmBigNumCacheReg *prv;
		7849
		7850	/*
		7851	* search the free list for an available register satisfying the
		7852	* size requirements
		7853	*/
		7854	for (p = free_reg_, prv = 0 ; p != 0 ; prv = p, p = p->nxt_)
		7855	{
		7856	/* if it satisfies the size requirements, return it */
		7857	if (p->siz_ >= siz)
		7858	{
		7859	/* unlink it from the free list */
		7860	if (prv == 0)
		7861	free_reg_ = p->nxt_;
		7862	else
		7863	prv->nxt_ = p->nxt_;
		7864
		7865	/* it's no longer in the free list */
		7866	p->nxt_ = 0;
		7867
		7868	/* return it */
		7869	*hdl = (uint)(p - reg_);
		7870	return p->buf_;
		7871	}
		7872	}
		7873
		7874	/*
		7875	* if there's an unallocated register, allocate it and use it;
		7876	* otherwise, reallocate the smallest free register
		7877	*/
		7878	if (unalloc_reg_ != 0)
		7879	{
		7880	/* use the first unallocated register */
		7881	p = unalloc_reg_;
		7882
		7883	/* unlink it from the list */
		7884	unalloc_reg_ = unalloc_reg_->nxt_;
		7885	}
		7886	else if (free_reg_ != 0)
		7887	{
		7888	CVmBigNumCacheReg *min_free_p;
		7889	CVmBigNumCacheReg *min_free_prv = 0;
		7890
		7891	/* search for the smallest free register */
		7892	for (min_free_p = 0, p = free_reg_, prv = 0 ; p != 0 ;
		7893	prv = p, p = p->nxt_)
		7894	{
		7895	/* if it's the smallest so far, remember it */
		7896	if (min_free_p == 0 \|\| p->siz_ < min_free_p->siz_)
		7897	{
		7898	/* remember it */
		7899	min_free_p = p;
		7900	min_free_prv = prv;
		7901	}
		7902	}
		7903
		7904	/* use the smallest register we found */
		7905	p = min_free_p;
		7906
		7907	/* unlink it from the list */
		7908	if (min_free_prv == 0)
		7909	free_reg_ = p->nxt_;
		7910	else
		7911	min_free_prv->nxt_ = p->nxt_;
		7912	}
		7913	else
		7914	{
		7915	/* there are no free registers - return failure */
		7916	return 0;
		7917	}
		7918
		7919	/*
		7920	* we found a register that was either previously unallocated, or
		7921	* was previously allocated but was too small - allocate or
		7922	* reallocate the register at the new size
		7923	*/
		7924	p->alloc_mem(siz);
		7925
		7926	/* return the new register */
		7927	*hdl = (uint)(p - reg_);
		7928	return p->buf_;
		7929	}
		7930
		7931	/*
		7932	* Release a register
		7933	*/
		7934	void CVmBigNumCache::release_reg(uint hdl)
		7935	{
		7936	CVmBigNumCacheReg *p = &reg_[hdl];
		7937
		7938	/* add the register to the free list */
		7939	p->nxt_ = free_reg_;
		7940	free_reg_ = p;
		7941	}
		7942
		7943	/*
		7944	* Release all registers
		7945	*/
		7946	void CVmBigNumCache::release_all()
		7947	{
		7948	size_t i;
		7949
		7950	/* mark each of our registers as not in use */
		7951	for (i = 0 ; i < max_regs_ ; ++i)
		7952	release_reg(i);
		7953	}

FrobTADS

cfad47cfa3/tads3/vmbignum.cpp