moo/lib/pf-basic.c

/*
 * $Id$
 *
    Copyright (c) 2014-2019 Chung, Hyung-Hwan. All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:
    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.
    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in the
       documentation and/or other materials provided with the distribution.

    THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
    IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
    OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
    IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
    NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
    DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
    THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
    (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
    THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 */


#include "moo-prv.h"

/* -------------------------------------------------------------------------------- 
 * COMPARISON
 * -------------------------------------------------------------------------------- */
 
moo_pfrc_t moo_pf_identical (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, arg, b;

	MOO_ASSERT (moo, nargs == 1);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	arg = MOO_STACK_GETARG(moo, nargs, 0);

	b = (rcv == arg)? moo->_true: moo->_false;

	MOO_STACK_SETRET (moo, nargs, b);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_not_identical (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, arg, b;

	MOO_ASSERT (moo, nargs == 1);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	arg = MOO_STACK_GETARG(moo, nargs, 0);

	b = (rcv != arg)? moo->_true: moo->_false;

	MOO_STACK_SETRET (moo, nargs, b);
	return MOO_PF_SUCCESS;
}

static int _equal_objects (moo_t* moo, moo_oop_t rcv, moo_oop_t arg)
{
	int rtag;

	if (rcv == arg) return 1; /* identical. so equal */

	rtag = MOO_OOP_GET_TAG(rcv);
	if (rtag != MOO_OOP_GET_TAG(arg)) return 0;

	switch (rtag)
	{
		case MOO_OOP_TAG_SMOOI:
			return MOO_OOP_TO_SMOOI(rcv) == MOO_OOP_TO_SMOOI(arg)? 1: 0;

		case MOO_OOP_TAG_SMPTR:
			return MOO_OOP_TO_SMPTR(rcv) == MOO_OOP_TO_SMPTR(arg)? 1: 0;

		case MOO_OOP_TAG_CHAR:
			return MOO_OOP_TO_CHAR(rcv) == MOO_OOP_TO_CHAR(arg)? 1: 0;

		case MOO_OOP_TAG_ERROR:
			return MOO_OOP_TO_ERROR(rcv) == MOO_OOP_TO_ERROR(arg)? 1: 0;

		default:
		{
			MOO_ASSERT (moo, MOO_OOP_IS_POINTER(rcv));

			if (MOO_OBJ_GET_CLASS(rcv) != MOO_OBJ_GET_CLASS(arg)) return 0; /* different class, not equal */
			MOO_ASSERT (moo, MOO_OBJ_GET_FLAGS_TYPE(rcv) == MOO_OBJ_GET_FLAGS_TYPE(arg));

			if (MOO_OBJ_GET_CLASS(rcv) == moo->_class && rcv != arg) 
			{
				/* a class object are supposed to be unique */
				return 0;
			}
			if (MOO_OBJ_GET_SIZE(rcv) != MOO_OBJ_GET_SIZE(arg)) return 0; /* different size, not equal */

			switch (MOO_OBJ_GET_FLAGS_TYPE(rcv))
			{
				case MOO_OBJ_TYPE_BYTE:
				case MOO_OBJ_TYPE_CHAR:
				case MOO_OBJ_TYPE_HALFWORD:
				case MOO_OBJ_TYPE_WORD:
					return (MOO_MEMCMP(MOO_OBJ_GET_BYTE_SLOT(rcv), MOO_OBJ_GET_BYTE_SLOT(arg), MOO_BYTESOF(moo,rcv)) == 0)? 1: 0;

				default:
				{
					moo_oow_t i, size;

					if (rcv == moo->_nil) return arg == moo->_nil? 1: 0;
					if (rcv == moo->_true) return arg == moo->_true? 1: 0;
					if (rcv == moo->_false) return arg == moo->_false? 1: 0;

					/* MOO_OBJ_TYPE_OOP, ... */
					MOO_ASSERT (moo, MOO_OBJ_GET_FLAGS_TYPE(rcv) == MOO_OBJ_TYPE_OOP);

				#if 1
					moo_seterrbfmt (moo, MOO_ENOIMPL, "no builtin comparison implemented for %O and %O", rcv, arg); /* TODO: better error code */
					return -1;
				#else

					if (MOO_UNLIKELY(MOO_OBJ_GET_FLAGS_PROC(rcv)))
					{
						/* the stack in a process object doesn't need to be 
						 * scanned in full. the slots above the stack pointer 
						 * are garbages. */
						size = MOO_PROCESS_NAMED_INSTVARS + MOO_OOP_TO_SMOOI(((moo_oop_process_t)rcv)->sp) + 1;
						MOO_ASSERT (moo, size <= MOO_OBJ_GET_SIZE(rcv));
					}
					else
					{
						size = MOO_OBJ_GET_SIZE(rcv);
					}
					for (i = 0; i < size; i++)
					{
						int n;
						/* TODO: remove recursion */

						/* [NOTE] even if the object implements the equality method, 
						 * this primitive method doesn't honor it. */
						n = _equal_objects(moo, MOO_OBJ_GET_OOP_VAL(rcv, i), MOO_OBJ_GET_OOP_VAL(arg, i));
						if (n <= 0) return n;
					}

					/* the default implementation doesn't take the trailer space into account */
					return 1;
				#endif
				}
			}
		}
	}
}

moo_pfrc_t moo_pf_equal (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, arg;
	int n;

	rcv = MOO_STACK_GETRCV(moo, nargs);
	arg = MOO_STACK_GETARG(moo, nargs, 0);

	n = _equal_objects(moo, rcv, arg);
	if (n <= -1) return MOO_PF_FAILURE;

	MOO_STACK_SETRET (moo, nargs, (n? moo->_true: moo->_false));
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_not_equal (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, arg;
	int n;

	rcv = MOO_STACK_GETRCV(moo, nargs);
	arg = MOO_STACK_GETARG(moo, nargs, 0);

	n = _equal_objects(moo, rcv, arg);
	if (n <= -1) return MOO_PF_FAILURE;

	MOO_STACK_SETRET (moo, nargs, (n? moo->_false: moo->_true));
	return MOO_PF_SUCCESS;
}


/* -------------------------------------------------------------------------------- 
 * INSTANTIATION
 * -------------------------------------------------------------------------------- */

moo_pfrc_t moo_pf_basic_new (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_class_t _class;
	moo_oop_t szoop, obj;
	moo_oow_t size = 0; /* size of the variable/indexed part */

	_class = (moo_oop_class_t)MOO_STACK_GETRCV(moo, nargs);
	if (MOO_CLASSOF(moo, _class) != moo->_class) 
	{
		/* the receiver is not a class object */
		moo_seterrbfmt (moo, MOO_EMSGRCV, "non-class receiver - %O", _class);
		return MOO_PF_FAILURE;
	}

	/* check if #limited is set on the class */
	if (MOO_CLASS_SELFSPEC_FLAGS(MOO_OOP_TO_SMOOI(_class->selfspec)) & MOO_CLASS_SELFSPEC_FLAG_LIMITED)
	{
		moo_seterrbfmt (moo, MOO_EPERM, "limited receiver - %O", _class);
		return MOO_PF_FAILURE;
	}

	if (nargs >= 1)
	{
		szoop = MOO_STACK_GETARG(moo, nargs, 0);
		if (moo_inttooow_noseterr(moo, szoop, &size) <= 0)
		{
			/* integer out of range or not integer */
			moo_seterrbfmt (moo, MOO_EINVAL, "size out of range or not integer - %O", szoop);
			return MOO_PF_FAILURE;
		}
	}

	if (MOO_OOP_IS_SMOOI(((moo_oop_class_t)_class)->trsize)) 
	{
		obj = moo_instantiatewithtrailer(moo, _class, size, MOO_NULL, MOO_OOP_TO_SMOOI(((moo_oop_class_t)_class)->trsize));
	}
	else 
	{
		/* moo_instantiate() will ignore size if the instance specification 
		 * disallows indexed(variable) parts. */
		/* TODO: should i check the specification before calling 
		*       moo_instantiate()? */
		obj = moo_instantiate(moo, _class, MOO_NULL, size);
	}
	if (!obj) return MOO_PF_FAILURE;

	MOO_STACK_SETRET (moo, nargs, obj);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_shallow_copy (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, obj;

	MOO_ASSERT (moo, nargs ==  0);
	rcv = MOO_STACK_GETRCV(moo, nargs);

	obj = moo_shallowcopy(moo, rcv);
	if (!obj) return MOO_PF_FAILURE;

	MOO_STACK_SETRET (moo, nargs, obj);
	return MOO_PF_SUCCESS;
}

/* -------------------------------------------------------------------------------- 
 * BASIC ACCESS
 * -------------------------------------------------------------------------------- */

moo_pfrc_t moo_pf_class (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv;
	rcv = MOO_STACK_GETRCV(moo, nargs);
	MOO_STACK_SETRET (moo, nargs, (moo_oop_t)MOO_CLASSOF(moo, rcv));
	return MOO_PF_SUCCESS;
}


moo_pfrc_t moo_pf_basic_size (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	/* return the number of indexable fields */

	moo_oop_t rcv, sz;

	MOO_ASSERT (moo, nargs == 0);

	rcv = MOO_STACK_GETRCV(moo, nargs);

	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* a non-pointer object has the size of 0. 
		 * such an object doesn't consume object memory space except an OOP word */
		sz = MOO_SMOOI_TO_OOP(0);
	}
	else
	{
		sz = moo_oowtoint(moo, MOO_OBJ_GET_SIZE(rcv));
		if (!sz) return MOO_PF_FAILURE;
	}

	MOO_STACK_SETRET (moo, nargs, sz);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_basic_first_index (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	/* return the number of indexable fields */

	moo_oop_t rcv, sz;

	MOO_ASSERT (moo, nargs == 0);

	rcv = MOO_STACK_GETRCV(moo, nargs);

	if (!MOO_OOP_IS_POINTER(rcv) || MOO_OBJ_GET_SIZE(rcv) == 0)
	{
		sz = MOO_SMOOI_TO_OOP(-1);
	}
	else
	{
		sz = MOO_SMOOI_TO_OOP(0);
	}

	MOO_STACK_SETRET (moo, nargs, sz);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_basic_last_index (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	/* return the number of indexable fields */

	moo_oop_t rcv, sz;

	MOO_ASSERT (moo, nargs == 0);

	rcv = MOO_STACK_GETRCV(moo, nargs);

	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* a non-pointer object has the size of 0. 
		 * such an object doesn't consume object memory space except an OOP word.
		 * use -1 to indicate that the last index doesn't exist */
		sz = MOO_SMOOI_TO_OOP(-1);
	}
	else
	{
		moo_oow_t rcvsize = MOO_OBJ_GET_SIZE(rcv);
		if (rcvsize == 0)
		{
			sz = MOO_SMOOI_TO_OOP(-1);
		}
		else
		{
			sz = moo_oowtoint(moo, rcvsize - 1);
			if (!sz) return MOO_PF_FAILURE;
		}
	}

	MOO_STACK_SETRET (moo, nargs, sz);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_basic_at (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, pos, v;
	moo_oow_t idx;

	MOO_ASSERT (moo, nargs == 1);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* the receiver is a special numeric object, not a normal pointer */
		moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
		return MOO_PF_FAILURE;
	}

	pos = MOO_STACK_GETARG(moo, nargs, 0);
	if (moo_inttooow_noseterr(moo, pos, &idx) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid position - %O", pos);
		return MOO_PF_FAILURE;
	}
	if (idx >= MOO_OBJ_GET_SIZE(rcv))
	{
		/* index out of range */
		moo_seterrbfmt (moo, MOO_ERANGE, "position out of bound - %zu", idx);
		return MOO_PF_FAILURE;
	}

	switch (MOO_OBJ_GET_FLAGS_TYPE(rcv))
	{
		case MOO_OBJ_TYPE_BYTE:
			v = MOO_SMOOI_TO_OOP(MOO_OBJ_GET_BYTE_VAL(rcv, idx));
			break;

		case MOO_OBJ_TYPE_CHAR:
			v = MOO_CHAR_TO_OOP(MOO_OBJ_GET_CHAR_VAL(rcv, idx));
			break;

		case MOO_OBJ_TYPE_HALFWORD:
			/* TODO: LargeInteger if the halfword is too large */
			v = MOO_SMOOI_TO_OOP(MOO_OBJ_GET_HALFWORD_VAL(rcv, idx));
			break;

		case MOO_OBJ_TYPE_WORD:
			v = moo_oowtoint(moo, MOO_OBJ_GET_WORD_VAL(rcv, idx));
			if (!v) return MOO_PF_FAILURE;
			break;

		case MOO_OBJ_TYPE_OOP:
			v = MOO_OBJ_GET_OOP_VAL(rcv, idx);
			break;

		default:
			moo_seterrnum (moo, MOO_EINTERN);
			return MOO_PF_HARD_FAILURE;
	}

	MOO_STACK_SETRET (moo, nargs, v);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_basic_at_put (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, pos, val;
	moo_oow_t idx;

	MOO_ASSERT (moo, nargs == 2);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* the receiver is a special numeric object, not a normal pointer */
		moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
		return MOO_PF_FAILURE;
	}

	if (MOO_OBJ_GET_FLAGS_RDONLY(rcv))
	{
		moo_seterrbfmt (moo, MOO_EPERM, "not allowed to change a read-only object - %O", rcv);
		return MOO_PF_FAILURE;
	}

	pos = MOO_STACK_GETARG(moo, nargs, 0);
	val = MOO_STACK_GETARG(moo, nargs, 1);

	if (moo_inttooow_noseterr(moo, pos, &idx) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid position - %O", pos);
		return MOO_PF_FAILURE;
	}
	if (idx >= MOO_OBJ_GET_SIZE(rcv))
	{
		/* index out of range */
		moo_seterrbfmt (moo, MOO_ERANGE, "position out of bound - %zu", idx);
		return MOO_PF_FAILURE;
	}

	switch (MOO_OBJ_GET_FLAGS_TYPE(rcv))
	{
		case MOO_OBJ_TYPE_BYTE:
			if (!MOO_OOP_IS_SMOOI(val))
			{
				moo_seterrbfmt (moo, MOO_EINVAL, "value not a byte - %O", val);
				return MOO_PF_FAILURE;
			}
/* TOOD: must I check the range of the value? */
			MOO_OBJ_SET_BYTE_VAL (rcv, idx, MOO_OOP_TO_SMOOI(val));
			break;

		case MOO_OBJ_TYPE_CHAR:
			if (!MOO_OOP_IS_CHAR(val))
			{
				moo_seterrbfmt (moo, MOO_EINVAL, "value not a character - %O", val);
				return MOO_PF_FAILURE;
			}
			MOO_OBJ_SET_CHAR_VAL (rcv, idx, MOO_OOP_TO_CHAR(val));
			break;

		case MOO_OBJ_TYPE_HALFWORD:
			if (!MOO_OOP_IS_SMOOI(val))
			{
				/* the value is not a number */
				moo_seterrbfmt (moo, MOO_EINVAL, "value not a half-word integer - %O", val);
				return MOO_PF_FAILURE;
			}

			/* if the small integer is too large, it will get truncated */
			MOO_OBJ_SET_HALFWORD_VAL (rcv, idx, MOO_OOP_TO_SMOOI(val));
			break;

		case MOO_OBJ_TYPE_WORD:
		{
			moo_oow_t w;

			if (moo_inttooow_noseterr(moo, val, &w) <= 0)
			{
				/* the value is not a number, out of range, or negative */
				moo_seterrbfmt (moo, MOO_EINVAL, "value not a word integer - %O", val);
				return MOO_PF_FAILURE;
			}
			MOO_OBJ_SET_WORD_VAL (rcv, idx, w);
			break;
		}

		case MOO_OBJ_TYPE_OOP:
			MOO_STORE_OOP (moo, MOO_OBJ_GET_OOP_PTR(rcv, idx), val);
			break;

		default:
			moo_seterrnum (moo, MOO_EINTERN);
			return MOO_PF_HARD_FAILURE;
	}

/* TODO: return receiver or value? */
	MOO_STACK_SETRET (moo, nargs, val);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_basic_at_test_put (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, pos, oldval, newval, retval;
	moo_oow_t idx;

	MOO_ASSERT (moo, nargs == 3);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* the receiver is a special numeric object, not a normal pointer */
		moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
		return MOO_PF_FAILURE;
	}

	if (MOO_OBJ_GET_FLAGS_RDONLY(rcv))
	{
		moo_seterrbfmt (moo, MOO_EPERM, "not allowed to change a read-only object - %O", rcv);
		return MOO_PF_FAILURE;
	}

	pos = MOO_STACK_GETARG(moo, nargs, 0);
	oldval = MOO_STACK_GETARG(moo, nargs, 1);
	newval = MOO_STACK_GETARG(moo, nargs, 1);

	if (moo_inttooow_noseterr(moo, pos, &idx) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid position - %O", pos);
		return MOO_PF_FAILURE;
	}
	if (idx >= MOO_OBJ_GET_SIZE(rcv))
	{
		/* index out of range */
		moo_seterrbfmt (moo, MOO_ERANGE, "position out of bound - %zu", idx);
		return MOO_PF_FAILURE;
	}

	retval = moo->_false;
	switch (MOO_OBJ_GET_FLAGS_TYPE(rcv))
	{
		case MOO_OBJ_TYPE_BYTE:
		{
			moo_ooi_t oi;

			if (!MOO_OOP_IS_SMOOI(newval))
			{
				moo_seterrbfmt (moo, MOO_EINVAL, "new value not a byte - %O", newval);
				return MOO_PF_FAILURE;
			}

/* TOOD: must I check the range of the new value? */
			if (MOO_OOP_IS_SMOOI(oldval) && (oi = MOO_OOP_TO_SMOOI(oldval)) >= 0 && oi == MOO_OBJ_GET_BYTE_VAL(rcv, idx))
			{
				MOO_OBJ_SET_BYTE_VAL (rcv, idx, MOO_OOP_TO_SMOOI(newval));
				retval = moo->_true;
			}
			break;
		}

		case MOO_OBJ_TYPE_CHAR:
			if (!MOO_OOP_IS_CHAR(newval))
			{
				moo_seterrbfmt (moo, MOO_EINVAL, "new value not a character - %O", newval);
				return MOO_PF_FAILURE;
			}
			if (MOO_OOP_IS_CHAR(oldval) && MOO_OOP_TO_CHAR(oldval) == MOO_OBJ_GET_CHAR_VAL(rcv, idx))
			{
				MOO_OBJ_SET_CHAR_VAL (rcv, idx, MOO_OOP_TO_CHAR(newval));
				retval = moo->_true;
			}
			break;

		case MOO_OBJ_TYPE_HALFWORD:
		{
			moo_ooi_t oi;

			if (!MOO_OOP_IS_SMOOI(newval))
			{
				/* the new value is not a number */
				moo_seterrbfmt (moo, MOO_EINVAL, "new value not a half-word integer - %O", newval);
				return MOO_PF_FAILURE;
			}
			/* if the small integer is too large, it will get truncated */
			if (MOO_OOP_IS_SMOOI(oldval) && (oi = MOO_OOP_TO_SMOOI(oldval)) >= 0 && oi == MOO_OBJ_GET_HALFWORD_VAL(rcv, idx))
			{
				MOO_OBJ_SET_HALFWORD_VAL (rcv, idx, MOO_OOP_TO_SMOOI(newval));
				retval = moo->_true;
			}
			break;
		}

		case MOO_OBJ_TYPE_WORD:
		{
			moo_oow_t w, ow;

			if (moo_inttooow_noseterr(moo, newval, &w) <= 0)
			{
				/* the new value is not a number, out of range, or negative */
				moo_seterrbfmt (moo, MOO_EINVAL, "new value not a word integer - %O", newval);
				return MOO_PF_FAILURE;
			}

			if (moo_inttooow_noseterr(moo, oldval, &ow) >= 1 && ow == MOO_OBJ_GET_WORD_VAL(rcv, idx))
			{
				MOO_OBJ_SET_WORD_VAL (rcv, idx, w);
				retval = moo->_true;
			}
			break;
		}

		case MOO_OBJ_TYPE_OOP:
			if (oldval == MOO_OBJ_GET_OOP_VAL(rcv, idx))
			{
				MOO_STORE_OOP (moo, MOO_OBJ_GET_OOP_PTR(rcv, idx), newval);
				retval = moo->_true;
			}
			break;

		default:
			moo_seterrnum (moo, MOO_EINTERN);
			return MOO_PF_HARD_FAILURE;
	}

	/* return the old value */
	MOO_STACK_SETRET (moo, nargs, retval);
	return MOO_PF_SUCCESS;
}

moo_pfrc_t moo_pf_basic_fill (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, spos, dval, slen;
	moo_oow_t sidx, ssz, maxlen, end, i;

	MOO_ASSERT (moo, nargs == 3);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* the receiver is a special numeric object, not a normal pointer */
		moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
		return MOO_PF_FAILURE;
	}

	if (MOO_OBJ_GET_FLAGS_RDONLY(rcv))
	{
		moo_seterrbfmt (moo, MOO_EPERM, "not allowed to change a read-only object - %O", rcv);
		return MOO_PF_FAILURE;
	}

	spos = MOO_STACK_GETARG(moo, nargs, 0);
	dval = MOO_STACK_GETARG(moo, nargs, 1);
	slen = MOO_STACK_GETARG(moo, nargs, 2);

	if (moo_inttooow_noseterr(moo, spos, &sidx) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid source position - %O", spos);
		return MOO_PF_FAILURE;
	}
	if (moo_inttooow_noseterr(moo, slen, &ssz) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid fill count - %O", slen);
		return MOO_PF_FAILURE;
	}

	if (ssz <= 0) 
	{
		/* no filling is performed. also no validation about the range of
		 * source position is performed */
		goto done;
	}

	if (sidx >= MOO_OBJ_GET_SIZE(rcv))
	{
		/* index out of range */
		moo_seterrbfmt (moo, MOO_ERANGE, "source position out of bound - %zu", sidx);
		return MOO_PF_FAILURE;
	}

	maxlen = MOO_OBJ_GET_SIZE(rcv) - sidx;
	if (ssz > maxlen) ssz = maxlen;
	end = sidx + ssz;

	/* TODO: do i need to perform a range check? */
	switch (MOO_OBJ_GET_FLAGS_TYPE(rcv))
	{
		case MOO_OBJ_TYPE_BYTE:
			if (!MOO_OOP_IS_SMOOI(dval)) goto invalid_fill_value;
			for (i = sidx; i < end; i++) MOO_OBJ_SET_BYTE_VAL (rcv, i, MOO_OOP_TO_SMOOI(dval));
			break;

		case MOO_OBJ_TYPE_CHAR:
			if (!MOO_OOP_IS_CHAR(dval)) goto invalid_fill_value;
			for (i = sidx; i < end; i++) MOO_OBJ_SET_CHAR_VAL (rcv, i, MOO_OOP_TO_CHAR(dval));
			break;

		case MOO_OBJ_TYPE_HALFWORD:
			if (!MOO_OOP_IS_SMOOI(dval)) goto invalid_fill_value;
			for (i = sidx; i < end; i++) MOO_OBJ_SET_HALFWORD_VAL (rcv, i, MOO_OOP_TO_SMOOI(dval));
			break;

		case MOO_OBJ_TYPE_WORD:
		{
			moo_oow_t dw;
			if (moo_inttooow_noseterr(moo, dval, &dw) <= 0) goto invalid_fill_value;
			for (i = sidx; i < end; i++) MOO_OBJ_SET_WORD_VAL (rcv, i, dw);
			break;
		}

		case MOO_OBJ_TYPE_OOP:
			for (i = sidx; i < end; i++) MOO_STORE_OOP (moo, MOO_OBJ_GET_OOP_PTR(rcv, i), dval);
			break;

		default:
			moo_seterrnum (moo, MOO_EINTERN);
			return MOO_PF_HARD_FAILURE;
	}


done:
#if defined(MOO_LIMIT_OBJ_SIZE)
	MOO_ASSERT (moo, ssz <= MOO_SMOOI_MAX);
	MOO_STACK_SETRET (moo, nargs, MOO_SMOOI_TO_OOP(ssz));
#else
	if (ssz <= MOO_SMOOI_MAX)
	{
		MOO_STACK_SETRET (moo, nargs, MOO_SMOOI_TO_OOP(ssz));
	}
	else
	{
		moo_oop_t v;
		v = moo_oowtoint(moo, ssz);
		if (!v) MOO_PF_FAILURE;
		MOO_STACK_SETRET (moo, nargs, v);
	}
#endif

	return MOO_PF_SUCCESS;

invalid_fill_value:
	moo_seterrbfmt (moo, MOO_EINVAL, "invalid fill value - %O", dval);
	return MOO_PF_FAILURE;
}

moo_pfrc_t moo_pf_basic_shift (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, spos, dpos, slen;
	moo_oow_t sidx, ssz, didx;

	MOO_ASSERT (moo, nargs == 3);

	rcv = MOO_STACK_GETRCV(moo, nargs);
	if (!MOO_OOP_IS_POINTER(rcv))
	{
		/* the receiver is a special numeric object, not a normal pointer */
		moo_seterrbfmt (moo, MOO_EMSGRCV, "receiver not indexable - %O", rcv);
		return MOO_PF_FAILURE;
	}

	if (MOO_OBJ_GET_FLAGS_RDONLY(rcv))
	{
		moo_seterrbfmt (moo, MOO_EPERM, "not allowed to change a read-only object - %O", rcv);
		return MOO_PF_FAILURE;
	}

	spos = MOO_STACK_GETARG(moo, nargs, 0);
	dpos = MOO_STACK_GETARG(moo, nargs, 1);
	slen = MOO_STACK_GETARG(moo, nargs, 2);

	if (moo_inttooow_noseterr(moo, spos, &sidx) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid source position - %O", spos);
		return MOO_PF_FAILURE;
	}
	if (moo_inttooow_noseterr(moo, dpos, &didx) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid destination position - %O", dpos);
		return MOO_PF_FAILURE;
	}
	if (moo_inttooow_noseterr(moo, slen, &ssz) <= 0)
	{
		/* negative integer or not integer */
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid shift count - %O", slen);
		return MOO_PF_FAILURE;
	}

	if (ssz <= 0) 
	{
		/* no shifting is performed. also no validation about the range of
		 * source position and destionation position is performed */
		goto done; 
	}

	if (sidx >= MOO_OBJ_GET_SIZE(rcv))
	{
		/* index out of range */
		moo_seterrbfmt (moo, MOO_ERANGE, "source position out of bound - %zu", sidx);
		return MOO_PF_FAILURE;
	}
	if (didx >= MOO_OBJ_GET_SIZE(rcv))
	{
		/* index out of range */
		moo_seterrbfmt (moo, MOO_ERANGE, "destination position out of bound - %zu", didx);
		return MOO_PF_FAILURE;
	}

	if (sidx != didx)
	{
		moo_oow_t maxlen;

		maxlen = MOO_OBJ_GET_SIZE(rcv) - didx;
		if (ssz > maxlen) ssz = maxlen;

		switch (MOO_OBJ_GET_FLAGS_TYPE(rcv))
		{
			case MOO_OBJ_TYPE_BYTE:
				MOO_MEMMOVE (MOO_OBJ_GET_BYTE_PTR(rcv, didx),
				             MOO_OBJ_GET_BYTE_PTR(rcv, sidx),
				             ssz * MOO_SIZEOF(MOO_OBJ_GET_BYTE_VAL(rcv, 0)));
				
				if (didx > sidx)
				{
					MOO_MEMSET (MOO_OBJ_GET_BYTE_PTR(rcv, sidx), 0, 
					            (didx - sidx) * MOO_SIZEOF(MOO_OBJ_GET_BYTE_VAL(rcv, 0)));
				}
				else
				{
					MOO_MEMSET (MOO_OBJ_GET_BYTE_PTR(rcv, didx + ssz - 1), 0, 
					            (sidx - didx) * MOO_SIZEOF(MOO_OBJ_GET_BYTE_VAL(rcv, 0)));
				}
				break;

			case MOO_OBJ_TYPE_CHAR:
				MOO_MEMMOVE (MOO_OBJ_GET_CHAR_PTR(rcv, didx),
				             MOO_OBJ_GET_CHAR_PTR(rcv, sidx),
				             ssz * MOO_SIZEOF(MOO_OBJ_GET_CHAR_VAL(rcv, 0)));

				if (didx > sidx)
				{
					MOO_MEMSET (MOO_OBJ_GET_CHAR_PTR(rcv, sidx), 0, 
					            (didx - sidx) * MOO_SIZEOF(MOO_OBJ_GET_CHAR_VAL(rcv, 0)));
				}
				else
				{
					MOO_MEMSET (MOO_OBJ_GET_CHAR_PTR(rcv, didx + ssz - 1), 0, 
					            (sidx - didx) * MOO_SIZEOF(MOO_OBJ_GET_CHAR_VAL(rcv, 0)));
				}
				break;

			case MOO_OBJ_TYPE_HALFWORD:
				MOO_MEMMOVE (MOO_OBJ_GET_HALFWORD_PTR(rcv, didx),
				             MOO_OBJ_GET_HALFWORD_PTR(rcv, sidx),
				             ssz * MOO_SIZEOF(MOO_OBJ_GET_HALFWORD_VAL(rcv, 0)));

				if (didx > sidx)
				{
					MOO_MEMSET (MOO_OBJ_GET_HALFWORD_PTR(rcv, sidx), 0, 
					            (didx - sidx) * MOO_SIZEOF(MOO_OBJ_GET_HALFWORD_VAL(rcv, 0)));
				}
				else
				{
					MOO_MEMSET (MOO_OBJ_GET_HALFWORD_PTR(rcv, didx + ssz - 1), 0, 
					            (sidx - didx) * MOO_SIZEOF(MOO_OBJ_GET_HALFWORD_VAL(rcv, 0)));
				}
				break;

			case MOO_OBJ_TYPE_WORD:
				MOO_MEMMOVE (MOO_OBJ_GET_WORD_PTR(rcv, didx),
				             MOO_OBJ_GET_WORD_PTR(rcv, sidx),
				             ssz * MOO_SIZEOF(MOO_OBJ_GET_WORD_VAL(rcv, 0)));

				if (didx > sidx)
				{
					MOO_MEMSET (MOO_OBJ_GET_WORD_PTR(rcv, sidx), 0, 
					            (didx - sidx) * MOO_SIZEOF(MOO_OBJ_GET_WORD_VAL(rcv, 0)));
				}
				else
				{
					MOO_MEMSET (MOO_OBJ_GET_WORD_PTR(rcv, didx + ssz - 1), 0, 
					            (sidx - didx) * MOO_SIZEOF(MOO_OBJ_GET_WORD_VAL(rcv, 0)));
				}
				break;

			case MOO_OBJ_TYPE_OOP:
				if (didx > sidx)
				{
					moo_oow_t i;
					for (i = ssz; i > 0; )
					{
						MOO_STORE_OOP (moo, MOO_OBJ_GET_OOP_PTR(rcv, didx + i), MOO_OBJ_GET_OOP_VAL(rcv, sidx + i));
					}

					while (sidx < didx) 
					{
						/* no need to use MOO_STORE_OOP because moo->_nil is the assigned value */
						MOO_OBJ_SET_OOP_VAL (rcv, sidx, moo->_nil);
						sidx = sidx + 1;
					}
				}
				else
				{
					moo_oow_t i;
					for (i = 0; i < ssz; i++)
					{
						--i;
						MOO_STORE_OOP (moo, MOO_OBJ_GET_OOP_PTR(rcv, didx + i), MOO_OBJ_GET_OOP_VAL(rcv, sidx + i));
					}

					while (didx > sidx) 
					{
						/* no need to use MOO_STORE_OOP because moo->_nil is the assigned value */
						MOO_OBJ_SET_OOP_VAL (rcv, didx + ssz, moo->_nil);
						didx = didx + 1;
					}
				}
				break;

			default:
				moo_seterrnum (moo, MOO_EINTERN);
				return MOO_PF_HARD_FAILURE;
		}
	}

done:
#if defined(MOO_LIMIT_OBJ_SIZE)
	MOO_ASSERT (moo, ssz <= MOO_SMOOI_MAX);
	MOO_STACK_SETRET (moo, nargs, MOO_SMOOI_TO_OOP(ssz));
#else
	if (ssz <= MOO_SMOOI_MAX)
	{
		MOO_STACK_SETRET (moo, nargs, MOO_SMOOI_TO_OOP(ssz));
	}
	else
	{
		moo_oop_t v;
		v = moo_oowtoint(moo, ssz);
		if (!v) MOO_PF_FAILURE;
		MOO_STACK_SETRET (moo, nargs, v);
	}
#endif
	return MOO_PF_SUCCESS;
}

/* -------------------------------------------------------------------------------- 
 * BASIC QUERY
 * -------------------------------------------------------------------------------- */

moo_pfrc_t moo_pf_is_kind_of (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, _class;

	rcv = MOO_STACK_GETRCV(moo, nargs);
	_class = MOO_STACK_GETARG(moo, nargs, 0);

	if (MOO_CLASSOF(moo, _class) == moo->_class &&
	    moo_iskindof(moo, rcv, (moo_oop_class_t)_class))
	{
		MOO_STACK_SETRET (moo, nargs, moo->_true);
	}
	else
	{
		MOO_STACK_SETRET (moo, nargs, moo->_false);
	}

	return MOO_PF_SUCCESS;
}


moo_pfrc_t moo_pf_responds_to (moo_t* moo, moo_mod_t* mod, moo_ooi_t nargs)
{
	moo_oop_t rcv, selector;

	rcv = MOO_STACK_GETRCV(moo, nargs);
	selector = MOO_STACK_GETARG(moo, nargs, 0);

	/*if (MOO_CLASSOF(moo,selector) != moo->_symbol)*/
	if (!MOO_OBJ_IS_CHAR_POINTER(selector))
	{
		moo_seterrbfmt (moo, MOO_EINVAL, "invalid argument - %O", selector);
		return MOO_PF_FAILURE;
	}

	if (moo_findmethod(moo, rcv, (moo_oop_char_t)selector, 0))
	{
		MOO_STACK_SETRET (moo, nargs, moo->_true);
	}
	else
	{
		MOO_STACK_SETRET (moo, nargs, moo->_false);
	}

	return MOO_PF_SUCCESS;
}