558 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
			
		
		
	
	
			558 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
| /*
 | |
|  * $Id$
 | |
|  *
 | |
|     Copyright (c) 2016-2018 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 "_core.h"
 | |
| #include "../lib/hak-prv.h"
 | |
| 
 | |
| static hak_pfrc_t pf_core_basic_new (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t obj, inst;
 | |
| 	hak_ooi_t nsize;
 | |
| 
 | |
| 	obj = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	if (!HAK_IS_CLASS(hak, obj))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "object not class - %O", obj);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	nsize = 0;
 | |
| 	if (nargs >= 2)
 | |
| 	{
 | |
| 		hak_oop_t size;
 | |
| 
 | |
| 		size = HAK_STACK_GETARG(hak, nargs, 1);
 | |
| 		if (!HAK_OOP_IS_SMOOI(size))
 | |
| 		{
 | |
| 			hak_seterrbfmt (hak, HAK_EINVAL, "size not numeric - %O", size);
 | |
| 			return HAK_PF_FAILURE;
 | |
| 		}
 | |
| 
 | |
| 		nsize = HAK_OOP_TO_SMOOI(size);
 | |
| 		if (nsize < 0)
 | |
| 		{
 | |
| 			hak_seterrbfmt (hak, HAK_EINVAL, "size not valid - %zd", nsize);
 | |
| 			return HAK_PF_FAILURE;
 | |
| 		}
 | |
| 	}
 | |
| 
 | |
| 	inst = hak_instantiate(hak, (hak_oop_class_t)obj, HAK_NULL, nsize);
 | |
| 	if (HAK_UNLIKELY(!inst)) return HAK_PF_FAILURE;
 | |
| 
 | |
| 	HAK_STACK_SETRET(hak, nargs, inst);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t __basic_at (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs, int span_fixed)
 | |
| {
 | |
| 	hak_oop_t obj, val;
 | |
| 	hak_oop_t pos;
 | |
| 	hak_oow_t index;
 | |
| 	hak_oop_class_t _class;
 | |
| 
 | |
| 	obj = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	pos = HAK_STACK_GETARG(hak, nargs, 1);
 | |
| 
 | |
| 	if (!HAK_OOP_IS_POINTER(obj) || !HAK_OBJ_GET_FLAGS_FLEXI(obj))
 | |
| 	{
 | |
| 	unindexable:
 | |
| 		/* the receiver is a special numeric object or a non-indexable object */
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver not indexable - %O", obj);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	if (hak_inttooow_noseterr(hak, pos, &index) <= 0)
 | |
| 	{
 | |
| 		/* negative integer or not integer */
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "position not valid - %O", pos);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	_class = (hak_oop_class_t)HAK_CLASSOF(hak, obj);
 | |
| 
 | |
| 	if (span_fixed)
 | |
| 	{
 | |
| 		hak_oow_t size;
 | |
| 		size = HAK_OBJ_GET_SIZE(obj);
 | |
| 		if (index >= size)
 | |
| 		{
 | |
| 			hak_seterrbfmt (hak, HAK_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hak_ooi_t)size);
 | |
| 			return HAK_PF_FAILURE;
 | |
| 		}
 | |
| 	}
 | |
| 	else
 | |
| 	{
 | |
| 		hak_oow_t fixed, flexi;
 | |
| 
 | |
| 		fixed = HAK_CLASS_SPEC_NAMED_INSTVARS(HAK_OOP_TO_SMOOI(_class->spec));
 | |
| 		flexi = HAK_OBJ_GET_SIZE(obj) - fixed;
 | |
| 		if (index >= flexi)
 | |
| 		{
 | |
| 			hak_seterrbfmt (hak, HAK_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hak_ooi_t)flexi);
 | |
| 			return HAK_PF_FAILURE;
 | |
| 		}
 | |
| 		index += fixed;
 | |
| 	}
 | |
| 
 | |
| 	switch (HAK_OBJ_GET_FLAGS_TYPE(obj))
 | |
