#include "factor.h" SBUF* sbuf(FIXNUM capacity) { SBUF* sbuf = allot_object(SBUF_TYPE,sizeof(SBUF)); sbuf->top = 0; sbuf->string = string(capacity,'\0'); return sbuf; } void primitive_sbuf(void) { drepl(tag_object(sbuf(to_fixnum(dpeek())))); } void primitive_sbuf_length(void) { drepl(tag_fixnum(untag_sbuf(dpeek())->top)); } void primitive_set_sbuf_length(void) { SBUF* sbuf = untag_sbuf(dpop()); FIXNUM length = to_fixnum(dpop()); if(length < 0) range_error(tag_object(sbuf),length,sbuf->top); sbuf->top = length; if(length > sbuf->string->capacity) sbuf->string = grow_string(sbuf->string,length,F); } void primitive_sbuf_nth(void) { SBUF* sbuf = untag_sbuf(dpop()); CELL index = to_fixnum(dpop()); if(index < 0 || index >= sbuf->top) range_error(tag_object(sbuf),index,sbuf->top); dpush(string_nth(sbuf->string,index)); } void sbuf_ensure_capacity(SBUF* sbuf, FIXNUM top) { STRING* string = sbuf->string; CELL capacity = string->capacity; if(top >= capacity) sbuf->string = grow_string(string,top * 2 + 1,F); sbuf->top = top; } void set_sbuf_nth(SBUF* sbuf, CELL index, CHAR value) { if(index < 0) range_error(tag_object(sbuf),index,sbuf->top); else if(index >= sbuf->top) sbuf_ensure_capacity(sbuf,index + 1); /* the following does not check bounds! */ set_string_nth(sbuf->string,index,value); } void primitive_set_sbuf_nth(void) { SBUF* sbuf = untag_sbuf(dpop()); FIXNUM index = to_fixnum(dpop()); CELL value = dpop(); set_sbuf_nth(sbuf,index,value); } void sbuf_append_string(SBUF* sbuf, STRING* string) { CELL top = sbuf->top; CELL strlen = string->capacity; sbuf_ensure_capacity(sbuf,top + strlen); memcpy((void*)((CELL)sbuf->string + sizeof(STRING) + top * CHARS), (void*)((CELL)string + sizeof(STRING)),strlen * CHARS); } void primitive_sbuf_append(void) { SBUF* sbuf = untag_sbuf(dpop()); CELL object = dpop(); switch(type_of(object)) { case FIXNUM_TYPE: case BIGNUM_TYPE: set_sbuf_nth(sbuf,sbuf->top,to_fixnum(object)); break; case STRING_TYPE: sbuf_append_string(sbuf,untag_string(object)); break; default: type_error(TEXT_TYPE,object); break; } } void primitive_sbuf_to_string(void) { SBUF* sbuf = untag_sbuf(dpeek()); STRING* s = string_clone(sbuf->string,sbuf->top); rehash_string(s); drepl(tag_object(s)); } void primitive_sbuf_reverse(void) { SBUF* sbuf = untag_sbuf(dpop()); string_reverse(sbuf->string,sbuf->top); } void primitive_sbuf_clone(void) { SBUF* s = untag_sbuf(dpeek()); SBUF* new_s = sbuf(s->top); sbuf_append_string(new_s,s->string); drepl(tag_object(new_s)); } bool sbuf_eq(SBUF* s1, SBUF* s2) { if(s1 == s2) return true; else if(s1->top == s2->top) return (string_compare_head(s1->string,s2->string,s1->top) == 0); else return false; } void primitive_sbuf_eq(void) { SBUF* s1 = untag_sbuf(dpop()); CELL with = dpop(); if(typep(SBUF_TYPE,with)) dpush(tag_boolean(sbuf_eq(s1,(SBUF*)UNTAG(with)))); else dpush(F); } void primitive_sbuf_hashcode(void) { SBUF* sbuf = untag_sbuf(dpop()); dpush(tag_fixnum(hash_string(sbuf->string,sbuf->top))); } void fixup_sbuf(SBUF* sbuf) { sbuf->string = fixup_untagged_string(sbuf->string); } void collect_sbuf(SBUF* sbuf) { sbuf->string = copy_untagged_string(sbuf->string); }