factor/native/string.c

#include "factor.h"

/* untagged */
F_STRING* allot_string(F_FIXNUM capacity)
{
	F_STRING* string;

	if(capacity < 0)
		general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_integer(capacity),true);

	string = allot_object(STRING_TYPE,
		sizeof(F_STRING) + (capacity + 1) * CHARS);
	/* strings are null-terminated in memory, even though they also
	have a length field. The null termination allows us to add
	the sizeof(F_STRING) to a Factor string to get a C-style
	UTF16 string for C library calls. */
	cput(SREF(string,capacity),(u16)'\0');
	string->length = tag_fixnum(capacity);
	return string;
}

/* call this after constructing a string */
void rehash_string(F_STRING* str)
{
	s32 hash = 0;
	CELL i;
	CELL capacity = string_capacity(str);
	for(i = 0; i < capacity; i++)
		hash = (31*hash + string_nth(str,i));
	str->hashcode = (s32)tag_fixnum(hash);
}

void primitive_rehash_string(void)
{
	rehash_string(untag_string(dpop()));
}

/* untagged */
F_STRING *string(F_FIXNUM capacity, CELL fill)
{
	CELL i;

	F_STRING* string = allot_string(capacity);

	for(i = 0; i < capacity; i++)
		cput(SREF(string,i),fill);

	rehash_string(string);

	return string;
}

void primitive_string(void)
{
	CELL initial = to_cell(dpop());
	F_FIXNUM length = to_fixnum(dpop());
	maybe_gc(string_size(length));
	dpush(tag_object(string(length,initial)));
}

F_STRING* resize_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
{
	/* later on, do an optimization: if end of array is here, just grow */
	CELL i;
	CELL to_copy = string_capacity(string);

	if(capacity < to_copy)
		to_copy = capacity;

	F_STRING* new_string = allot_string(capacity);

	memcpy(new_string + 1,string + 1,to_copy * CHARS);

	for(i = to_copy; i < capacity; i++)
		cput(SREF(new_string,i),fill);

	return new_string;
}

void primitive_resize_string(void)
{
	F_STRING* string;
	CELL capacity = to_fixnum(dpeek2());
	maybe_gc(string_size(capacity));
	string = untag_string_fast(dpop());
	drepl(tag_object(resize_string(string,capacity,F)));
}

F_STRING *memory_to_string(const BYTE* string, CELL length)
{
	F_STRING* s = allot_string(length);
	CELL i;

	for(i = 0; i < length; i++)
	{
		cput(SREF(s,i),*string);
		string++;
	}

	rehash_string(s);
	
	return s;
}

void primitive_memory_to_string(void)
{
	CELL length = unbox_unsigned_cell();
	BYTE *string = (BYTE*)unbox_unsigned_cell();
	dpush(tag_object(memory_to_string(string,length)));
}

/* untagged */
F_STRING *from_c_string(const char *c_string)
{
	return memory_to_string((BYTE*)c_string,strlen(c_string));
}

/* FFI calls this */
void box_c_string(const char *c_string)
{
	dpush(c_string ? tag_object(from_c_string(c_string)) : F);
}

F_ARRAY *string_to_alien(F_STRING *s, bool check)
{
	CELL capacity = string_capacity(s);
	F_ARRAY *_c_str;
	
	if(check)
	{
		CELL i;
		for(i = 0; i < capacity; i++)
		{
			u16 ch = string_nth(s,i);
			if(ch == '\0' || ch > 255)
				general_error(ERROR_C_STRING,tag_object(s),true);
		}
	}

	_c_str = allot_array(BYTE_ARRAY_TYPE,capacity / CELLS + 1);
	BYTE *c_str = (BYTE*)(_c_str + 1);
	string_to_memory(s,c_str);
	c_str[capacity] = '\0';
	return _c_str;
}

/* untagged */
char *to_c_string(F_STRING *s, bool check)
{
	return (char*)(string_to_alien(s,check) + 1);
}

void string_to_memory(F_STRING *s, BYTE *string)
{
	CELL i;
	CELL capacity = string_capacity(s);
	for(i = 0; i < capacity; i++)
		string[i] = string_nth(s,i);
}

void primitive_string_to_memory(void)
{
	BYTE *address = (BYTE*)unbox_unsigned_cell();
	F_STRING *str = untag_string(dpop());
	string_to_memory(str,address);
}

/* FFI calls this */
char *unbox_c_string(void)
{
	CELL str = dpop();
	if(type_of(str) == STRING_TYPE)
		return to_c_string(untag_string(str),true);
	else
		return (char*)alien_offset(str);
}

/* this function is used when we really want only Factor strings as input, not
aliens. In particular, certian primitives crash if given a null pointer (f), so
we protect against this by using this function instead of unbox_c_string() */
char *pop_c_string(void)
{
	return to_c_string(untag_string(dpop()),true);
}

/* FFI calls this */
u16 *unbox_utf16_string(void)
{
	/* Return pointer to first character */
	CELL obj = dpop();

	if(type_of(obj) == STRING_TYPE)
	{
		F_STRING* str = untag_string(obj);
		u16 *unboxed = (u16*)(str + 1);

		CELL length = string_capacity(str);
		CELL i;

		for(i = 0; i < length; i++)
		{
			if(unboxed[i] == 0)
				general_error(ERROR_C_STRING,obj,true);
		}

		return unboxed;
	}
	else
		return (u16*)alien_offset(obj);
}

/* FFI calls this */
void box_utf16_string(u16 *unboxed)
{
	CELL length = 0;
	u16 *scan = unboxed;
	F_STRING *str;

	while(*scan++) length++;

	str = allot_string(length);
	memcpy((u16*)(str + 1),unboxed,length * sizeof(u16));
	rehash_string(str);
	dpush(tag_object(str));
}

void primitive_char_slot(void)
{
	F_STRING* string = untag_string_fast(dpop());
	CELL index = untag_fixnum_fast(dpop());
	dpush(tag_fixnum(string_nth(string,index)));
}

void primitive_set_char_slot(void)
{
	F_STRING* string = untag_string_fast(dpop());
	CELL index = untag_fixnum_fast(dpop());
	CELL value = untag_fixnum_fast(dpop());
	set_string_nth(string,index,value);
}