2004-07-16 02:26:21 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
|
|
|
/* untagged */
|
2004-12-25 02:55:03 -05:00
|
|
|
F_STRING* allot_string(CELL capacity)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2004-12-25 02:55:03 -05:00
|
|
|
F_STRING* string = allot_object(STRING_TYPE,
|
2005-02-09 19:58:53 -05:00
|
|
|
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. */
|
2005-03-21 20:59:30 -05:00
|
|
|
cput(SREF(string,capacity),(u16)'\0');
|
2005-02-20 19:03:37 -05:00
|
|
|
string->length = tag_fixnum(capacity);
|
2004-07-16 02:26:21 -04:00
|
|
|
return string;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* call this after constructing a string */
|
2005-02-20 19:03:37 -05:00
|
|
|
void rehash_string(F_STRING* str)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2004-12-10 21:46:42 -05:00
|
|
|
F_FIXNUM hash = 0;
|
2004-08-01 19:26:43 -04:00
|
|
|
CELL i;
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL capacity = string_capacity(str);
|
|
|
|
for(i = 0; i < capacity; i++)
|
2004-07-16 02:26:21 -04:00
|
|
|
hash = 31*hash + string_nth(str,i);
|
2005-02-20 19:03:37 -05:00
|
|
|
str->hashcode = tag_fixnum(hash);
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
2005-05-18 16:26:22 -04:00
|
|
|
void primitive_rehash_string(void)
|
|
|
|
{
|
|
|
|
rehash_string(untag_string(dpop()));
|
|
|
|
}
|
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
/* untagged */
|
2004-12-25 02:55:03 -05:00
|
|
|
F_STRING* string(CELL capacity, CELL fill)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2004-08-01 19:26:43 -04:00
|
|
|
CELL i;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-12-10 21:46:42 -05:00
|
|
|
F_STRING* string = allot_string(capacity);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
for(i = 0; i < capacity; i++)
|
2004-08-07 18:45:48 -04:00
|
|
|
cput(SREF(string,i),fill);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-09-26 21:34:25 -04:00
|
|
|
rehash_string(string);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
return string;
|
|
|
|
}
|
|
|
|
|
2005-06-10 16:08:00 -04:00
|
|
|
F_STRING* resize_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
/* later on, do an optimization: if end of array is here, just grow */
|
2004-08-01 19:26:43 -04:00
|
|
|
CELL i;
|
2005-06-10 16:08:00 -04:00
|
|
|
CELL to_copy = string_capacity(string);
|
|
|
|
|
|
|
|
if(capacity < to_copy)
|
|
|
|
to_copy = capacity;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-12-10 21:46:42 -05:00
|
|
|
F_STRING* new_string = allot_string(capacity);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-10 16:08:00 -04:00
|
|
|
memcpy(new_string + 1,string + 1,to_copy * CHARS);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-06-10 16:08:00 -04:00
|
|
|
for(i = to_copy; i < capacity; i++)
|
2004-08-07 18:45:48 -04:00
|
|
|
cput(SREF(new_string,i),fill);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
return new_string;
|
|
|
|
}
|
|
|
|
|
2005-06-10 16:08:00 -04:00
|
|
|
void primitive_resize_string(void)
|
2005-05-05 22:30:58 -04:00
|
|
|
{
|
|
|
|
F_STRING* string; CELL capacity;
|
|
|
|
maybe_garbage_collection();
|
|
|
|
string = untag_string_fast(dpop());
|
|
|
|
capacity = to_fixnum(dpop());
|
2005-06-10 16:08:00 -04:00
|
|
|
dpush(tag_object(resize_string(string,capacity,F)));
|
2005-05-05 22:30:58 -04:00
|
|
|
}
|
|
|
|
|
2005-04-22 20:09:46 -04:00
|
|
|
F_STRING* memory_to_string(const BYTE* string, CELL length)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2004-12-10 21:46:42 -05:00
|
|
|
F_STRING* s = allot_string(length);
|
2004-08-01 19:26:43 -04:00
|
|
|
CELL i;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
for(i = 0; i < length; i++)
|
|
|
|
{
|
2004-12-19 21:07:17 -05:00
|
|
|
cput(SREF(s,i),*string);
|
|
|
|
string++;
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
2004-09-26 21:34:25 -04:00
|
|
|
rehash_string(s);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
return s;
|
|
|
|
}
|
|
|
|
|
2004-12-19 21:07:17 -05:00
|
|
|
void primitive_memory_to_string(void)
|
|
|
|
{
|
2005-03-28 23:45:13 -05:00
|
|
|
CELL length = unbox_unsigned_cell();
|
|
|
|
BYTE* string = (BYTE*)unbox_unsigned_cell();
|
2004-12-19 21:07:17 -05:00
|
|
|
dpush(tag_object(memory_to_string(string,length)));
|
|
|
|
}
|
|
|
|
|
|
|
|
/* untagged */
|
2005-03-03 20:43:55 -05:00
|
|
|
F_STRING* from_c_string(const char* c_string)
|
2004-12-19 21:07:17 -05:00
|
|
|
{
|
2005-03-03 20:43:55 -05:00
|
|
|
return memory_to_string((BYTE*)c_string,strlen(c_string));
|
2004-12-19 21:07:17 -05:00
|
|
|
}
|
|
|
|
|
2004-09-19 17:39:28 -04:00
|
|
|
/* FFI calls this */
|
2005-03-03 20:43:55 -05:00
|
|
|
void box_c_string(const char* c_string)
|
2004-09-19 17:39:28 -04:00
|
|
|
{
|
|
|
|
dpush(tag_object(from_c_string(c_string)));
|
|
|
|
}
|
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
/* untagged */
|
2005-03-03 20:43:55 -05:00
|
|
|
char* to_c_string(F_STRING* s)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2004-08-01 19:26:43 -04:00
|
|
|
CELL i;
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL capacity = string_capacity(s);
|
|
|
|
for(i = 0; i < capacity; i++)
|
2004-09-06 22:39:12 -04:00
|
|
|
{
|
2005-03-21 20:59:30 -05:00
|
|
|
u16 ch = string_nth(s,i);
|
2004-09-06 22:39:12 -04:00
|
|
|
if(ch == '\0' || ch > 255)
|
|
|
|
general_error(ERROR_C_STRING,tag_object(s));
|
|
|
|
}
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-11-13 18:07:18 -05:00
|
|
|
return to_c_string_unchecked(s);
|
|
|
|
}
|
|
|
|
|
2005-04-22 20:09:46 -04:00
|
|
|
void string_to_memory(F_STRING* s, BYTE* string)
|
2004-12-19 21:07:17 -05:00
|
|
|
{
|
|
|
|
CELL i;
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL capacity = string_capacity(s);
|
|
|
|
for(i = 0; i < capacity; i++)
|
2004-12-19 21:07:17 -05:00
|
|
|
string[i] = string_nth(s,i);
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_string_to_memory(void)
|
|
|
|
{
|
2005-03-28 23:45:13 -05:00
|
|
|
BYTE* address = (BYTE*)unbox_unsigned_cell();
|
2004-12-22 22:23:13 -05:00
|
|
|
F_STRING* str = untag_string(dpop());
|
2004-12-19 21:07:17 -05:00
|
|
|
string_to_memory(str,address);
|
|
|
|
}
|
|
|
|
|
2004-11-13 18:07:18 -05:00
|
|
|
/* untagged */
|
2005-03-03 20:43:55 -05:00
|
|
|
char* to_c_string_unchecked(F_STRING* s)
|
2004-11-13 18:07:18 -05:00
|
|
|
{
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL capacity = string_capacity(s);
|
|
|
|
F_STRING* _c_str = allot_string(capacity / CHARS + 1);
|
2004-11-13 18:07:18 -05:00
|
|
|
BYTE* c_str = (BYTE*)(_c_str + 1);
|
2004-12-19 21:07:17 -05:00
|
|
|
string_to_memory(s,c_str);
|
2005-02-20 19:03:37 -05:00
|
|
|
c_str[capacity] = '\0';
|
2005-03-03 20:43:55 -05:00
|
|
|
return (char*)c_str;
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
2004-09-19 17:39:28 -04:00
|
|
|
/* FFI calls this */
|
2005-03-03 20:43:55 -05:00
|
|
|
char* unbox_c_string(void)
|
2004-09-19 17:39:28 -04:00
|
|
|
{
|
|
|
|
return to_c_string(untag_string(dpop()));
|
|
|
|
}
|
|
|
|
|
2005-02-08 22:02:44 -05:00
|
|
|
/* FFI calls this */
|
2005-03-21 20:59:30 -05:00
|
|
|
u16* unbox_utf16_string(void)
|
2005-02-08 22:02:44 -05:00
|
|
|
{
|
|
|
|
/* Return pointer to first character */
|
2005-03-21 20:59:30 -05:00
|
|
|
return (u16*)(untag_string(dpop()) + 1);
|
2005-02-08 22:02:44 -05:00
|
|
|
}
|
|
|
|
|
2005-05-05 22:30:58 -04:00
|
|
|
void primitive_char_slot(void)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2005-05-05 22:30:58 -04:00
|
|
|
F_STRING* string = untag_string_fast(dpop());
|
|
|
|
CELL index = untag_fixnum_fast(dpop());
|
2004-08-12 17:36:36 -04:00
|
|
|
dpush(tag_fixnum(string_nth(string,index)));
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
2005-05-05 22:30:58 -04:00
|
|
|
void primitive_set_char_slot(void)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2005-05-05 22:30:58 -04:00
|
|
|
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);
|
2004-08-12 01:07:22 -04:00
|
|
|
}
|
|
|
|
|
2004-12-10 21:46:42 -05:00
|
|
|
F_FIXNUM string_compare(F_STRING* s1, F_STRING* s2)
|
2004-08-12 01:07:22 -04:00
|
|
|
{
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL len1 = string_capacity(s1);
|
|
|
|
CELL len2 = string_capacity(s2);
|
2004-08-12 01:07:22 -04:00
|
|
|
|
|
|
|
CELL limit = (len1 < len2 ? len1 : len2);
|
|
|
|
|
2005-05-05 22:30:58 -04:00
|
|
|
CELL i = 0;
|
|
|
|
while(i < limit)
|
|
|
|
{
|
|
|
|
u16 c1 = string_nth(s1,i);
|
|
|
|
u16 c2 = string_nth(s2,i);
|
|
|
|
if(c1 != c2)
|
|
|
|
return c1 - c2;
|
|
|
|
i++;
|
|
|
|
}
|
|
|
|
|
|
|
|
return len1 - len2;
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_string_compare(void)
|
|
|
|
{
|
2004-12-10 21:46:42 -05:00
|
|
|
F_STRING* s2 = untag_string(dpop());
|
|
|
|
F_STRING* s1 = untag_string(dpop());
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2004-08-12 17:36:36 -04:00
|
|
|
dpush(tag_fixnum(string_compare(s1,s2)));
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|