2009-05-02 05:04:19 -04:00
|
|
|
#include "master.hpp"
|
|
|
|
|
2009-05-04 02:46:13 -04:00
|
|
|
namespace factor
|
|
|
|
{
|
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
CELL string_nth(F_STRING* string, CELL index)
|
|
|
|
{
|
|
|
|
/* If high bit is set, the most significant 16 bits of the char
|
|
|
|
come from the aux vector. The least significant bit of the
|
|
|
|
corresponding aux vector entry is negated, so that we can
|
|
|
|
XOR the two components together and get the original code point
|
|
|
|
back. */
|
2009-05-04 02:00:30 -04:00
|
|
|
CELL lo_bits = string->data()[index];
|
|
|
|
|
|
|
|
if((lo_bits & 0x80) == 0)
|
|
|
|
return lo_bits;
|
2009-05-02 05:04:19 -04:00
|
|
|
else
|
|
|
|
{
|
2009-05-02 21:47:29 -04:00
|
|
|
F_BYTE_ARRAY *aux = untag<F_BYTE_ARRAY>(string->aux);
|
2009-05-04 02:00:30 -04:00
|
|
|
CELL hi_bits = aux->data<u16>()[index];
|
|
|
|
return (hi_bits << 7) ^ lo_bits;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
void set_string_nth_fast(F_STRING *string, CELL index, CELL ch)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-04 02:00:30 -04:00
|
|
|
string->data()[index] = ch;
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
void set_string_nth_slow(F_STRING *string_, CELL index, CELL ch)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_STRING> string(string_);
|
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
F_BYTE_ARRAY *aux;
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
string->data()[index] = ((ch & 0x7f) | 0x80);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
|
|
|
if(string->aux == F)
|
|
|
|
{
|
|
|
|
/* We don't need to pre-initialize the
|
|
|
|
byte array with any data, since we
|
|
|
|
only ever read from the aux vector
|
|
|
|
if the most significant bit of a
|
|
|
|
character is set. Initially all of
|
|
|
|
the bits are clear. */
|
2009-05-02 05:43:58 -04:00
|
|
|
aux = allot_array_internal<F_BYTE_ARRAY>(
|
2009-05-02 21:47:29 -04:00
|
|
|
untag_fixnum(string->length)
|
2009-05-02 05:04:19 -04:00
|
|
|
* sizeof(u16));
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
write_barrier(string.untagged());
|
2009-05-02 21:47:29 -04:00
|
|
|
string->aux = tag<F_BYTE_ARRAY>(aux);
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
else
|
2009-05-02 21:47:29 -04:00
|
|
|
aux = untag<F_BYTE_ARRAY>(string->aux);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
aux->data<u16>()[index] = ((ch >> 7) ^ 1);
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
/* allocates memory */
|
|
|
|
void set_string_nth(F_STRING* string, CELL index, CELL ch)
|
|
|
|
{
|
|
|
|
if(ch <= 0x7f)
|
|
|
|
set_string_nth_fast(string,index,ch);
|
|
|
|
else
|
|
|
|
set_string_nth_slow(string,index,ch);
|
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
/* Allocates memory */
|
|
|
|
F_STRING *allot_string_internal(CELL capacity)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
F_STRING *string = allot<F_STRING>(string_size(capacity));
|
2009-05-02 05:04:19 -04:00
|
|
|
|
|
|
|
string->length = tag_fixnum(capacity);
|
|
|
|
string->hashcode = F;
|
|
|
|
string->aux = F;
|
|
|
|
|
|
|
|
return string;
|
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
/* Allocates memory */
|
|
|
|
void fill_string(F_STRING *string_, CELL start, CELL capacity, CELL fill)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_STRING> string(string_);
|
|
|
|
|
2009-05-02 05:04:19 -04:00
|
|
|
if(fill <= 0x7f)
|
2009-05-04 02:00:30 -04:00
|
|
|
memset(&string->data()[start],fill,capacity - start);
|
2009-05-02 05:04:19 -04:00
|
|
|
else
|
|
|
|
{
|
|
|
|
CELL i;
|
|
|
|
|
|
|
|
for(i = start; i < capacity; i++)
|
2009-05-02 10:19:09 -04:00
|
|
|
set_string_nth(string.untagged(),i,fill);
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
/* Allocates memory */
|
2009-05-02 05:04:19 -04:00
|
|
|
F_STRING *allot_string(CELL capacity, CELL fill)
|
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_STRING> string(allot_string_internal(capacity));
|
|
|
|
fill_string(string.untagged(),0,capacity,fill);
|
|
|
|
return string.untagged();
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
PRIMITIVE(string)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
|
|
|
CELL initial = to_cell(dpop());
|
|
|
|
CELL length = unbox_array_size();
|
2009-05-02 21:47:29 -04:00
|
|
|
dpush(tag<F_STRING>(allot_string(length,initial)));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
static bool reallot_string_in_place_p(F_STRING *string, CELL capacity)
|
|
|
|
{
|
2009-05-04 02:00:30 -04:00
|
|
|
return in_zone(&nursery,string) && capacity <= string_capacity(string);
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
F_STRING* reallot_string(F_STRING *string_, CELL capacity)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_STRING> string(string_);
|
|
|
|
|
|
|
|
if(reallot_string_in_place_p(string.untagged(),capacity))
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
|
|
|
string->length = tag_fixnum(capacity);
|
|
|
|
|
|
|
|
if(string->aux != F)
|
|
|
|
{
|
2009-05-02 21:47:29 -04:00
|
|
|
F_BYTE_ARRAY *aux = untag<F_BYTE_ARRAY>(string->aux);
|
2009-05-02 05:04:19 -04:00
|
|
|
aux->capacity = tag_fixnum(capacity * 2);
|
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
return string.untagged();
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
else
|
|
|
|
{
|
2009-05-02 10:19:09 -04:00
|
|
|
CELL to_copy = string_capacity(string.untagged());
|
2009-05-02 05:04:19 -04:00
|
|
|
if(capacity < to_copy)
|
|
|
|
to_copy = capacity;
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
gc_root<F_STRING> new_string(allot_string_internal(capacity));
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
memcpy(new_string->data(),string->data(),to_copy);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
|
|
|
if(string->aux != F)
|
|
|
|
{
|
|
|
|
F_BYTE_ARRAY *new_aux = allot_byte_array(capacity * sizeof(u16));
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
write_barrier(new_string.untagged());
|
2009-05-02 21:47:29 -04:00
|
|
|
new_string->aux = tag<F_BYTE_ARRAY>(new_aux);
|
2009-05-02 05:04:19 -04:00
|
|
|
|
2009-05-02 21:47:29 -04:00
|
|
|
F_BYTE_ARRAY *aux = untag<F_BYTE_ARRAY>(string->aux);
|
2009-05-04 02:00:30 -04:00
|
|
|
memcpy(new_aux->data<u16>(),aux->data<u16>(),to_copy * sizeof(u16));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-02 10:19:09 -04:00
|
|
|
fill_string(new_string.untagged(),to_copy,capacity,'\0');
|
|
|
|
return new_string.untagged();
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
PRIMITIVE(resize_string)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 21:47:29 -04:00
|
|
|
F_STRING* string = untag_check<F_STRING>(dpop());
|
2009-05-02 05:04:19 -04:00
|
|
|
CELL capacity = unbox_array_size();
|
2009-05-02 21:47:29 -04:00
|
|
|
dpush(tag<F_STRING>(reallot_string(string,capacity)));
|
2009-05-02 05:04:19 -04:00
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
PRIMITIVE(string_nth)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 21:47:29 -04:00
|
|
|
F_STRING *string = untag<F_STRING>(dpop());
|
|
|
|
CELL index = untag_fixnum(dpop());
|
2009-05-02 05:04:19 -04:00
|
|
|
dpush(tag_fixnum(string_nth(string,index)));
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
PRIMITIVE(set_string_nth_fast)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 21:47:29 -04:00
|
|
|
F_STRING *string = untag<F_STRING>(dpop());
|
|
|
|
CELL index = untag_fixnum(dpop());
|
|
|
|
CELL value = untag_fixnum(dpop());
|
2009-05-02 05:04:19 -04:00
|
|
|
set_string_nth_fast(string,index,value);
|
|
|
|
}
|
|
|
|
|
2009-05-04 02:00:30 -04:00
|
|
|
PRIMITIVE(set_string_nth_slow)
|
2009-05-02 05:04:19 -04:00
|
|
|
{
|
2009-05-02 21:47:29 -04:00
|
|
|
F_STRING *string = untag<F_STRING>(dpop());
|
|
|
|
CELL index = untag_fixnum(dpop());
|
|
|
|
CELL value = untag_fixnum(dpop());
|
2009-05-02 05:04:19 -04:00
|
|
|
set_string_nth_slow(string,index,value);
|
|
|
|
}
|
2009-05-04 02:46:13 -04:00
|
|
|
|
|
|
|
}
|