Diff | Source/Git

Download diff

	4b825dc642cb6eb9a060e54bf8d69288fbee4904		cfad47cfa334b206c65f22086bcc5d63e6f70944
		1	#ifdef RCSID
		2	static char RCSid[] =
		3	"$Header: d:/cvsroot/tads/tads3/VMLST.CPP,v 1.3 1999/05/17 02:52:28 MJRoberts Exp $";
		4	#endif
		5
		6	/*
		7	* Copyright (c) 1998, 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	vmlst.cpp - list metaclass
		15	Function
		16
		17	Notes
		18
		19	Modified
		20	10/29/98 MJRoberts - Creation
		21	*/
		22
		23	#include <stdlib.h>
		24	#include <string.h>
		25
		26	#include "t3std.h"
		27	#include "vmmcreg.h"
		28	#include "vmtype.h"
		29	#include "vmlst.h"
		30	#include "vmobj.h"
		31	#include "vmerr.h"
		32	#include "vmerrnum.h"
		33	#include "vmfile.h"
		34	#include "vmpool.h"
		35	#include "vmstack.h"
		36	#include "vmmeta.h"
		37	#include "vmrun.h"
		38	#include "vmbif.h"
		39	#include "vmpredef.h"
		40	#include "vmiter.h"
		41	#include "vmsort.h"
		42
		43
		44	/* ------------------------------------------------------------------------ */
		45	/*
		46	* statics
		47	*/
		48
		49	/* metaclass registration object */
		50	static CVmMetaclassList metaclass_reg_obj;
		51	CVmMetaclass *CVmObjList::metaclass_reg_ = &metaclass_reg_obj;
		52
		53	/* function table */
		54	int (CVmObjList::func_table_[])(VMG_ vm_val_t retval,
		55	const vm_val_t *self_val,
		56	const char lst, uint argc) =
		57	{
		58	&CVmObjList::getp_undef,
		59	&CVmObjList::getp_subset,
		60	&CVmObjList::getp_map,
		61	&CVmObjList::getp_len,
		62	&CVmObjList::getp_sublist,
		63	&CVmObjList::getp_intersect,
		64	&CVmObjList::getp_index_of,
		65	&CVmObjList::getp_car,
		66	&CVmObjList::getp_cdr,
		67	&CVmObjList::getp_index_which,
		68	&CVmObjList::getp_for_each,
		69	&CVmObjList::getp_val_which,
		70	&CVmObjList::getp_last_index_of,
		71	&CVmObjList::getp_last_index_which,
		72	&CVmObjList::getp_last_val_which,
		73	&CVmObjList::getp_count_of,
		74	&CVmObjList::getp_count_which,
		75	&CVmObjList::getp_get_unique,
		76	&CVmObjList::getp_append_unique,
		77	&CVmObjList::getp_append,
		78	&CVmObjList::getp_sort,
		79	&CVmObjList::getp_prepend,
		80	&CVmObjList::getp_insert_at,
		81	&CVmObjList::getp_remove_element_at,
		82	&CVmObjList::getp_remove_range,
		83	&CVmObjList::getp_for_each_assoc
		84	};
		85
		86
		87	/* ------------------------------------------------------------------------ */
		88	/*
		89	* Static creation methods. These routines allocate an object ID and
		90	* create a new list object.
		91	*/
		92
		93	/* create dynamically using stack arguments */
		94	vm_obj_id_t CVmObjList::create_from_stack(VMG_ const uchar **pc_ptr,
		95	uint argc)
		96	{
		97	vm_obj_id_t id;
		98	CVmObjList *lst;
		99	size_t idx;
		100
		101	/*
		102	* create the list - this type of construction is never used for
		103	* root set objects
		104	*/
		105	id = vm_new_id(vmg_ FALSE, TRUE, FALSE);
		106
		107	/* create a list with one element per argument */
		108	lst = new (vmg_ id) CVmObjList(vmg_ argc);
		109
		110	/* add each argument */
		111	for (idx = 0 ; idx < argc ; ++idx)
		112	{
		113	/* retrieve the next element from the stack and add it to the list */
		114	lst->cons_set_element(idx, G_stk->get(idx));
		115	}
		116
		117	/* discard the stack parameters */
		118	G_stk->discard(argc);
		119
		120	/* return the new object */
		121	return id;
		122	}
		123
		124	/*
		125	* create dynamically from the current method's parameters
		126	*/
		127	vm_obj_id_t CVmObjList::create_from_params(VMG_ uint param_idx, uint cnt)
		128	{
		129	vm_obj_id_t id;
		130	CVmObjList *lst;
		131	size_t idx;
		132
		133	/* create the new list object as a non-root-set object */
		134	id = vm_new_id(vmg_ FALSE, TRUE, FALSE);
		135	lst = new (vmg_ id) CVmObjList(vmg_ cnt);
		136
		137	/* copy each parameter into the new list */
		138	for (idx = 0 ; cnt != 0 ; --cnt, ++param_idx, ++idx)
		139	{
		140	/* retrieve the next element and add it to the list */
		141	lst->cons_set_element(idx,
		142	G_interpreter->get_param(vmg_ param_idx));
		143	}
		144
		145	/* return the new object */
		146	return id;
		147	}
		148
		149	/* create a list with no initial contents */
		150	vm_obj_id_t CVmObjList::create(VMG_ int in_root_set)
		151	{
		152	vm_obj_id_t id = vm_new_id(vmg_ in_root_set, TRUE, FALSE);
		153	new (vmg_ id) CVmObjList();
		154	return id;
		155	}
		156
		157	/* create a list with a given number of elements */
		158	vm_obj_id_t CVmObjList::create(VMG_ int in_root_set,
		159	size_t element_count)
		160	{
		161	vm_obj_id_t id = vm_new_id(vmg_ in_root_set, TRUE, FALSE);
		162	new (vmg_ id) CVmObjList(vmg_ element_count);
		163	return id;
		164	}
		165
		166	/* create a list by copying a constant list */
		167	vm_obj_id_t CVmObjList::create(VMG_ int in_root_set, const char *lst)
		168	{
		169	vm_obj_id_t id = vm_new_id(vmg_ in_root_set, TRUE, FALSE);
		170	new (vmg_ id) CVmObjList(vmg_ lst);
		171	return id;
		172	}
		173
		174	/* ------------------------------------------------------------------------ */
		175	/*
		176	* Constructors. These are called indirectly through our static
		177	* creation methods.
		178	*/
		179
		180	/*
		181	* create a list object from a constant list
		182	*/
		183	CVmObjList::CVmObjList(VMG_ const char *lst)
		184	{
		185	size_t cnt;
		186
		187	/* get the element count from the original list */
		188	cnt = vmb_get_len(lst);
		189
		190	/* allocate space */
		191	alloc_list(vmg_ cnt);
		192
		193	/* copy the list's contents */
		194	memcpy(ext_, lst, calc_alloc(cnt));
		195	}
		196
		197	/*
		198	* Create a list with a given number of elements. This can be used to
		199	* construct a list element-by-element.
		200	*/
		201	CVmObjList::CVmObjList(VMG_ size_t cnt)
		202	{
		203	/* allocate space */
		204	alloc_list(vmg_ cnt);
		205
		206	/*
		207	* Clear the list. Since the caller is responsible for populating the
		208	* list in this version of the constructor, it's possible that GC will
		209	* run between now and the time the list is fully populated. We must
		210	* initialize the list to ensure that we don't misinterpret the
		211	* contents as valid should we run GC between now and the time the
		212	* caller has finished populating the list. It's adequate to set the
		213	* list to all zeroes, since we won't try to interpret the contents as
		214	* valid if the type markers are all invalid.
		215	*/
		216	memset(ext_ + VMB_LEN, 0, calc_alloc(cnt) - VMB_LEN);
		217	}
		218
		219	/* ------------------------------------------------------------------------ */
		220	/*
		221	* allocate space for a list with a given number of elements
		222	*/
		223	void CVmObjList::alloc_list(VMG_ size_t cnt)
		224	{
		225	size_t alo;
		226
		227	/* calculate the allocation size */
		228	alo = calc_alloc(cnt);
		229
		230	/*
		231	* ensure we're within the limit (NB: this really is 65535 on ALL
		232	* PLATFORMS - this is a portable limit imposed by the storage format,
		233	* not a platform-specific size limit
		234	*/
		235	if (alo > 65535)
		236	{
		237	ext_ = 0;
		238	err_throw(VMERR_LIST_TOO_LONG);
		239	}
		240
		241	/* allocate space for the given number of elements */
		242	ext_ = (char *)G_mem->get_var_heap()->alloc_mem(alo, this);
		243
		244	/* set the element count */
		245	vmb_put_len(ext_, cnt);
		246	}
		247
		248	/* ------------------------------------------------------------------------ */
		249	/*
		250	* construction: set an element
		251	*/
		252	void CVmObjList::cons_set_element(size_t idx, const vm_val_t *val)
		253	{
		254	/* set the element's value */
		255	vmb_put_dh(get_element_ptr(idx), val);
		256	}
		257
		258	/*
		259	* construction: copy a list into our list
		260	*/
		261	void CVmObjList::cons_copy_elements(size_t idx, const char *orig_list)
		262	{
		263	/* copy the elements */
		264	memcpy(get_element_ptr(idx), orig_list + VMB_LEN,
		265	(vmb_get_len(orig_list) * VMB_DATAHOLDER));
		266	}
		267
		268	/*
		269	* construction: copy element data into our list
		270	*/
		271	void CVmObjList::cons_copy_data(size_t idx, const char *ele_array,
		272	size_t ele_count)
		273	{
		274	/* copy the elements */
		275	memcpy(get_element_ptr(idx), ele_array, ele_count * VMB_DATAHOLDER);
		276	}
		277
		278
		279	/* ------------------------------------------------------------------------ */
		280	/*
		281	* receive notification of deletion
		282	*/
		283	void CVmObjList::notify_delete(VMG_ int in_root_set)
		284	{
		285	/* free our extension */
		286	if (ext_ != 0 && !in_root_set)
		287	G_mem->get_var_heap()->free_mem(ext_);
		288	}
		289
		290	/* ------------------------------------------------------------------------ */
		291	/*
		292	* Set a property. Lists have no settable properties, so simply signal
		293	* an error indicating that the set-prop call is invalid.
		294	*/
		295	void CVmObjList::set_prop(VMG_ CVmUndo *, vm_obj_id_t,
		296	vm_prop_id_t, const vm_val_t *)
		297	{
		298	err_throw(VMERR_INVALID_SETPROP);
		299	}
		300
		301	/* ------------------------------------------------------------------------ */
		302	/*
		303	* Save the object to a file
		304	*/
		305	void CVmObjList::save_to_file(VMG_ CVmFile *fp)
		306	{
		307	size_t cnt;
		308
		309	/* get our element count */
		310	cnt = vmb_get_len(ext_);
		311
		312	/* write the count and the elements */
		313	fp->write_bytes(ext_, calc_alloc(cnt));
		314	}
		315
		316	/*
		317	* Restore the object from a file
		318	*/
		319	void CVmObjList::restore_from_file(VMG_ vm_obj_id_t,
		320	CVmFile fp, CVmObjFixup fixups)
		321	{
		322	size_t cnt;
		323
		324	/* read the element count */
		325	cnt = fp->read_uint2();
		326
		327	/* free any existing extension */
		328	if (ext_ != 0)
		329	{
		330	G_mem->get_var_heap()->free_mem(ext_);
		331	ext_ = 0;
		332	}
		333
		334	/* allocate the space */
		335	alloc_list(vmg_ cnt);
		336
		337	/* store our element count */
		338	vmb_put_len(ext_, cnt);
		339
		340	/* read the contents, if there are any elements */
		341	fp->read_bytes(ext_ + VMB_LEN, cnt * VMB_DATAHOLDER);
		342
		343	/* fix object references */
		344	fixups->fix_dh_array(vmg_ ext_ + VMB_LEN, cnt);
		345	}
		346
		347	/* ------------------------------------------------------------------------ */
		348	/*
		349	* Mark references
		350	*/
		351	void CVmObjList::mark_refs(VMG_ uint state)
		352	{
		353	size_t cnt;
		354	char *p;
		355
		356	/* get my element count */
		357	cnt = vmb_get_len(ext_);
		358
		359	/* mark as referenced each object in our list */
		360	for (p = get_element_ptr(0) ; cnt != 0 ; --cnt, inc_element_ptr(&p))
		361	{
		362	/*
		363	* if this is an object, mark it as referenced, and mark its
		364	* references as referenced
		365	*/
		366	if (vmb_get_dh_type(p) == VM_OBJ)
		367	G_obj_table->mark_all_refs(vmb_get_dh_obj(p), state);
		368	}
		369	}
		370
		371
		372	/* ------------------------------------------------------------------------ */
		373	/*
		374	* Add a value to the list. This yields a new list, with the value
		375	* appended to the existing list. If the value to be appended is itself
		376	* a list (constant or object), we'll append each element of that list
		377	* to our list (rather than appending a single element containing a
		378	* sublist).
		379	*/
		380	void CVmObjList::add_val(VMG_ vm_val_t *result,
		381	vm_obj_id_t self, const vm_val_t *val)
		382	{
		383	/*
		384	* Use the generic list adder, using my extension as the constant
		385	* list. We store our extension in the general list format required
		386	* by the static adder.
		387	*/
		388	add_to_list(vmg_ result, self, ext_, val);
		389	}
		390
		391	/*
		392	* Static list adder. This creates a new list object that results from
		393	* appending the given value to the given list constant. This is
		394	* defined statically so that this code can be shared for adding to
		395	* constant pool lists and adding to CVmObjList objects.
		396	*
		397	* 'lstval' must point to a constant list. The first two bytes of the
		398	* list are stored in portable UINT2 format and give the number of
		399	* elements in the list; this is immediately followed by a packed array
		400	* of data holders in portable format.
		401	*
		402	* Note that we always create a new object to hold the result, even if
		403	* the new string is identical to the first, so that we consistently
		404	* return a distinct reference from the original.
		405	*/
		406	void CVmObjList::add_to_list(VMG_ vm_val_t *result,
		407	vm_obj_id_t self, const char *lstval,
		408	const vm_val_t *rhs)
		409	{
		410	size_t lhs_cnt, rhs_cnt;
		411	vm_obj_id_t obj;
		412	CVmObjList *objptr;
		413	size_t i;
		414
		415	/* push self and the other list for protection against GC */
		416	G_stk->push()->set_obj(self);
		417	G_stk->push(rhs);
		418
		419	/* get the number of elements in the left-hand ('self') side */
		420	lhs_cnt = vmb_get_len(lstval);
		421
		422	/* get the number of elements the right-hand side concatenates */
		423	rhs_cnt = rhs->get_coll_addsub_rhs_ele_cnt(vmg0_);
		424
		425	/* allocate a new object to hold the new list */
		426	obj = create(vmg_ FALSE, lhs_cnt + rhs_cnt);
		427	objptr = (CVmObjList *)vm_objp(vmg_ obj);
		428
		429	/* copy the first list into the new object's list buffer */
		430	objptr->cons_copy_elements(0, lstval);
		431
		432	/* add each value from the right-hand side */
		433	for (i = 0 ; i < rhs_cnt ; ++i)
		434	{
		435	vm_val_t val;
		436
		437	/* retrieve this element of the rhs (adjusting to a 1-based index) */
		438	rhs->get_coll_addsub_rhs_ele(vmg_ i + 1, &val);
		439
		440	/* store the element in the new list */
		441	objptr->cons_set_element(lhs_cnt + i, &val);
		442	}
		443
		444	/* set the result to the new list */
		445	result->set_obj(obj);
		446
		447	/* discard the GC protection items */
		448	G_stk->discard(2);
		449	}
		450
		451	/* ------------------------------------------------------------------------ */
		452	/*
		453	* Subtract a value from the list.
		454	*/
		455	void CVmObjList::sub_val(VMG_ vm_val_t *result,
		456	vm_obj_id_t self, const vm_val_t *val)
		457	{
		458	vm_val_t self_val;
		459
		460	/*
		461	* Invoke our static list subtraction routine, using our extension
		462	* as the constant list. Our extension is stored in the same format
		463	* as a constant list, so we can use the same code to handle
		464	* subtraction from a list object as we would for subtraction from a
		465	* constant list.
		466	*/
		467	self_val.set_obj(self);
		468	sub_from_list(vmg_ result, &self_val, ext_, val);
		469	}
		470
		471	/*
		472	* Subtract a value from a constant list.
		473	*/
		474	void CVmObjList::sub_from_list(VMG_ vm_val_t *result,
		475	const vm_val_t lstval, const char lstmem,
		476	const vm_val_t *rhs)
		477	{
		478	size_t lhs_cnt, rhs_cnt;
		479	vm_obj_id_t obj;
		480	CVmObjList *objptr;
		481	size_t i;
		482	char *dst;
		483	size_t dst_cnt;
		484
		485	/* push self and the other list for protection against GC */
		486	G_stk->push(lstval);
		487	G_stk->push(rhs);
		488
		489	/* get the number of elements in the right-hand side */
		490	lhs_cnt = vmb_get_len(lstmem);
		491
		492	/*
		493	* allocate a new object to hold the new list, which will be no
		494	* bigger than the original left-hand side, since we're doing
		495	* nothing but (possibly) taking elements out
		496	*/
		497	obj = create(vmg_ FALSE, lhs_cnt);
		498	objptr = (CVmObjList *)vm_objp(vmg_ obj);
		499
		500	/* get the number of elements to consider from the right-hand side */
		501	rhs_cnt = rhs->get_coll_addsub_rhs_ele_cnt(vmg0_);
		502
		503	/* copy the first list into the new object's list buffer */
		504	objptr->cons_copy_elements(0, lstmem);
		505
		506	/* consider each element of the left-hand side */
		507	for (i = 0, dst = objptr->get_element_ptr(0), dst_cnt = 0 ;
		508	i < lhs_cnt ; ++i)
		509	{
		510	vm_val_t src_val;
		511	int keep;
		512	size_t j;
		513
		514	/*
		515	* if our list is from constant memory, get its address again --
		516	* the address could have changed due to swapping if we
		517	* traversed into another list
		518	*/
		519	VM_IF_SWAPPING_POOL(if (lstval != 0 && lstval->typ == VM_LIST)
		520	lstmem = G_const_pool->get_ptr(lstval->val.ofs));
		521
		522	/* get this element */
		523	vmb_get_dh(get_element_ptr_const(lstmem, i), &src_val);
		524
		525	/* presume we'll keep it */
		526	keep = TRUE;
		527
		528	/*
		529	* scan the right side to see if we can find this value - if we
		530	* can, it's to be removed, so we don't want to copy it to the
		531	* result list
		532	*/
		533	for (j = 0 ; j < rhs_cnt ; ++j)
		534	{
		535	vm_val_t rem_val;
		536
		537	/* retrieve this rhs value (using a 1-based index) */
		538	rhs->get_coll_addsub_rhs_ele(vmg_ j + 1, &rem_val);
		539
		540	/* if this value matches, we're removing it */
		541	if (rem_val.equals(vmg_ &src_val))
		542	{
		543	/* it's to be removed */
		544	keep = FALSE;
		545
		546	/* no need to look any further in the rhs list */
		547	break;
		548	}
		549	}
		550
		551	/* if we're keeping the value, put it in the result list */
		552	if (keep)
		553	{
		554	/* store it in the result list */
		555	vmb_put_dh(dst, &src_val);
		556
		557	/* advance the result pointer */
		558	inc_element_ptr(&dst);
		559
		560	/* count it */
		561	++dst_cnt;
		562	}
		563	}
		564
		565	/* set the length of the result list */
		566	objptr->cons_set_len(dst_cnt);
		567
		568	/* set the result to the new list */
		569	result->set_obj(obj);
		570
		571	/* discard the GC protection items */
		572	G_stk->discard(2);
		573	}
		574
		575	/* ------------------------------------------------------------------------ */
		576	/*
		577	* Index the list
		578	*/
		579	void CVmObjList::index_val(VMG_ vm_val_t result, vm_obj_id_t /self*/,
		580	const vm_val_t *index_val)
		581	{
		582	/*
		583	* use the constant list indexing routine, using our extension data
		584	* as the list data
		585	*/
		586	index_list(vmg_ result, ext_, index_val);
		587	}
		588
		589	/* ------------------------------------------------------------------------ */
		590	/*
		591	* Index a constant list
		592	*/
		593	void CVmObjList::index_list(VMG_ vm_val_t result, const char lst,
		594	const vm_val_t *index_val)
		595	{
		596	uint32 idx;
		597
		598	/* get the index value as an integer */
		599	idx = index_val->num_to_int();
		600
		601	/* index the list */
		602	index_list(vmg_ result, lst, idx);
		603	}
		604
		605	/*
		606	* Index a constant list by an integer value
		607	*/
		608	void CVmObjList::index_list(VMG_ vm_val_t result, const char lst, uint idx)
		609	{
		610	/* make sure it's in range - 1 to our element count, inclusive */
		611	if (idx < 1 \|\| idx > vmb_get_len(lst))
		612	err_throw(VMERR_INDEX_OUT_OF_RANGE);
		613
		614	/*
		615	* get the indexed element and store it in the result, adjusting the
		616	* index to the C-style 0-based range
		617	*/
		618	get_element_const(lst, idx - 1, result);
		619	}
		620
		621	/* ------------------------------------------------------------------------ */
		622	/*
		623	* Set an element of the list
		624	*/
		625	void CVmObjList::set_index_val(VMG_ vm_val_t *result, vm_obj_id_t self,
		626	const vm_val_t *index_val,
		627	const vm_val_t *new_val)
		628	{
		629	/* put the list on the stack to avoid garbage collection */
		630	G_stk->push()->set_obj(self);
		631
		632	/*
		633	* use the constant list set-index routine, using our extension data
		634	* as the list data
		635	*/
		636	set_index_list(vmg_ result, ext_, index_val, new_val);
		637
		638	/* discard the GC protection */
		639	G_stk->discard();
		640	}
		641
		642	/* ------------------------------------------------------------------------ */
		643	/*
		644	* Set an element in a constant list
		645	*/
		646	void CVmObjList::set_index_list(VMG_ vm_val_t result, const char lst,
		647	const vm_val_t *index_val,
		648	const vm_val_t *new_val)
		649	{
		650	uint32 idx;
		651	CVmObjList *obj;
		652
		653	/* get the index value as an integer */
		654	idx = index_val->num_to_int();
		655
		656	/* push the new value for gc protection during the create */
		657	G_stk->push(new_val);
		658
		659	/* make sure it's in range - 1 to our element count, inclusive */
		660	if (idx < 1 \|\| idx > vmb_get_len(lst))
		661	err_throw(VMERR_INDEX_OUT_OF_RANGE);
		662
		663	/* create a new list as a copy of this list */
		664	result->set_obj(create(vmg_ FALSE, lst));
		665
		666	/* get the new list object */
		667	obj = (CVmObjList *)vm_objp(vmg_ result->val.obj);
		668
		669	/* update the element of the new list */
		670	obj->cons_set_element(idx - 1, new_val);
		671
		672	/* discard our gc protection */
		673	G_stk->discard();
		674	}
		675
		676	/* ------------------------------------------------------------------------ */
		677	/*
		678	* Check a value for equality
		679	*/
		680	int CVmObjList::equals(VMG_ vm_obj_id_t self, const vm_val_t *val,
		681	int depth) const
		682	{
		683	/* if it's a reference to myself, we certainly match */
		684	if (val->typ == VM_OBJ && val->val.obj == self)
		685	return TRUE;
		686
		687	/*
		688	* compare via the constant list comparison routine, using our
		689	* extension data as the list data
		690	*/
		691	return const_equals(vmg_ 0, ext_, val, depth);
		692	}
		693
		694	/* ------------------------------------------------------------------------ */
		695	/*
		696	* Constant list comparison routine
		697	*/
		698	int CVmObjList::const_equals(VMG_ const vm_val_t lstval, const char lstmem,
		699	const vm_val_t *val, int depth)
		700	{
		701	const char *lstmem2;
		702	const vm_val_t *lstval2;
		703	size_t cnt;
		704	size_t idx;
		705
		706	/* get the list underlying the other value */
		707	lstmem2 = val->get_as_list(vmg0_);
		708	lstval2 = val;
		709
		710	/* if it doesn't have an underlying list, it doesn't match */
		711	if (lstmem2 == 0)
		712	return FALSE;
		713
		714	/* if the lists don't have the same length, they don't match */
		715	cnt = vmb_get_len(lstmem);
		716	if (cnt != vmb_get_len(lstmem2))
		717	return FALSE;
		718
		719	/* compare each element in the list */
		720	for (idx = 0 ; idx < cnt ; ++idx)
		721	{
		722	vm_val_t val1;
		723	vm_val_t val2;
		724
		725	/*
		726	* if either list comes from constant memory, re-translate its
		727	* pointer, in case we did any swapping while traversing the
		728	* previous element
		729	*/
		730	VM_IF_SWAPPING_POOL(if (lstval != 0 && lstval->typ == VM_LIST)
		731	lstmem = G_const_pool->get_ptr(lstval->val.ofs));
		732	VM_IF_SWAPPING_POOL(if (lstval2 != 0 && lstval2->typ == VM_LIST)
		733	lstmem2 = G_const_pool->get_ptr(lstval2->val.ofs));
		734
		735	/* get the two elements */
		736	vmb_get_dh(get_element_ptr_const(lstmem, idx), &val1);
		737	vmb_get_dh(get_element_ptr_const(lstmem2, idx), &val2);
		738
		739	/*
		740	* If these elements don't match, the lists don't match. Note that
		741	* lists can't contain circular references (by their very nature as
		742	* immutable objects), so we don't need to increase the depth.
		743	*/
		744	if (!val1.equals(vmg_ &val2, depth))
		745	return FALSE;
		746	}
		747
		748	/* if we got here, we didn't find any differences, so they match */
		749	return TRUE;
		750	}
		751
		752	/* ------------------------------------------------------------------------ */
		753	/*
		754	* Hash value calculation
		755	*/
		756	uint CVmObjList::calc_hash(VMG_ vm_obj_id_t self, int depth) const
		757	{
		758	vm_val_t self_val;
		759
		760	/* set up our 'self' value pointer */
		761	self_val.set_obj(self);
		762
		763	/* calculate the value */
		764	return const_calc_hash(vmg_ &self_val, ext_, depth);
		765	}
		766
		767	/*
		768	* Hash value calculation
		769	*/
		770	uint CVmObjList::const_calc_hash(VMG_ const vm_val_t *self_val,
		771	const char *lst, int depth)
		772	{
		773	size_t len;
		774	size_t i;
		775	uint hash;
		776
		777	/* get and skip the length prefix */
		778	len = vmb_get_len(lst);
		779
		780	/* calculate a hash combining the hash of each element in the list */
		781	for (hash = 0, i = 0 ; i < len ; ++i)
		782	{
		783	vm_val_t ele;
		784
		785	/* re-translate in case of swapping */
		786	VM_IF_SWAPPING_POOL(if (self_val->typ == VM_LIST)
		787	lst = G_const_pool->get_ptr(self_val->val.ofs));
		788
		789	/* get this element */
		790	get_element_const(lst, i, &ele);
		791
		792	/*
		793	* Compute its hash value and add it into the total. Note that
		794	* even though we're recursively calculating the hash of an
		795	* element, we don't need to increase the recursion depth, because
		796	* it's impossible for a list to have cycles.
		797	*
		798	* (It's not possible for a list to have cycles because a list is
		799	* always constructed with its contents, and can never be changed.
		800	* This means that there's no possibility of storing a reference to
		801	* the new list inside the list itself, or inside any other list
		802	* the list refers to. It is possible to put the reference to
		803	* the new list in a mutable object to which the list refers, but
		804	* in such cases, that mutable object will be capable of having
		805	* cycles in its references, so it will be responsible for
		806	* increasing the depth counter when it recurses.)
		807	*/
		808	hash += ele.calc_hash(vmg_ depth);
		809	}
		810
		811	/* return the hash value */
		812	return hash;
		813	}
		814
		815
		816	/* ------------------------------------------------------------------------ */
		817	/*
		818	* Find a value in a list
		819	*/
		820	int CVmObjList::find_in_list(VMG_ const vm_val_t *lst,
		821	const vm_val_t val, size_t idxp)
		822	{
		823	const char *lstmem;
		824	size_t cnt;
		825	size_t idx;
		826
		827	/* get the list underyling this value */
		828	lstmem = lst->get_as_list(vmg0_);
		829
		830	/* get the length of the list */
		831	cnt = vmb_get_len(lstmem);
		832
		833	/* scan the list for the value */
		834	for (idx = 0 ; idx < cnt ; ++idx)
		835	{
		836	vm_val_t curval;
		837
		838	/*
		839	* re-translate the list pointer if it's in constant memory, in
		840	* case we did any swapping on the last iteratino
		841	*/
		842	VM_IF_SWAPPING_POOL(if (lst->typ == VM_LIST)
		843	lstmem = G_const_pool->get_ptr(lst->val.ofs));
		844
		845	/* get this list element */
		846	vmb_get_dh(get_element_ptr_const(lstmem, idx), &curval);
		847
		848	/* compare this value to the one we're looking for */
		849	if (curval.equals(vmg_ val))
		850	{
		851	/* this is the one - set the return index */
		852	if (idxp != 0)
		853	*idxp = idx;
		854
		855	/* indicate that we found the value */
		856	return TRUE;
		857	}
		858	}
		859
		860	/* we didn't find the value */
		861	return FALSE;
		862	}
		863
		864	/*
		865	* Find the last match for a value in a list
		866	*/
		867	int CVmObjList::find_last_in_list(VMG_ const vm_val_t *lst,
		868	const vm_val_t val, size_t idxp)
		869	{
		870	const char *lstmem;
		871	size_t cnt;
		872	size_t idx;
		873
		874	/* get the list underyling this value */
		875	lstmem = lst->get_as_list(vmg0_);
		876
		877	/* get the length of the list */
		878	cnt = vmb_get_len(lstmem);
		879
		880	/* scan the list for the value */
		881	for (idx = cnt ; idx != 0 ; --idx)
		882	{
		883	vm_val_t curval;
		884
		885	/*
		886	* re-translate the list pointer if it's in constant memory, in
		887	* case we did any swapping on the last iteratino
		888	*/
		889	VM_IF_SWAPPING_POOL(if (lst->typ == VM_LIST)
		890	lstmem = G_const_pool->get_ptr(lst->val.ofs));
		891
		892	/* get this list element */
		893	vmb_get_dh(get_element_ptr_const(lstmem, idx), &curval);
		894
		895	/* compare this value to the one we're looking for */
		896	if (curval.equals(vmg_ val))
		897	{
		898	/* this is the one - set the return index */
		899	if (idxp != 0)
		900	*idxp = idx;
		901
		902	/* indicate that we found the value */
		903	return TRUE;
		904	}
		905	}
		906
		907	/* we didn't find the value */
		908	return FALSE;
		909	}
		910
		911	/* ------------------------------------------------------------------------ */
		912	/*
		913	* Compute the intersection of two lists. Returns a new list with the
		914	* elements that occur in both lists.
		915	*/
		916	vm_obj_id_t CVmObjList::intersect(VMG_ const vm_val_t *lst1,
		917	const vm_val_t *lst2)
		918	{
		919	const char *lstmem1;
		920	const char *lstmem2;
		921	size_t cnt1;
		922	size_t cnt2;
		923	size_t idx;
		924	vm_obj_id_t resobj;
		925	CVmObjList *reslst;
		926	size_t residx;
		927
		928	/* get the two list memory blocks */
		929	lstmem1 = lst1->get_as_list(vmg0_);
		930	lstmem2 = lst2->get_as_list(vmg0_);
		931
		932	/* get the lengths of the lists */
		933	cnt1 = vmb_get_len(lstmem1);
		934	cnt2 = vmb_get_len(lstmem2);
		935
		936	/* if the first list is larger than the second, swap them */
		937	if (cnt1 > cnt2)
		938	{
		939	const vm_val_t *tmp;
		940
		941	/* swap the vm_val_t pointers */
		942	tmp = lst1;
		943	lst1 = lst2;
		944	lst2 = tmp;
		945
		946	/*
		947	* momentarily forget the larger count and memory pointer, and
		948	* copy the smaller count into cnt1
		949	*/
		950	cnt1 = cnt2;
		951	lstmem1 = lstmem2;
		952	}
		953
		954	/*
		955	* Allocate our result list. The result list can't have any more
		956	* elements in it than the shorter of the two lists, whose length is
		957	* now in cnt1.
		958	*/
		959	resobj = create(vmg_ FALSE, cnt1);
		960	reslst = (CVmObjList *)vm_objp(vmg_ resobj);
		961
		962	/* we haven't put any elements in the result list yet */
		963	residx = 0;
		964
		965	/*
		966	* for each element in the first list, find the element in the
		967	* second list
		968	*/
		969	for (idx = 0 ; idx < cnt1 ; ++idx)
		970	{
		971	vm_val_t curval;
		972
		973	/* re-translate the first list address in case of swapping */
		974	if (lst1->typ == VM_LIST)
		975	lstmem1 = lst1->get_as_list(vmg0_);
		976
		977	/* get this element from the first list */
		978	vmb_get_dh(get_element_ptr_const(lstmem1, idx), &curval);
		979
		980	/* find the element in the second list */
		981	if (find_in_list(vmg_ lst2, &curval, 0))
		982	{
		983	/* we found it - copy it into the result list */
		984	reslst->cons_set_element(residx, &curval);
		985
		986	/* count the new entry in the result list */
		987	++residx;
		988	}
		989	}
		990
		991	/*
		992	* set the actual result length, which might be shorter than the
		993	* amount we allocated
		994	*/
		995	reslst->cons_set_len(residx);
		996
		997	/* return the result list */
		998	return resobj;
		999	}
		1000
		1001	/* ------------------------------------------------------------------------ */
		1002	/*
		1003	* Uniquify the list; modifies the list in place, so this can only be
		1004	* used during construction of a new list
		1005	*/
		1006	void CVmObjList::cons_uniquify(VMG0_)
		1007	{
		1008	size_t cnt;
		1009	size_t src, dst;
		1010
		1011	/* get the length of the list */
		1012	cnt = vmb_get_len(ext_);
		1013
		1014	/* loop through the list and look for repeated values */
		1015	for (src = dst = 0 ; src < cnt ; ++src)
		1016	{
		1017	size_t idx;
		1018	vm_val_t src_val;
		1019	int found;
		1020
		1021	/*
		1022	* look for a copy of this source value already in the output
		1023	* list
		1024	*/
		1025	index_list(vmg_ &src_val, ext_, src + 1);
		1026	for (idx = 0, found = FALSE ; idx < dst ; ++idx)
		1027	{
		1028	vm_val_t idx_val;
		1029
		1030	/* get this value */
		1031	index_list(vmg_ &idx_val, ext_, idx + 1);
		1032
		1033	/* if it's equal to the current source value, note it */
		1034	if (src_val.equals(vmg_ &idx_val))
		1035	{
		1036	/* note that we found it */
		1037	found = TRUE;
		1038
		1039	/* no need to look any further */
		1040	break;
		1041	}
		1042	}
		1043
		1044	/* if we didn't find the value, copy it to the output list */
		1045	if (!found)
		1046	{
		1047	/* add it to the output list */
		1048	cons_set_element(dst, &src_val);
		1049
		1050	/* count it */
		1051	++dst;
		1052	}
		1053	}
		1054
		1055	/* adjust the size of the result list */
		1056	cons_set_len(dst);
		1057	}
		1058
		1059	/* ------------------------------------------------------------------------ */
		1060	/*
		1061	* Create an iterator
		1062	*/
		1063	void CVmObjList::new_iterator(VMG_ vm_val_t *retval,
		1064	const vm_val_t *self_val)
		1065	{
		1066	size_t len;
		1067
		1068	/* get the number of elements in the list */
		1069	len = vmb_get_len(self_val->get_as_list(vmg0_));
		1070
		1071	/*
		1072	* Set up a new indexed iterator object. The first valid index for
		1073	* a list is always 1, and the last valid index is the same as the
		1074	* number of elements in the list.
		1075	*/
		1076	retval->set_obj(CVmObjIterIdx::create_for_coll(vmg_ self_val, 1, len));
		1077	}
		1078
		1079	/* ------------------------------------------------------------------------ */
		1080	/*
		1081	* Evaluate a property
		1082	*/
		1083	int CVmObjList::get_prop(VMG_ vm_prop_id_t prop, vm_val_t *retval,
		1084	vm_obj_id_t self, vm_obj_id_t *source_obj,
		1085	uint *argc)
		1086	{
		1087	vm_val_t self_val;
		1088
		1089	/* use the constant evaluator */
		1090	self_val.set_obj(self);
		1091	if (const_get_prop(vmg_ retval, &self_val, ext_, prop, source_obj, argc))
		1092	{
		1093	*source_obj = metaclass_reg_->get_class_obj(vmg0_);
		1094	return TRUE;
		1095	}
		1096
		1097	/* inherit default handling from the base object class */
		1098	return CVmObjCollection::get_prop(vmg_ prop, retval, self,
		1099	source_obj, argc);
		1100	}
		1101
		1102	/* ------------------------------------------------------------------------ */
		1103	/*
		1104	* Evaluate a property of a constant list value
		1105	*/
		1106	int CVmObjList::const_get_prop(VMG_ vm_val_t *retval,
		1107	const vm_val_t self_val, const char lst,
		1108	vm_prop_id_t prop, vm_obj_id_t *src_obj,
		1109	uint *argc)
		1110	{
		1111	uint func_idx;
		1112
		1113	/* presume no source object */
		1114	*src_obj = VM_INVALID_OBJ;
		1115
		1116	/* translate the property index to an index into our function table */
		1117	func_idx = G_meta_table
		1118	->prop_to_vector_idx(metaclass_reg_->get_reg_idx(), prop);
		1119
		1120	/* call the appropriate function */
		1121	if ((*func_table_[func_idx])(vmg_ retval, self_val, lst, argc))
		1122	return TRUE;
		1123
		1124	/*
		1125	* If this is a constant list (which is indicated by a non-object type
		1126	* 'self'), try inheriting the default object interpretation, passing
		1127	* the constant list placeholder object for its type information.
		1128	*/
		1129	if (self_val->typ != VM_OBJ)
		1130	{
		1131	/* try going to our base class, CVmCollection */
		1132	if (((CVmObjCollection *)vm_objp(vmg_ G_predef->const_lst_obj))
		1133	->const_get_coll_prop(vmg_ prop, retval, self_val, src_obj, argc))
		1134	return TRUE;
		1135
		1136	/* try going to our next base class, CVmObject */
		1137	if (vm_objp(vmg_ G_predef->const_lst_obj)
		1138	->CVmObject::get_prop(vmg_ prop, retval, G_predef->const_lst_obj,
		1139	src_obj, argc))
		1140	return TRUE;
		1141	}
		1142
		1143	/* not handled */
		1144	return FALSE;
		1145	}
		1146
		1147	/* ------------------------------------------------------------------------ */
		1148	/*
		1149	* property evaluator - select a subset through a callback
		1150	*/
		1151	int CVmObjList::getp_subset(VMG_ vm_val_t retval, const vm_val_t self_val,
		1152	const char lst, uint argc)
		1153	{
		1154	const vm_val_t *func_val;
		1155	size_t src;
		1156	size_t dst;
		1157	size_t cnt;
		1158	char *new_lst;
		1159	CVmObjList *new_lst_obj;
		1160	static CVmNativeCodeDesc desc(1);
		1161
		1162	/* check arguments */
		1163	if (get_prop_check_argc(retval, argc, &desc))
		1164	return TRUE;
		1165
		1166	/* get the function pointer argument, but leave it on the stack */
		1167	func_val = G_stk->get(0);
		1168
		1169	/* push a self-reference while allocating to protect from gc */
		1170	G_stk->push(self_val);
		1171
		1172	/*
		1173	* Make a copy of our list for the return value. The result value
		1174	* will be at most the same size as our current list; since we have
		1175	* no way of knowing exactly how large it will be, and since we
		1176	* don't want to run through the selection functions twice, we'll
		1177	* just allocate at the maximum size and leave it partially unused
		1178	* if we don't need all of the space. By making a copy of the input
		1179	* list, we also can avoid worrying about whether the input list was
		1180	* a constant, and hence we don't have to worry about the
		1181	* possibility of constant page swapping.
		1182	*/
		1183	retval->set_obj(create(vmg_ FALSE, lst));
		1184
		1185	/* get the return value list data */
		1186	new_lst_obj = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		1187	new_lst = new_lst_obj->ext_;
		1188
		1189	/* get the length of the list */
		1190	cnt = vmb_get_len(new_lst);
		1191
		1192	/*
		1193	* push a reference to the new list to protect it from the garbage
		1194	* collector, which could be invoked in the course of executing the
		1195	* user callback
		1196	*/
		1197	G_stk->push(retval);
		1198
		1199	/*
		1200	* Go through each element of our list, and invoke the callback on
		1201	* each element. If the element passes, write it to the current
		1202	* output location in the list; otherwise, just skip it.
		1203	*
		1204	* Note that we're using the same list as source and destination,
		1205	* which is easy because the list will either shrink or stay the
		1206	* same - we'll never need to insert new elements.
		1207	*/
		1208	for (src = dst = 0 ; src < cnt ; ++src)
		1209	{
		1210	vm_val_t ele;
		1211	const vm_val_t *val;
		1212
		1213	/*
		1214	* get this element (using a 1-based index), and push it as the
		1215	* callback's argument
		1216	*/
		1217	index_list(vmg_ &ele, new_lst, src + 1);
		1218	G_stk->push(&ele);
		1219
		1220	/* invoke the callback */
		1221	G_interpreter->call_func_ptr(vmg_ func_val, 1, "list.subset", 0);
		1222
		1223	/* get the result from R0 */
		1224	val = G_interpreter->get_r0();
		1225
		1226	/*
		1227	* if the callback returned non-nil and non-zero, include this
		1228	* element in the result
		1229	*/
		1230	if (val->typ == VM_NIL
		1231	\|\| (val->typ == VM_INT && val->val.intval == 0))
		1232	{
		1233	/* it's nil or zero - don't include it in the result */
		1234	}
		1235	else
		1236	{
		1237	/* include this element in the result */
		1238	new_lst_obj->cons_set_element(dst, &ele);
		1239
		1240	/* advance the output index */
		1241	++dst;
		1242	}
		1243	}
		1244
		1245	/*
		1246	* set the result list length to the number of elements we actually
		1247	* copied
		1248	*/
		1249	new_lst_obj->cons_set_len(dst);
		1250
		1251	/* discard our gc protection (self, return value) and our arguments */
		1252	G_stk->discard(3);
		1253
		1254	/* handled */
		1255	return TRUE;
		1256	}
		1257
		1258
		1259	/* ------------------------------------------------------------------------ */
		1260	/*
		1261	* property evaluator - map through a callback
		1262	*/
		1263	int CVmObjList::getp_map(VMG_ vm_val_t retval, const vm_val_t self_val,
		1264	const char lst, uint argc)
		1265	{
		1266	const vm_val_t *func_val;
		1267	size_t cnt;
		1268	size_t idx;
		1269	char *new_lst;
		1270	CVmObjList *new_lst_obj;
		1271	static CVmNativeCodeDesc desc(1);
		1272
		1273	/* check arguments */
		1274	if (get_prop_check_argc(retval, argc, &desc))
		1275	return TRUE;
		1276
		1277	/* get the function pointer argument, but leave it on the stack */
		1278	func_val = G_stk->get(0);
		1279
		1280	/* push a self-reference while allocating to protect from gc */
		1281	G_stk->push(self_val);
		1282
		1283	/*
		1284	* Make a copy of our list for the return value, since the result
		1285	* value is always the same size as our current list. By making a
		1286	* copy of the input list, we also can avoid worrying about whether
		1287	* the input list was a constant, and hence we don't have to worry
		1288	* about the possibility of constant page swapping - we'll just
		1289	* update elements of the copy in-place.
		1290	*/
		1291	retval->set_obj(create(vmg_ FALSE, lst));
		1292
		1293	/* get the return value list data */
		1294	new_lst_obj = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		1295	new_lst = new_lst_obj->ext_;
		1296
		1297	/* get the length of the list */
		1298	cnt = vmb_get_len(new_lst);
		1299
		1300	/*
		1301	* push a reference to the new list to protect it from the garbage
		1302	* collector, which could be invoked in the course of executing the
		1303	* user callback
		1304	*/
		1305	G_stk->push(retval);
		1306
		1307	/*
		1308	* Go through each element of our list, and invoke the callback on
		1309	* each element. Replace each element with the result of the
		1310	* callback.
		1311	*/
		1312	for (idx = 0 ; idx < cnt ; ++idx)
		1313	{
		1314	/*
		1315	* get this element (using a 1-based index), and push it as the
		1316	* callback's argument
		1317	*/
		1318	index_and_push(vmg_ new_lst, idx + 1);
		1319
		1320	/* invoke the callback */
		1321	G_interpreter->call_func_ptr(vmg_ func_val, 1, "list.mapAll", 0);
		1322
		1323	/* store the result in the list */
		1324	new_lst_obj->cons_set_element(idx, G_interpreter->get_r0());
		1325	}
		1326
		1327	/* discard our gc protection (self, return value) and our arguments */
		1328	G_stk->discard(3);
		1329
		1330	/* handled */
		1331	return TRUE;
		1332	}
		1333
		1334	/* ------------------------------------------------------------------------ */
		1335	/*
		1336	* property evaluator - length
		1337	*/
		1338	int CVmObjList::getp_len(VMG_ vm_val_t retval, const vm_val_t self_val,
		1339	const char lst, uint argc)
		1340	{
		1341	static CVmNativeCodeDesc desc(0);
		1342
		1343	/* check arguments */
		1344	if (get_prop_check_argc(retval, argc, &desc))
		1345	return TRUE;
		1346
		1347	/* return the element count */
		1348	retval->set_int(vmb_get_len(lst));
		1349
		1350	/* handled */
		1351	return TRUE;
		1352	}
		1353
		1354	/* ------------------------------------------------------------------------ */
		1355	/*
		1356	* property evaluator - sublist
		1357	*/
		1358	int CVmObjList::getp_sublist(VMG_ vm_val_t retval, const vm_val_t self_val,
		1359	const char lst, uint in_argc)
		1360	{
		1361	uint argc = (in_argc != 0 ? *in_argc : 0);
		1362	ulong start;
		1363	ulong len;
		1364	vm_obj_id_t obj;
		1365	size_t old_cnt;
		1366	size_t new_cnt;
		1367	static CVmNativeCodeDesc desc(1, 1);
		1368
		1369	/* check arguments */
		1370	if (get_prop_check_argc(retval, in_argc, &desc))
		1371	return TRUE;
		1372
		1373	/* get the original element count */
		1374	old_cnt = vmb_get_len(lst);
		1375
		1376	/* pop the starting index */
		1377	start = CVmBif::pop_long_val(vmg0_);
		1378
		1379	/*
		1380	* pop the length, if present; if not, use the current element
		1381	* count, which will ensure that we use all available elements of
		1382	* the sublist
		1383	*/
		1384	if (argc >= 2)
		1385	len = CVmBif::pop_long_val(vmg0_);
		1386	else
		1387	len = old_cnt;
		1388
		1389	/* push the 'self' as protection from GC */
		1390	G_stk->push(self_val);
		1391
		1392	/* skip to the first element */
		1393	lst += VMB_LEN;
		1394
		1395	/* skip to the desired first element */
		1396	if (start >= 1 && start <= old_cnt)
		1397	{
		1398	/* it's in range - skip to the desired first element */
		1399	lst += (start - 1) * VMB_DATAHOLDER;
		1400	new_cnt = old_cnt - (start - 1);
		1401	}
		1402	else
		1403	{
		1404	/* there's nothing left */
		1405	new_cnt = 0;
		1406	}
		1407
		1408	/*
		1409	* limit the result to the desired new count, if it's shorter than
		1410	* what we have left (we obviously can't give them more elements
		1411	* than we have remaining)
		1412	*/
		1413	if (len < new_cnt)
		1414	new_cnt = (size_t)len;
		1415
		1416	/* create the new list */
		1417	obj = create(vmg_ FALSE, new_cnt);
		1418
		1419	/* copy the elements */
		1420	((CVmObjList *)vm_objp(vmg_ obj))->cons_copy_data(0, lst, new_cnt);
		1421
		1422	/* return the new object */
		1423	retval->set_obj(obj);
		1424
		1425	/* discard GC protection */
		1426	G_stk->discard();
		1427
		1428	/* handled */
		1429	return TRUE;
		1430	}
		1431
		1432	/* ------------------------------------------------------------------------ */
		1433	/*
		1434	* property evaluator - intersect
		1435	*/
		1436	int CVmObjList::getp_intersect(VMG_ vm_val_t *retval,
		1437	const vm_val_t *self_val,
		1438	const char lst, uint argc)
		1439	{
		1440	vm_val_t val2;
		1441	vm_obj_id_t obj;
		1442	static CVmNativeCodeDesc desc(1);
		1443
		1444	/* check arguments */
		1445	if (get_prop_check_argc(retval, argc, &desc))
		1446	return TRUE;
		1447
		1448	/* get the second list, but leave it on the stack for GC protection */
		1449	val2 = *G_stk->get(0);
		1450
		1451	/* put myself on the stack for GC protection as well */
		1452	G_stk->push(self_val);
		1453
		1454	/* make sure the other value is indeed a list */
		1455	if (val2.get_as_list(vmg0_) == 0)
		1456	err_throw(VMERR_LIST_VAL_REQD);
		1457
		1458	/* compute the intersection */
		1459	obj = intersect(vmg_ self_val, &val2);
		1460
		1461	/* discard the argument lists */
		1462	G_stk->discard(2);
		1463
		1464	/* return the new object */
		1465	retval->set_obj(obj);
		1466
		1467	/* handled */
		1468	return TRUE;
		1469	}
		1470
		1471	/* ------------------------------------------------------------------------ */
		1472	/*
		1473	* property evaluator - indexOf
		1474	*/
		1475	int CVmObjList::getp_index_of(VMG_ vm_val_t retval, const vm_val_t self_val,
		1476	const char lst, uint argc)
		1477	{
		1478	vm_val_t subval;
		1479	size_t idx;
		1480	static CVmNativeCodeDesc desc(1);
		1481
		1482	/* check arguments */
		1483	if (get_prop_check_argc(retval, argc, &desc))
		1484	return TRUE;
		1485
		1486	/* pop the value to find */
		1487	G_stk->pop(&subval);
		1488
		1489	/* find the value in the list */
		1490	if (find_in_list(vmg_ self_val, &subval, &idx))
		1491	{
		1492	/* found it - adjust to 1-based index for return */
		1493	retval->set_int(idx + 1);
		1494	}
		1495	else
		1496	{
		1497	/* didn't find it - return nil */
		1498	retval->set_nil();
		1499	}
		1500
		1501	/* handled */
		1502	return TRUE;
		1503	}
		1504
		1505	/* ------------------------------------------------------------------------ */
		1506	/*
		1507	* property evaluator - car
		1508	*/
		1509	int CVmObjList::getp_car(VMG_ vm_val_t retval, const vm_val_t self_val,
		1510	const char lst, uint argc)
		1511	{
		1512	static CVmNativeCodeDesc desc(0);
		1513
		1514	/* check arguments */
		1515	if (get_prop_check_argc(retval, argc, &desc))
		1516	return TRUE;
		1517
		1518	/*
		1519	* if the list has at least one element, return it; otherwise return
		1520	* nil
		1521	*/
		1522	if (vmb_get_len(lst) == 0)
		1523	{
		1524	/* no elements - return nil */
		1525	retval->set_nil();
		1526	}
		1527	else
		1528	{
		1529	/* it has at least one element - return the first element */
		1530	vmb_get_dh(lst + VMB_LEN, retval);
		1531	}
		1532
		1533	/* handled */
		1534	return TRUE;
		1535	}
		1536
		1537	/* ------------------------------------------------------------------------ */
		1538	/*
		1539	* property evaluator - cdr
		1540	*/
		1541	int CVmObjList::getp_cdr(VMG_ vm_val_t retval, const vm_val_t self_val,
		1542	const char lst, uint argc)
		1543	{
		1544	static CVmNativeCodeDesc desc(0);
		1545
		1546	/* check arguments */
		1547	if (get_prop_check_argc(retval, argc, &desc))
		1548	return TRUE;
		1549
		1550	/* push a self-reference for GC protection */
		1551	G_stk->push(self_val);
		1552
		1553	/*
		1554	* if the list has no elements, return nil; otherwise, return the
		1555	* sublist starting with the second element (thus return an empty
		1556	* list if the original list has only one element)
		1557	*/
		1558	if (vmb_get_len(lst) == 0)
		1559	{
		1560	/* no elements - return nil */
		1561	retval->set_nil();
		1562	}
		1563	else
		1564	{
		1565	vm_obj_id_t obj;
		1566	size_t new_cnt;
		1567
		1568	/* reduce the list count by one */
		1569	new_cnt = vmb_get_len(lst) - 1;
		1570
		1571	/* skip past the first element */
		1572	lst += VMB_LEN + VMB_DATAHOLDER;
		1573
		1574	/* create the new list */
		1575	obj = create(vmg_ FALSE, new_cnt);
		1576
		1577	/* copy the elements */
		1578	((CVmObjList *)vm_objp(vmg_ obj))->cons_copy_data(0, lst, new_cnt);
		1579
		1580	/* return the new object */
		1581	retval->set_obj(obj);
		1582	}
		1583
		1584	/* discard the stack protection */
		1585	G_stk->discard();
		1586
		1587	/* handled */
		1588	return TRUE;
		1589	}
		1590
		1591	/* ------------------------------------------------------------------------ */
		1592	/*
		1593	* property evaluator - indexWhich
		1594	*/
		1595	int CVmObjList::getp_index_which(VMG_ vm_val_t *retval,
		1596	const vm_val_t *self_val,
		1597	const char lst, uint argc)
		1598	{
		1599	/* use the generic index-which routine, stepping forward */
		1600	return gen_index_which(vmg_ retval, self_val, lst, argc, TRUE);
		1601	}
		1602
		1603	/*
		1604	* general index finder for indexWhich and lastIndexWhich - steps either
		1605	* forward or backward through the list
		1606	*/
		1607	int CVmObjList::gen_index_which(VMG_ vm_val_t *retval,
		1608	const vm_val_t *self_val,
		1609	const char lst, uint argc,
		1610	int forward)
		1611	{
		1612	const vm_val_t *func_val;
		1613	size_t cnt;
		1614	size_t idx;
		1615	static CVmNativeCodeDesc desc(1);
		1616
		1617	/* check arguments */
		1618	if (get_prop_check_argc(retval, argc, &desc))
		1619	return TRUE;
		1620
		1621	/* get the function pointer argument, but leave it on the stack */
		1622	func_val = G_stk->get(0);
		1623
		1624	/* push a self-reference while allocating to protect from gc */
		1625	G_stk->push(self_val);
		1626
		1627	/* get the length of the list */
		1628	cnt = vmb_get_len(lst);
		1629
		1630	/* presume that we won't find any element that satisfies the condition */
		1631	retval->set_nil();
		1632
		1633	/*
		1634	* start at either the first or last index, depending on which way
		1635	* we're stepping
		1636	*/
		1637	idx = (forward ? 1 : cnt);
		1638
		1639	/*
		1640	* Go through each element of our list, and invoke the callback on
		1641	* the element. Stop when we reach the first element that returns
		1642	* true, or when we run out of elements.
		1643	*/
		1644	for (;;)
		1645	{
		1646	/* if we're out of elements, stop now */
		1647	if (forward ? idx > cnt : idx == 0)
		1648	break;
		1649
		1650	/* re-translate the list address in case of swapping */
		1651	if (self_val->typ == VM_LIST)
		1652	lst = self_val->get_as_list(vmg0_);
		1653
		1654	/* get this element, and push it as the callback's argument */
		1655	index_and_push(vmg_ lst, idx);
		1656
		1657	/* invoke the callback */
		1658	G_interpreter->call_func_ptr(vmg_ func_val, 1, "list.indexWhich", 0);
		1659
		1660	/*
		1661	* if the callback returned true, we've found the element we're
		1662	* looking for
		1663	*/
		1664	if (G_interpreter->get_r0()->typ == VM_NIL
		1665	\|\| (G_interpreter->get_r0()->typ == VM_INT
		1666	&& G_interpreter->get_r0()->val.intval == 0))
		1667	{
		1668	/* nil or zero - this one failed the test, so keep looking */
		1669	}
		1670	else
		1671	{
		1672	/* it passed the test - return its index */
		1673	retval->set_int(idx);
		1674
		1675	/* no need to keep searching - we found what we're looking for */
		1676	break;
		1677	}
		1678
		1679	/* advance to the next element */
		1680	if (forward)
		1681	++idx;
		1682	else
		1683	--idx;
		1684	}
		1685
		1686	/* discard our gc protection (self) and our arguments */
		1687	G_stk->discard(2);
		1688
		1689	/* handled */
		1690	return TRUE;
		1691	}
		1692
		1693	/* ------------------------------------------------------------------------ */
		1694	/*
		1695	* property evaluator - forEach
		1696	*/
		1697	int CVmObjList::getp_for_each(VMG_ vm_val_t *retval,
		1698	const vm_val_t *self_val,
		1699	const char lst, uint argc)
		1700	{
		1701	/* use the generic forEach/forEachAssoc processor */
		1702	return for_each_gen(vmg_ retval, self_val, lst, argc, FALSE);
		1703	}
		1704
		1705	/*
		1706	* property evaluator - forEachAssoc
		1707	*/
		1708	int CVmObjList::getp_for_each_assoc(VMG_ vm_val_t *retval,
		1709	const vm_val_t *self_val,
		1710	const char lst, uint argc)
		1711	{
		1712	/* use the generic forEach/forEachAssoc processor */
		1713	return for_each_gen(vmg_ retval, self_val, lst, argc, TRUE);
		1714	}
		1715
		1716	/*
		1717	* General forEach processor - combines the functionality of forEach and
		1718	* forEachAssoc, using a flag to specify whether or not to pass the index
		1719	* of each element to the callback.
		1720	*/
		1721	int CVmObjList::for_each_gen(VMG_ vm_val_t *retval,
		1722	const vm_val_t *self_val,
		1723	const char lst, uint argc,
		1724	int send_idx_to_cb)
		1725	{
		1726	const vm_val_t *func_val;
		1727	size_t cnt;
		1728	size_t idx;
		1729	static CVmNativeCodeDesc desc(1);
		1730
		1731	/* check arguments */
		1732	if (get_prop_check_argc(retval, argc, &desc))
		1733	return TRUE;
		1734
		1735	/* get the function pointer argument, but leave it on the stack */
		1736	func_val = G_stk->get(0);
		1737
		1738	/* push a self-reference while allocating to protect from gc */
		1739	G_stk->push(self_val);
		1740
		1741	/* get the length of the list */
		1742	cnt = vmb_get_len(lst);
		1743
		1744	/* no return value */
		1745	retval->set_nil();
		1746
		1747	/* invoke the callback on each element */
		1748	for (idx = 1 ; idx <= cnt ; ++idx)
		1749	{
		1750	/* re-translate the list address in case of swapping */
		1751	if (self_val->typ == VM_LIST)
		1752	lst = self_val->get_as_list(vmg0_);
		1753
		1754	/*
		1755	* get this element (using a 1-based index) and push it as the
		1756	* callback's argument
		1757	*/
		1758	index_and_push(vmg_ lst, idx);
		1759
		1760	/* push the index, if desired */
		1761	if (send_idx_to_cb)
		1762	G_stk->push()->set_int(idx);
		1763
		1764	/* invoke the callback */
		1765	G_interpreter->call_func_ptr(vmg_ func_val, send_idx_to_cb ? 2 : 1,
		1766	"list.forEach", 0);
		1767	}
		1768
		1769	/* discard our gc protection (self) and our arguments */
		1770	G_stk->discard(2);
		1771
		1772	/* handled */
		1773	return TRUE;
		1774	}
		1775
		1776	/* ------------------------------------------------------------------------ */
		1777	/*
		1778	* property evaluator - valWhich
		1779	*/
		1780	int CVmObjList::getp_val_which(VMG_ vm_val_t *retval,
		1781	const vm_val_t *self_val,
		1782	const char lst, uint argc)
		1783	{
		1784	/* get the index of the value using indexWhich */
		1785	getp_index_which(vmg_ retval, self_val, lst, argc);
		1786
		1787	/* if the return value is a valid index, get the value at the index */
		1788	if (retval->typ == VM_INT)
		1789	{
		1790	int idx;
		1791
		1792	/* re-translate the list address in case of swapping */
		1793	if (self_val->typ == VM_LIST)
		1794	lst = self_val->get_as_list(vmg0_);
		1795
		1796	/* get the element as the return value */
		1797	idx = (int)retval->val.intval;
		1798	index_list(vmg_ retval, lst, idx);
		1799	}
		1800
		1801	/* handled */
		1802	return TRUE;
		1803	}
		1804
		1805	/* ------------------------------------------------------------------------ */
		1806	/*
		1807	* property evaluator - lastIndexOf
		1808	*/
		1809	int CVmObjList::getp_last_index_of(VMG_ vm_val_t *retval,
		1810	const vm_val_t *self_val,
		1811	const char lst, uint argc)
		1812	{
		1813	vm_val_t subval;
		1814	size_t idx;
		1815	static CVmNativeCodeDesc desc(1);
		1816
		1817	/* check arguments */
		1818	if (get_prop_check_argc(retval, argc, &desc))
		1819	return TRUE;
		1820
		1821	/* pop the value to find */
		1822	G_stk->pop(&subval);
		1823
		1824	/* find the value in the list */
		1825	if (find_last_in_list(vmg_ self_val, &subval, &idx))
		1826	{
		1827	/* found it - adjust to 1-based index for return */
		1828	retval->set_int(idx + 1);
		1829	}
		1830	else
		1831	{
		1832	/* didn't find it - return nil */
		1833	retval->set_nil();
		1834	}
		1835
		1836	/* handled */
		1837	return TRUE;
		1838	}
		1839
		1840	/* ------------------------------------------------------------------------ */
		1841	/*
		1842	* property evaluator - lastIndexWhich
		1843	*/
		1844	int CVmObjList::getp_last_index_which(VMG_ vm_val_t *retval,
		1845	const vm_val_t *self_val,
		1846	const char lst, uint argc)
		1847	{
		1848	/* use the generic index-which routine, stepping backward */
		1849	return gen_index_which(vmg_ retval, self_val, lst, argc, FALSE);
		1850	}
		1851
		1852	/* ------------------------------------------------------------------------ */
		1853	/*
		1854	* property evaluator - lastValWhich
		1855	*/
		1856	int CVmObjList::getp_last_val_which(VMG_ vm_val_t *retval,
		1857	const vm_val_t *self_val,
		1858	const char lst, uint argc)
		1859	{
		1860	/* get the index of the value using lastIndexWhich */
		1861	getp_last_index_which(vmg_ retval, self_val, lst, argc);
		1862
		1863	/* if the return value is a valid index, get the value at the index */
		1864	if (retval->typ == VM_INT)
		1865	{
		1866	int idx;
		1867
		1868	/* re-translate the list address in case of swapping */
		1869	if (self_val->typ == VM_LIST)
		1870	lst = self_val->get_as_list(vmg0_);
		1871
		1872	/* get the element as the return value */
		1873	idx = (int)retval->val.intval;
		1874	index_list(vmg_ retval, lst, idx);
		1875	}
		1876
		1877	/* handled */
		1878	return TRUE;
		1879	}
		1880
		1881	/* ------------------------------------------------------------------------ */
		1882	/*
		1883	* property evaluator - countOf
		1884	*/
		1885	int CVmObjList::getp_count_of(VMG_ vm_val_t *retval,
		1886	const vm_val_t *self_val,
		1887	const char lst, uint argc)
		1888	{
		1889	vm_val_t *val;
		1890	size_t idx;
		1891	size_t cnt;
		1892	size_t val_cnt;
		1893	static CVmNativeCodeDesc desc(1);
		1894
		1895	/* check arguments */
		1896	if (get_prop_check_argc(retval, argc, &desc))
		1897	return TRUE;
		1898
		1899	/* get the value to find, but leave it on the stack for gc protection */
		1900	val = G_stk->get(0);
		1901
		1902	/* lave the self value on the stack for gc protection */
		1903	G_stk->push(self_val);
		1904
		1905	/* get the number of elements in the list */
		1906	cnt = vmb_get_len(lst);
		1907
		1908	/* scan the list and count the elements */
		1909	for (idx = 0, val_cnt = 0 ; idx < cnt ; ++idx)
		1910	{
		1911	vm_val_t ele;
		1912
		1913	/* re-translate the list address in case of swapping */
		1914	if (self_val->typ == VM_LIST)
		1915	lst = self_val->get_as_list(vmg0_);
		1916
		1917	/* get this list element */
		1918	vmb_get_dh(get_element_ptr_const(lst, idx), &ele);
		1919
		1920	/* if it's the one we're looking for, count it */
		1921	if (ele.equals(vmg_ val))
		1922	++val_cnt;
		1923	}
		1924
		1925	/* discard our gc protection */
		1926	G_stk->discard(2);
		1927
		1928	/* return the count */
		1929	retval->set_int(val_cnt);
		1930
		1931	/* handled */
		1932	return TRUE;
		1933	}
		1934
		1935	/* ------------------------------------------------------------------------ */
		1936	/*
		1937	* property evaluator - countWhich
		1938	*/
		1939	int CVmObjList::getp_count_which(VMG_ vm_val_t *retval,
		1940	const vm_val_t *self_val,
		1941	const char lst, uint argc)
		1942	{
		1943	const vm_val_t *func_val;
		1944	size_t cnt;
		1945	size_t idx;
		1946	int val_cnt;
		1947	static CVmNativeCodeDesc desc(1);
		1948
		1949	/* check arguments */
		1950	if (get_prop_check_argc(retval, argc, &desc))
		1951	return TRUE;
		1952
		1953	/* get the function pointer argument, but leave it on the stack */
		1954	func_val = G_stk->get(0);
		1955
		1956	/* push a self-reference while allocating to protect from gc */
		1957	G_stk->push(self_val);
		1958
		1959	/* get the length of the list */
		1960	cnt = vmb_get_len(lst);
		1961
		1962	/* no return value */
		1963	retval->set_nil();
		1964
		1965	/* invoke the callback on each element */
		1966	for (idx = 1, val_cnt = 0 ; idx <= cnt ; ++idx)
		1967	{
		1968	vm_val_t *val;
		1969
		1970	/* re-translate the list address in case of swapping */
		1971	if (self_val->typ == VM_LIST)
		1972	lst = self_val->get_as_list(vmg0_);
		1973
		1974	/*
		1975	* get this element (using a 1-based index), and push it as the
		1976	* callback's argument
		1977	*/
		1978	index_and_push(vmg_ lst, idx);
		1979
		1980	/* invoke the callback */
		1981	G_interpreter->call_func_ptr(vmg_ func_val, 1, "list.forEach", 0);
		1982
		1983	/* get the result from R0 */
		1984	val = G_interpreter->get_r0();
		1985
		1986	/* if the callback returned non-nil and non-zero, count it */
		1987	if (val->typ == VM_NIL
		1988	\|\| (val->typ == VM_INT && val->val.intval == 0))
		1989	{
		1990	/* it's nil or zero - don't include it in the result */
		1991	}
		1992	else
		1993	{
		1994	/* count it */
		1995	++val_cnt;
		1996	}
		1997	}
		1998
		1999	/* discard our gc protection (self) and our arguments */
		2000	G_stk->discard(2);
		2001
		2002	/* return the count */
		2003	retval->set_int(val_cnt);
		2004
		2005	/* handled */
		2006	return TRUE;
		2007	}
		2008
		2009	/* ------------------------------------------------------------------------ */
		2010	/*
		2011	* property evaluator - getUnique
		2012	*/
		2013	int CVmObjList::getp_get_unique(VMG_ vm_val_t *retval,
		2014	const vm_val_t *self_val,
		2015	const char lst, uint argc)
		2016	{
		2017	CVmObjList *new_lst_obj;
		2018	static CVmNativeCodeDesc desc(0);
		2019
		2020	/* check arguments */
		2021	if (get_prop_check_argc(retval, argc, &desc))
		2022	return TRUE;
		2023
		2024	/* put myself on the stack for GC protection */
		2025	G_stk->push(self_val);
		2026
		2027	/*
		2028	* Make a copy of our list for the return value, since the result
		2029	* value will never be larger than the original list. By making a
		2030	* copy of the input list, we also can avoid worrying about whether
		2031	* the input list was a constant, and hence we don't have to worry
		2032	* about the possibility of constant page swapping - we'll just
		2033	* update elements of the copy in-place.
		2034	*/
		2035	retval->set_obj(create(vmg_ FALSE, lst));
		2036
		2037	/* get the return value list data */
		2038	new_lst_obj = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		2039
		2040	/* push a reference to the new list for gc protection */
		2041	G_stk->push(retval);
		2042
		2043	/* uniquify the list */
		2044	new_lst_obj->cons_uniquify(vmg0_);
		2045
		2046	/* discard the gc protection */
		2047	G_stk->discard(2);
		2048
		2049	/* handled */
		2050	return TRUE;
		2051	}
		2052
		2053	/* ------------------------------------------------------------------------ */
		2054	/*
		2055	* property evaluator - appendUnique
		2056	*/
		2057	int CVmObjList::getp_append_unique(VMG_ vm_val_t *retval,
		2058	const vm_val_t *self_val,
		2059	const char lst, uint argc)
		2060	{
		2061	vm_val_t val2;
		2062	const char *lst2;
		2063	size_t lst_len;
		2064	size_t lst2_len;
		2065	CVmObjList *new_lst;
		2066	static CVmNativeCodeDesc desc(1);
		2067
		2068	/* check arguments */
		2069	if (get_prop_check_argc(retval, argc, &desc))
		2070	return TRUE;
		2071
		2072	/* remember the length of my list */
		2073	lst_len = vmb_get_len(lst);
		2074
		2075	/* get the second list, but leave it on the stack for GC protection */
		2076	val2 = *G_stk->get(0);
		2077
		2078	/* put myself on the stack for GC protection as well */
		2079	G_stk->push(self_val);
		2080
		2081	/* make sure the other value is indeed a list */
		2082	if ((lst2 = val2.get_as_list(vmg0_)) == 0)
		2083	err_throw(VMERR_LIST_VAL_REQD);
		2084
		2085	/* get the length of the second list */
		2086	lst2_len = vmb_get_len(lst2);
		2087
		2088	/*
		2089	* Create a new list for the return value. Allocate space for the
		2090	* current list plus the list to be added - this is an upper bound,
		2091	* since the actual result list can be shorter
		2092	*/
		2093	retval->set_obj(create(vmg_ FALSE, lst_len + lst2_len));
		2094
		2095	/* push a reference to the new list for gc protection */
		2096	G_stk->push(retval);
		2097
		2098	/* get the return value list data */
		2099	new_lst = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		2100
		2101	/*
		2102	* copy the first list into the result list (including only the data
		2103	* elements, not the length prefix)
		2104	*/
		2105	lst = self_val->get_as_list(vmg0_);
		2106	new_lst->cons_copy_elements(0, lst);
		2107
		2108	/* append the second list to the result list */
		2109	lst2 = val2.get_as_list(vmg0_);
		2110	new_lst->cons_copy_elements(lst_len, lst2);
		2111
		2112	/* make the list unique */
		2113	new_lst->cons_uniquify(vmg0_);
		2114
		2115	/* discard the gc protection and arguments */
		2116	G_stk->discard(3);
		2117
		2118	/* handled */
		2119	return TRUE;
		2120	}
		2121
		2122
		2123	/* ------------------------------------------------------------------------ */
		2124	/*
		2125	* General insertion routine - this is used to handle append, prepend, and
		2126	* insertAt property evaluators. Inserts elements from the argument list
		2127	* at the given index, with zero indicating insertion before the first
		2128	* existing element.
		2129	*/
		2130	void CVmObjList::insert_elements(VMG_ vm_val_t *retval,
		2131	const vm_val_t *self_val,
		2132	const char *lst, uint argc, int idx)
		2133	{
		2134	size_t lst_len;
		2135	CVmObjList *new_lst;
		2136	uint i;
		2137	const int stack_temp_cnt = 2;
		2138
		2139	/* remember the length of my list */
		2140	lst_len = vmb_get_len(lst);
		2141
		2142	/* the index must be in the range 0 to the number of elements */
		2143	if (idx < 0 \|\| (size_t)idx > lst_len)
		2144	err_throw(VMERR_INDEX_OUT_OF_RANGE);
		2145
		2146	/* put myself on the stack for GC protection as well */
		2147	G_stk->push(self_val);
		2148
		2149	/*
		2150	* Create a new list for the return value. Allocate space for the
		2151	* current list plus one new element for each argument.
		2152	*/
		2153	retval->set_obj(create(vmg_ FALSE, lst_len + argc));
		2154
		2155	/* push a reference to the new list for gc protection */
		2156	G_stk->push(retval);
		2157
		2158	/* get the return value list data */
		2159	new_lst = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		2160
		2161	/* get the original list data */
		2162	lst = self_val->get_as_list(vmg0_);
		2163
		2164	/*
		2165	* Copy the first list into the result list (including only the data
		2166	* elements, not the length prefix). Copy it in two pieces: first,
		2167	* copy the elements before the insertion point.
		2168	*/
		2169	if (idx != 0)
		2170	new_lst->cons_copy_data(0, get_element_ptr_const(lst, 0), idx);
		2171
		2172	/* second, copy the elements after the insertion point */
		2173	if ((size_t)idx != lst_len)
		2174	new_lst->cons_copy_data(idx + argc, get_element_ptr_const(lst, idx),
		2175	lst_len - idx);
		2176
		2177	/* copy each argument into the proper position in the new list */
		2178	for (i = 0 ; i < argc ; ++i)
		2179	{
		2180	const vm_val_t *argp;
		2181
		2182	/*
		2183	* get a pointer to this argument value - the arguments are just
		2184	* after the temporary items we've pushed onto the stack
		2185	*/
		2186	argp = G_stk->get(stack_temp_cnt + i);
		2187
		2188	/* copy the argument into the list */
		2189	new_lst->cons_set_element((uint)idx + i, argp);
		2190	}
		2191
		2192	/* discard the gc protection and arguments */
		2193	G_stk->discard(argc + stack_temp_cnt);
		2194	}
		2195
		2196
		2197	/* ------------------------------------------------------------------------ */
		2198	/*
		2199	* property evaluator - append
		2200	*/
		2201	int CVmObjList::getp_append(VMG_ vm_val_t *retval,
		2202	const vm_val_t *self_val,
		2203	const char lst, uint argc)
		2204	{
		2205	static CVmNativeCodeDesc desc(1);
		2206
		2207	/* check arguments */
		2208	if (get_prop_check_argc(retval, argc, &desc))
		2209	return TRUE;
		2210
		2211	/* insert the element (there's just one) at the end of the list */
		2212	insert_elements(vmg_ retval, self_val, lst, 1, vmb_get_len(lst));
		2213
		2214	/* handled */
		2215	return TRUE;
		2216	}
		2217
		2218	/* ------------------------------------------------------------------------ */
		2219	/*
		2220	* property evaluator - prepend
		2221	*/
		2222	int CVmObjList::getp_prepend(VMG_ vm_val_t *retval,
		2223	const vm_val_t *self_val,
		2224	const char lst, uint argc)
		2225	{
		2226	static CVmNativeCodeDesc desc(1);
		2227
		2228	/* check arguments */
		2229	if (get_prop_check_argc(retval, argc, &desc))
		2230	return TRUE;
		2231
		2232	/* insert the element (there's just one) at the start of the list */
		2233	insert_elements(vmg_ retval, self_val, lst, 1, 0);
		2234
		2235	/* handled */
		2236	return TRUE;
		2237	}
		2238
		2239	/* ------------------------------------------------------------------------ */
		2240	/*
		2241	* property evaluator - insert new elements
		2242	*/
		2243	int CVmObjList::getp_insert_at(VMG_ vm_val_t *retval,
		2244	const vm_val_t *self_val,
		2245	const char lst, uint in_argc)
		2246	{
		2247	int idx;
		2248	uint argc = (in_argc != 0 ? *in_argc : 0);
		2249	static CVmNativeCodeDesc desc(2, 0, TRUE);
		2250
		2251	/* check arguments - we need at least two */
		2252	if (get_prop_check_argc(retval, in_argc, &desc))
		2253	return TRUE;
		2254
		2255	/*
		2256	* Pop the index value - the remaining arguments are the new element
		2257	* values to be inserted, so leave them on the stack. Note that we
		2258	* must adjust the value from the 1-based indexing of our caller to
		2259	* the zero-based indexing we use internally.
		2260	*/
		2261	idx = CVmBif::pop_int_val(vmg0_) - 1;
		2262
		2263	/*
		2264	* Insert the element (there's just one) at the start of the list.
		2265	* Note that we must decrement the argument count we got, since we
		2266	* already took off the first argument (the index value).
		2267	*/
		2268	insert_elements(vmg_ retval, self_val, lst, argc - 1, idx);
		2269
		2270	/* handled */
		2271	return TRUE;
		2272	}
		2273
		2274	/* ------------------------------------------------------------------------ */
		2275	/*
		2276	* General property evaluator for removing a range of elements - this
		2277	* handles removeElementAt and removeRange.
		2278	*/
		2279	void CVmObjList::remove_range(VMG_ vm_val_t *retval,
		2280	const vm_val_t *self_val,
		2281	const char *lst, int start_idx, int del_cnt)
		2282	{
		2283	size_t lst_len;
		2284	CVmObjList *new_lst;
		2285
		2286	/* push myself onto the stack for GC protection */
		2287	G_stk->push(self_val);
		2288
		2289	/* get the original list length */
		2290	lst_len = vmb_get_len(lst);
		2291
		2292	/*
		2293	* allocate a new list with space for the original list minus the
		2294	* elements to be deleted
		2295	*/
		2296	retval->set_obj(create(vmg_ FALSE, lst_len - del_cnt));
		2297
		2298	/* push a reference to teh new list for gc protection */
		2299	G_stk->push(retval);
		2300
		2301	/* get the return value list data */
		2302	new_lst = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		2303
		2304	/* get the original list data as well */
		2305	lst = self_val->get_as_list(vmg0_);
		2306
		2307	/*
		2308	* copy elements from the original list up to the first item to be
		2309	* removed
		2310	*/
		2311	if (start_idx != 0)
		2312	new_lst->cons_copy_data(0, get_element_ptr_const(lst, 0), start_idx);
		2313
		2314	/*
		2315	* copy elements of the original list following the last item to be
		2316	* removed
		2317	*/
		2318	if ((size_t)(start_idx + del_cnt) < lst_len)
		2319	new_lst->
		2320	cons_copy_data(start_idx,
		2321	get_element_ptr_const(lst, start_idx + del_cnt),
		2322	lst_len - (start_idx + del_cnt));
		2323
		2324	/* discard the gc protection */
		2325	G_stk->discard(2);
		2326	}
		2327
		2328	/* ------------------------------------------------------------------------ */
		2329	/*
		2330	* property evaluator - remove the element at the given index
		2331	*/
		2332	int CVmObjList::getp_remove_element_at(VMG_ vm_val_t *retval,
		2333	const vm_val_t *self_val,
		2334	const char lst, uint argc)
		2335	{
		2336	int idx;
		2337	static CVmNativeCodeDesc desc(1);
		2338
		2339	/* check arguments */
		2340	if (get_prop_check_argc(retval, argc, &desc))
		2341	return TRUE;
		2342
		2343	/* retrieve the index value, and adjust to zero-based indexing */
		2344	idx = CVmBif::pop_int_val(vmg0_) - 1;
		2345
		2346	/* make sure it's in range - it must refer to a valid element */
		2347	if (idx < 0 \|\| (size_t)idx >= vmb_get_len(lst))
		2348	err_throw(VMERR_INDEX_OUT_OF_RANGE);
		2349
		2350	/* remove one element at the given index */
		2351	remove_range(vmg_ retval, self_val, lst, idx, 1);
		2352
		2353	/* handled */
		2354	return TRUE;
		2355	}
		2356
		2357	/* ------------------------------------------------------------------------ */
		2358	/*
		2359	* property evaluator - remove the element at the given index
		2360	*/
		2361	int CVmObjList::getp_remove_range(VMG_ vm_val_t *retval,
		2362	const vm_val_t *self_val,
		2363	const char lst, uint argc)
		2364	{
		2365	int start_idx;
		2366	int end_idx;
		2367	static CVmNativeCodeDesc desc(2);
		2368
		2369	/* check arguments */
		2370	if (get_prop_check_argc(retval, argc, &desc))
		2371	return TRUE;
		2372
		2373	/*
		2374	* retrieve the starting and ending index values, and adjust to
		2375	* zero-based indexing
		2376	*/
		2377	start_idx = CVmBif::pop_int_val(vmg0_) - 1;
		2378	end_idx = CVmBif::pop_int_val(vmg0_) - 1;
		2379
		2380	/*
		2381	* make sure the index values are in range - both must refer to valid
		2382	* elements, and the ending index must be at least as high as the
		2383	* starting index
		2384	*/
		2385	if (start_idx < 0 \|\| (size_t)start_idx >= vmb_get_len(lst)
		2386	\|\| end_idx < 0 \|\| (size_t)end_idx >= vmb_get_len(lst)
		2387	\|\| end_idx < start_idx)
		2388	err_throw(VMERR_INDEX_OUT_OF_RANGE);
		2389
		2390	/* remove the specified elements */
		2391	remove_range(vmg_ retval, self_val, lst, start_idx,
		2392	end_idx - start_idx + 1);
		2393
		2394	/* handled */
		2395	return TRUE;
		2396	}
		2397
		2398	/* ------------------------------------------------------------------------ */
		2399	/*
		2400	* sorter for list data
		2401	*/
		2402	class CVmQSortList: public CVmQSortVal
		2403	{
		2404	public:
		2405	CVmQSortList()
		2406	{
		2407	lst_ = 0;
		2408	}
		2409
		2410	/* get an element */
		2411	void get_ele(VMG_ size_t idx, vm_val_t *val)
		2412	{
		2413	vmb_get_dh(get_ele_ptr(idx), val);
		2414	}
		2415
		2416	/* set an element */
		2417	void set_ele(VMG_ size_t idx, const vm_val_t *val)
		2418	{
		2419	vmb_put_dh(get_ele_ptr(idx), val);
		2420	}
		2421
		2422	/* get an element pointer */
		2423	char *get_ele_ptr(size_t idx)
		2424	{ return lst_ + VMB_LEN + (idx * VMB_DATAHOLDER); }
		2425
		2426	/* our list data */
		2427	char *lst_;
		2428	};
		2429
		2430	/*
		2431	* property evaluator - sort
		2432	*/
		2433	int CVmObjList::getp_sort(VMG_ vm_val_t *retval,
		2434	const vm_val_t *self_val,
		2435	const char lst, uint in_argc)
		2436	{
		2437	size_t lst_len;
		2438	CVmObjList *new_lst;
		2439	uint argc = (in_argc == 0 ? 0 : *in_argc);
		2440	CVmQSortList sorter;
		2441	static CVmNativeCodeDesc desc(0, 2);
		2442
		2443	/* check arguments */
		2444	if (get_prop_check_argc(retval, in_argc, &desc))
		2445	return TRUE;
		2446
		2447	/* remember the length of my list */
		2448	lst_len = vmb_get_len(lst);
		2449
		2450	/* if we have an 'descending' flag, note it */
		2451	if (argc >= 1)
		2452	sorter.descending_ = (G_stk->get(0)->typ != VM_NIL);
		2453
		2454	/*
		2455	* if we have a comparison function, note it, but leave it on the
		2456	* stack for gc protection
		2457	*/
		2458	if (argc >= 2)
		2459	sorter.compare_fn_ = *G_stk->get(1);
		2460
		2461	/* put myself on the stack for GC protection as well */
		2462	G_stk->push(self_val);
		2463
		2464	/* create a copy of the list as the return value */
		2465	retval->set_obj(create(vmg_ FALSE, lst));
		2466
		2467	/* push a reference to the new list for gc protection */
		2468	G_stk->push(retval);
		2469
		2470	/* get the return value list data */
		2471	new_lst = (CVmObjList *)vm_objp(vmg_ retval->val.obj);
		2472
		2473	/* set the list pointer in the sorter */
		2474	sorter.lst_ = new_lst->ext_;
		2475
		2476	/* sort the new list if it has any elements */
		2477	if (lst_len != 0)
		2478	sorter.sort(vmg_ 0, lst_len - 1);
		2479
		2480	/* discard the gc protection and arguments */
		2481	G_stk->discard(2 + argc);
		2482
		2483	/* handled */
		2484	return TRUE;
		2485	}
		2486
		2487
		2488	/* ------------------------------------------------------------------------ */
		2489	/*
		2490	* Constant-pool list object
		2491	*/
		2492
		2493	/*
		2494	* create
		2495	*/
		2496	vm_obj_id_t CVmObjListConst::create(VMG_ const char *const_ptr)
		2497	{
		2498	/* create our new ID */
		2499	vm_obj_id_t id = vm_new_id(vmg_ FALSE, FALSE, FALSE);
		2500
		2501	/* create our list object, pointing directly to the constant pool */
		2502	new (vmg_ id) CVmObjListConst(vmg_ const_ptr);
		2503
		2504	/* return the new ID */
		2505	return id;
		2506	}

FrobTADS

cfad47cfa3/tads3/vmlst.cpp