| 	{
 | |
| 		case HAK_OBJ_TYPE_OOP:
 | |
| 			val = HAK_OBJ_GET_OOP_VAL(obj, index);
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_CHAR:
 | |
| 		{
 | |
| 			hak_ooch_t c;
 | |
| 			c = HAK_OBJ_GET_CHAR_VAL(obj, index);
 | |
| 			val = HAK_CHAR_TO_OOP(c);
 | |
| 			break;
 | |
| 		}
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_BYTE:
 | |
| 		{
 | |
| 			hak_ooi_t b;
 | |
| 			b = HAK_OBJ_GET_BYTE_VAL(obj, index);
 | |
| 			val = HAK_SMOOI_TO_OOP(b);
 | |
| 			break;
 | |
| 		}
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_HALFWORD:
 | |
| 			val = hak_oowtoint(hak, HAK_OBJ_GET_HALFWORD_VAL(obj, index));
 | |
| 			if (HAK_UNLIKELY(!val)) return HAK_PF_FAILURE;
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_WORD:
 | |
| 			val = hak_oowtoint(hak, HAK_OBJ_GET_WORD_VAL(obj, index));
 | |
| 			if (HAK_UNLIKELY(!val)) return HAK_PF_FAILURE;
 | |
| 			break;
 | |
| 
 | |
| 		default:
 | |
| 			goto unindexable;
 | |
| 	}
 | |
| 
 | |
| 
 | |
