factor/native/sbuf.c

146 lines
2.9 KiB
C
Raw Normal View History

2004-07-16 02:26:21 -04:00
#include "factor.h"
F_SBUF* sbuf(F_FIXNUM capacity)
2004-07-16 02:26:21 -04:00
{
2004-12-25 02:55:03 -05:00
F_SBUF* sbuf;
if(capacity < 0)
general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
sbuf = allot_object(SBUF_TYPE,sizeof(F_SBUF));
2004-07-16 02:26:21 -04:00
sbuf->top = 0;
sbuf->string = tag_object(string(capacity,'\0'));
2004-07-16 02:26:21 -04:00
return sbuf;
}
void primitive_sbuf(void)
{
maybe_garbage_collection();
drepl(tag_object(sbuf(to_fixnum(dpeek()))));
2004-07-16 02:26:21 -04:00
}
void primitive_sbuf_length(void)
{
drepl(tag_fixnum(untag_sbuf(dpeek())->top));
2004-07-16 02:26:21 -04:00
}
void primitive_set_sbuf_length(void)
{
F_SBUF* sbuf;
F_FIXNUM length;
F_STRING* str;
maybe_garbage_collection();
sbuf = untag_sbuf(dpop());
str = untag_string(sbuf->string);
length = to_fixnum(dpop());
2004-07-16 02:26:21 -04:00
if(length < 0)
range_error(tag_object(sbuf),0,to_fixnum(length),sbuf->top);
2004-08-27 02:09:24 -04:00
sbuf->top = length;
if(length > string_capacity(str))
sbuf->string = tag_object(grow_string(str,length,F));
2004-07-16 02:26:21 -04:00
}
void primitive_sbuf_nth(void)
{
F_SBUF* sbuf = untag_sbuf(dpop());
2004-07-29 17:18:41 -04:00
CELL index = to_fixnum(dpop());
2004-07-16 02:26:21 -04:00
if(index < 0 || index >= sbuf->top)
range_error(tag_object(sbuf),0,tag_fixnum(index),sbuf->top);
2005-04-02 02:39:33 -05:00
dpush(tag_fixnum(string_nth(untag_string(sbuf->string),index)));
2004-07-16 02:26:21 -04:00
}
void sbuf_ensure_capacity(F_SBUF* sbuf, F_FIXNUM top)
2004-07-16 02:26:21 -04:00
{
F_STRING* string = untag_string(sbuf->string);
if(top >= string_capacity(string))
sbuf->string = tag_object(grow_string(string,top * 2 + 1,F));
2004-07-16 02:26:21 -04:00
sbuf->top = top;
}
2005-03-21 20:59:30 -05:00
void set_sbuf_nth(F_SBUF* sbuf, CELL index, u16 value)
2004-07-16 02:26:21 -04:00
{
if(index < 0)
range_error(tag_object(sbuf),0,tag_fixnum(index),sbuf->top);
2004-07-16 02:26:21 -04:00
else if(index >= sbuf->top)
sbuf_ensure_capacity(sbuf,index + 1);
/* the following does not check bounds! */
set_string_nth(untag_string(sbuf->string),index,value);
2004-07-16 02:26:21 -04:00
}
void primitive_set_sbuf_nth(void)
{
F_SBUF* sbuf;
F_FIXNUM index;
CELL value;
maybe_garbage_collection();
sbuf = untag_sbuf(dpop());
index = to_fixnum(dpop());
2005-04-07 18:54:02 -04:00
value = to_fixnum(dpop());
2004-07-16 02:26:21 -04:00
set_sbuf_nth(sbuf,index,value);
}
void sbuf_append_string(F_SBUF* sbuf, F_STRING* string)
2004-07-16 02:26:21 -04:00
{
CELL top = sbuf->top;
CELL strlen = string_capacity(string);
F_STRING* str;
2004-07-16 02:26:21 -04:00
sbuf_ensure_capacity(sbuf,top + strlen);
str = untag_string(sbuf->string);
memcpy((void*)((CELL)str + sizeof(F_STRING) + top * CHARS),
(void*)((CELL)string + sizeof(F_STRING)),strlen * CHARS);
2004-07-16 02:26:21 -04:00
}
void primitive_sbuf_append(void)
{
F_SBUF* sbuf;
CELL object;
maybe_garbage_collection();
sbuf = untag_sbuf(dpop());
object = dpop();
switch(type_of(object))
{
case FIXNUM_TYPE:
2004-07-29 17:18:41 -04:00
case BIGNUM_TYPE:
set_sbuf_nth(sbuf,sbuf->top,to_fixnum(object));
break;
case STRING_TYPE:
2004-07-16 02:26:21 -04:00
sbuf_append_string(sbuf,untag_string(object));
break;
default:
2004-12-27 22:58:43 -05:00
type_error(STRING_TYPE,object);
break;
}
2004-07-16 02:26:21 -04:00
}
2004-08-25 20:51:19 -04:00
void primitive_sbuf_clone(void)
2004-08-13 18:43:03 -04:00
{
F_SBUF* s;
F_SBUF* new_s;
maybe_garbage_collection();
s = untag_sbuf(dpeek());
new_s = sbuf(s->top);
sbuf_append_string(new_s,untag_string(s->string));
2004-08-13 18:43:03 -04:00
drepl(tag_object(new_s));
}
void fixup_sbuf(F_SBUF* sbuf)
2004-07-16 02:26:21 -04:00
{
2004-12-25 02:55:03 -05:00
data_fixup(&sbuf->string);
2004-07-16 02:26:21 -04:00
}
void collect_sbuf(F_SBUF* sbuf)
2004-07-16 02:26:21 -04:00
{
2005-02-19 23:25:21 -05:00
COPY_OBJECT(sbuf->string);
2004-07-16 02:26:21 -04:00
}