| 	HAK_STACK_SETRET(hak, nargs, val);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_basic_at (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	return __basic_at(hak, mod, nargs, 0);
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_prim_at (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	return __basic_at(hak, mod, nargs, 1);
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t __basic_at_put (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs, int span_fixed)
 | |
| {
 | |
| 	hak_oop_t obj, val;
 | |
| 	hak_oop_t pos;
 | |
| 	hak_oow_t index;
 | |
| 	hak_oop_class_t _class;
 | |
| 
 | |
| 	obj = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	pos = HAK_STACK_GETARG(hak, nargs, 1);
 | |
| 	val = HAK_STACK_GETARG(hak, nargs, 2);
 | |
| 
 | |
| 	if (!HAK_OOP_IS_POINTER(obj) || !HAK_OBJ_GET_FLAGS_FLEXI(obj))
 | |
| 	{
 | |
| 	unindexable:
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver not indexable - %O", obj);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	if (HAK_OBJ_GET_FLAGS_RDONLY(obj))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver immutable - %O", obj);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	if (hak_inttooow_noseterr(hak, pos, &index) <= 0)
 | |
| 	{
 | |
| 		/* negative integer or not integer */
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "position not valid - %O", pos);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	_class = (hak_oop_class_t)HAK_CLASSOF(hak, obj);
 | |
| 	if (span_fixed) /* include the fixed part in positioning */
 | |
| 	{
 | |
| 		hak_oow_t size;
 | |
| 
 | |
| 		size = HAK_OBJ_GET_SIZE(obj);
 | |
| 		if (index >= size)
 | |
| 		{
 | |
| 			hak_seterrbfmt (hak, HAK_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hak_ooi_t)size);
 | |
| 			return HAK_PF_FAILURE;
 | |
| 		}
 | |
| 	}
 | |
| 	else
 | |
| 	{
 | |
| 		hak_oow_t fixed, flexi;
 | |
| 
 | |
| 		fixed = HAK_CLASS_SPEC_NAMED_INSTVARS(HAK_OOP_TO_SMOOI(_class->spec));
 | |
| 		flexi = HAK_OBJ_GET_SIZE(obj) - fixed;
 | |
| 		if (index >= flexi)
 | |
| 		{
 | |
| 			hak_seterrbfmt (hak, HAK_EINVAL, "position(%zd) out of range - negative or greater than or equal to %zu", index, (hak_ooi_t)HAK_OBJ_GET_SIZE(obj));
 | |
| 			return HAK_PF_FAILURE;
 | |
| 		}
 | |
| 		index += fixed;
 | |
| 	}
 | |
| 
 | |
| 	switch (HAK_OBJ_GET_FLAGS_TYPE(obj))
 | |
| 	{
 | |
| 		case HAK_OBJ_TYPE_OOP:
 | |
| 			HAK_OBJ_SET_OOP_VAL(obj, index, val);
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_CHAR:
 | |
| 		{
 | |
| 			hak_ooch_t c;
 | |
| 			if (!HAK_OOP_IS_CHAR(val))
 | |
| 			{
 | |
| 				hak_seterrbfmt (hak, HAK_EINVAL, "value not character - %O", val);
 | |
| 				return HAK_PF_FAILURE;
 | |
| 			}
 | |
| 			c = HAK_OOP_TO_CHAR(val);
 | |
| 			HAK_OBJ_SET_CHAR_VAL(obj, index, c);
 | |
| 			break;
 | |
| 		}
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_BYTE:
 | |
| 		{
 | |
| 			hak_ooi_t b;
 | |
| 			if (!HAK_OOP_IS_SMOOI(val))
 | |
| 			{
 | |
| 				hak_seterrbfmt (hak, HAK_EINVAL, "value not byte - %O", val);
 | |
| 				return HAK_PF_FAILURE;
 | |
| 			}
 | |
| 			b = HAK_OOP_TO_SMOOI(val);
 | |
| 			HAK_OBJ_SET_BYTE_VAL(obj, index, b);
 | |
| 			break;
 | |
| 		}
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_HALFWORD:
 | |
| 		{
 | |
| 			hak_oow_t w;
 | |
| 			if (hak_inttooow(hak, val, &w) <= -1) return HAK_PF_FAILURE;
 | |
| 			HAK_OBJ_SET_HALFWORD_VAL(obj, index, w);
 | |
| 			break;
 | |
| 		}
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_WORD:
 | |
| 		{
 | |
| 			hak_oow_t w;
 | |
| 			if (hak_inttooow(hak, val, &w) <= -1) return HAK_PF_FAILURE;
 | |
| 			HAK_OBJ_SET_WORD_VAL(obj, index, w);
 | |
| 			break;
 | |
| 		}
 | |
| 
 | |
| 		default:
 | |
| 			goto unindexable;
 | |
| 	}
 | |
| 
 | |
| 
 | |
| 	HAK_STACK_SETRET(hak, nargs, val);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_basic_at_put (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	return __basic_at_put(hak, mod, nargs, 0);
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_prim_at_put (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	return __basic_at_put(hak, mod, nargs, 1);
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_basic_size (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_oop_t src;
 | |
| 	hak_oop_t size;
 | |
| 
 | |
| 	src = (hak_oop_oop_t)HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 
 | |
| 	if (!HAK_OOP_IS_POINTER(src))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "source not sizable - %O", src);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	size = hak_oowtoint(hak, HAK_OBJ_GET_SIZE(src));
 | |
| 	if (!size) return HAK_PF_FAILURE;
 | |
| 
 | |
| 	HAK_STACK_SETRET(hak, nargs, size);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_class_name (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t obj;
 | |
| 
 | |
| 	obj = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 
 | |
| 	if (!HAK_IS_CLASS(hak, obj))
 | |
| 	{
 | |
| 	#if 0
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver not class - %O", obj);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	#else
 | |
| 		obj = (hak_oop_t)HAK_CLASSOF(hak, obj);
 | |
| 		HAK_ASSERT (hak, HAK_IS_CLASS(hak, obj));
 | |
| 	#endif
 | |
| 	}
 | |
| 
 | |
| 	HAK_STACK_SETRET(hak, nargs, ((hak_oop_class_t)obj)->name);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_class_responds_to (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t obj;
 | |
| 	hak_oop_t msg;
 | |
| 	int x;
 | |
| 
 | |
| 	obj = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	msg = HAK_STACK_GETARG(hak, nargs, 1);
 | |
| 	if (!HAK_IS_CLASS(hak, obj))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver not class - %O", msg);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 	if (!HAK_OBJ_IS_CHAR_POINTER(msg))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "invalid message - %O", msg);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	x = hak_class_responds_to(hak, obj, msg);
 | |
| 	HAK_STACK_SETRET(hak, nargs, (x? hak->_true: hak->_false));
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_inst_responds_to (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t obj;
 | |
| 	hak_oop_t msg;
 | |
| 	int x;
 | |
| 
 | |
| 	obj = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	msg = HAK_STACK_GETARG(hak, nargs, 1);
 | |
| 	if (!HAK_OBJ_IS_CHAR_POINTER(msg))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "invalid message - %O", msg);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	x = hak_inst_responds_to(hak, obj, msg);
 | |
| 	HAK_STACK_SETRET(hak, nargs, (x? hak->_true: hak->_false));
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_slice (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t src, slice, a1, a2;
 | |
| 	hak_ooi_t size;
 | |
| 	hak_ooi_t pos;
 | |
| 	hak_ooi_t len;
 | |
| 	hak_ooi_t i;
 | |
| 
 | |
| 	src = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	a1 = HAK_STACK_GETARG(hak, nargs, 1);
 | |
| 	a2 = HAK_STACK_GETARG(hak, nargs, 2);
 | |
| 
 | |
| 	if (!HAK_OOP_IS_POINTER(src))
 | |
| 	{
 | |
| 	unsliceable:
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "source not sliceable - %O", src);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	if (!HAK_OOP_IS_SMOOI(a1))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "position not numeric - %O", a1);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 	if (!HAK_OOP_IS_SMOOI(a2))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "length not numeric - %O", a2);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	size = HAK_OBJ_GET_SIZE(src);
 | |
| 	pos = HAK_OOP_TO_SMOOI(a1);
 | |
| 	len = HAK_OOP_TO_SMOOI(a2);
 | |
| 
 | |
| 	if (pos < 0) pos = 0;
 | |
| 	else if (pos >= size) pos = size;
 | |
| 	if (len >= size - pos) len = size - pos;
 | |
| 
 | |
| /* TODO: check if the object is an indexable object from the class spec... */
 | |
| 	/* use HAK_OBJ_GET_CLASS() instead of HAK_CLASSOF() as we know it's an object */
 | |
| 	slice = hak_instantiate(hak, (hak_oop_class_t)HAK_OBJ_GET_CLASS(src), HAK_NULL, len);
 | |
| 	if (HAK_UNLIKELY(!slice)) return HAK_PF_FAILURE;
 | |
| 
 | |
| /* OR if add by the number of fixed fields??? */
 | |
| 	switch (HAK_OBJ_GET_FLAGS_TYPE(src))
 | |
| 	{
 | |
| 		case HAK_OBJ_TYPE_OOP:
 | |
| 			for (i = 0; i < len; i++) HAK_OBJ_GET_OOP_VAL(slice, i) = HAK_OBJ_GET_OOP_VAL(src, pos + i);
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_CHAR:
 | |
| 			for (i = 0; i < len; i++) HAK_OBJ_GET_CHAR_VAL(slice, i) = HAK_OBJ_GET_CHAR_VAL(src, pos + i);
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_BYTE:
 | |
| 			for (i = 0; i < len; i++) HAK_OBJ_GET_BYTE_VAL(slice, i) = HAK_OBJ_GET_BYTE_VAL(src, pos + i);
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_HALFWORD:
 | |
| 			for (i = 0; i < len; i++) HAK_OBJ_GET_HALFWORD_VAL(slice, i) = HAK_OBJ_GET_HALFWORD_VAL(src, pos + i);
 | |
| 			break;
 | |
| 
 | |
| 		case HAK_OBJ_TYPE_WORD:
 | |
| 			for (i = 0; i < len; i++) HAK_OBJ_GET_WORD_VAL(slice, i) = HAK_OBJ_GET_WORD_VAL(src, pos + i);
 | |
| 			break;
 | |
| 
 | |
| 		default:
 | |
| 			goto unsliceable;
 | |
| 	}
 | |
| 
 | |
| 	HAK_STACK_SETRET(hak, nargs, slice);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_char_to_smooi (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t rcv, out;
 | |
| 	hak_ooi_t code;
 | |
| 
 | |
| 	rcv = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	if (!HAK_OOP_IS_CHAR(rcv))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver not Character - %O", rcv);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	code = HAK_OOP_TO_CHAR(rcv);
 | |
| 	out = HAK_SMOOI_TO_OOP(code);
 | |
| 	HAK_STACK_SETRET(hak, nargs, out);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfrc_t pf_core_smooi_to_char (hak_t* hak, hak_mod_t* mod, hak_ooi_t nargs)
 | |
| {
 | |
| 	hak_oop_t rcv, out;
 | |
| 	hak_ooi_t code;
 | |
| 
 | |
| 	rcv = HAK_STACK_GETARG(hak, nargs, 0);
 | |
| 	if (!HAK_OOP_IS_SMOOI(rcv))
 | |
| 	{
 | |
| 		hak_seterrbfmt (hak, HAK_EINVAL, "receiver not SmallInteger - %O", rcv);
 | |
| 		return HAK_PF_FAILURE;
 | |
| 	}
 | |
| 
 | |
| 	code = HAK_OOP_TO_SMOOI(rcv);
 | |
| 	out = HAK_CHAR_TO_OOP(code);
 | |
| 	HAK_STACK_SETRET(hak, nargs, out);
 | |
| 	return HAK_PF_SUCCESS;
 | |
| }
 | |
| 
 | |
| static hak_pfinfo_t pfinfos[] =
 | |
| {
 | |
| 	{ "*",                  { HAK_PFBASE_FUNC, hak_pf_number_mul,             1, HAK_TYPE_MAX(hak_oow_t) } },
 | |
| 	{ "+",                  { HAK_PFBASE_FUNC, hak_pf_number_add,             1, HAK_TYPE_MAX(hak_oow_t) } },
 | |
| 	{ "-",                  { HAK_PFBASE_FUNC, hak_pf_number_sub,             1, HAK_TYPE_MAX(hak_oow_t) } },
 | |
| 	{ "/",                  { HAK_PFBASE_FUNC, hak_pf_number_div,             1, HAK_TYPE_MAX(hak_oow_t) } },
 | |
| 	{ "<",                  { HAK_PFBASE_FUNC, hak_pf_number_lt,              2, 2 } },
 | |
| 	{ "<=",                 { HAK_PFBASE_FUNC, hak_pf_number_le,              2, 2 } },
 | |
| 	{ "=",                  { HAK_PFBASE_FUNC, hak_pf_number_eq,              2, 2 } },
 | |
| 	{ "==",                 { HAK_PFBASE_FUNC, hak_pf_number_eq,              2, 2 } },
 | |
| 	{ ">",                  { HAK_PFBASE_FUNC, hak_pf_number_gt,              2, 2 } },
 | |
| 	{ ">=",                 { HAK_PFBASE_FUNC, hak_pf_number_ge,              2, 2 } },
 | |
| 
 | |
| /* TODO: add more builtin primitives here... */
 | |
| 	{ "abs",                { HAK_PFBASE_FUNC, hak_pf_number_abs,             1,  1 } },
 | |
| 	{ "basicAt",            { HAK_PFBASE_FUNC, pf_core_basic_at,              2,  2 } },
 | |
| 	{ "basicAtPut",         { HAK_PFBASE_FUNC, pf_core_basic_at_put,          3,  3 } },
 | |
| 	{ "basicNew",           { HAK_PFBASE_FUNC, pf_core_basic_new,             1,  2 } },
 | |
| 	{ "basicSize",          { HAK_PFBASE_FUNC, pf_core_basic_size,            1,  1 } },
 | |
| 
 | |
| 	{ "bit-and",            { HAK_PFBASE_FUNC, hak_pf_integer_band,           2,  2 } },
 | |
| 	{ "bit-left-shift",     { HAK_PFBASE_FUNC, hak_pf_integer_blshift,        2,  2 } },
 | |
| 	{ "bit-not",            { HAK_PFBASE_FUNC, hak_pf_integer_bnot,           1,  1 } },
 | |
| 	{ "bit-or",             { HAK_PFBASE_FUNC, hak_pf_integer_bor,            2,  2 } },
 | |
| 	{ "bit-right-shift",    { HAK_PFBASE_FUNC, hak_pf_integer_brshift,        2,  2 } },
 | |
| 	{ "bit-shift",          { HAK_PFBASE_FUNC, hak_pf_integer_bshift,         2,  2 } },
 | |
| 	{ "bit-xor",            { HAK_PFBASE_FUNC, hak_pf_integer_bxor,           2,  2 } },
 | |
| 
 | |
| 	{ "charToSmooi",        { HAK_PFBASE_FUNC, pf_core_char_to_smooi,         1,  1 } },
 | |
| 	{ "className",          { HAK_PFBASE_FUNC, pf_core_class_name,            1,  1 } },
 | |
| 	{ "classRespondsTo",    { HAK_PFBASE_FUNC, pf_core_class_responds_to,     2,  2 } },
 | |
| 
 | |
| 	{ "eqk?",               { HAK_PFBASE_FUNC, hak_pf_eqk,                    2,  2 } },
 | |
| 	{ "eql?",               { HAK_PFBASE_FUNC, hak_pf_eql,                    2,  2 } },
 | |
| 	{ "eqv?",               { HAK_PFBASE_FUNC, hak_pf_eqv,                    2,  2 } },
 | |
| 
 | |
| 	{ "instRespondsTo",     { HAK_PFBASE_FUNC, pf_core_inst_responds_to,      2,  2 } },
 | |
| 
 | |
| 	{ "nqk?",               { HAK_PFBASE_FUNC, hak_pf_nqk,                    2,  2 } },
 | |
| 	{ "nql?",               { HAK_PFBASE_FUNC, hak_pf_nql,                    2,  2 } },
 | |
| 	{ "nqv?",               { HAK_PFBASE_FUNC, hak_pf_nqv,                    2,  2 } },
 | |
| 
 | |
| 	{ "primAt",             { HAK_PFBASE_FUNC, pf_core_prim_at,               2,  2 } },
 | |
| 	{ "primAtPut",          { HAK_PFBASE_FUNC, pf_core_prim_at_put,           3,  3 } },
 | |
| 	{ "slice",              { HAK_PFBASE_FUNC, pf_core_slice,                 3,  3 } },
 | |
| 	{ "smooiToChar",        { HAK_PFBASE_FUNC, pf_core_smooi_to_char,         1,  1 } },
 | |
| 	{ "sqrt",               { HAK_PFBASE_FUNC, hak_pf_number_sqrt,            1,  1 } },
 | |
| 	{ "~=",                 { HAK_PFBASE_FUNC, hak_pf_number_ne,              2,  2 } },
 | |
| };
 | |
| 
 | |
| /* ------------------------------------------------------------------------ */
 | |
| 
 | |
| static hak_pfbase_t* query (hak_t* hak, hak_mod_t* mod, const hak_ooch_t* name, hak_oow_t namelen)
 | |
| {
 | |
| 	return hak_findpfbase(hak, pfinfos, HAK_COUNTOF(pfinfos), name, namelen);
 | |
| }
 | |
| 
 | |
| static void unload (hak_t* hak, hak_mod_t* mod)
 | |
| {
 | |
| }
 | |
| 
 | |
| int hak_mod_core (hak_t* hak, hak_mod_t* mod)
 | |
| {
 | |
| 	mod->query = query;
 | |
| 	mod->unload = unload; 
 | |
| 	mod->ctx = HAK_NULL;
 | |
| 	return 0;
 | |
| }
 |