diff --git a/vm/alien.c b/vm/alien.c old mode 100644 new mode 100755 diff --git a/vm/code_heap.c b/vm/code_heap.c index 5771725f9d..f449445eb9 100755 --- a/vm/code_heap.c +++ b/vm/code_heap.c @@ -176,7 +176,7 @@ void deposit_integers(CELL here, F_ARRAY *array, CELL format) { F_FIXNUM value = to_fixnum(array_nth(array,i)); if(format == 1) - cput(here + i,value); + bput(here + i,value); else if(format == sizeof(unsigned int)) *(unsigned int *)(here + format * i) = value; else if(format == CELLS) diff --git a/vm/layouts.h b/vm/layouts.h index 2b8957ee66..ef6fb3d4ac 100755 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -19,9 +19,6 @@ typedef signed long long s64; #define CELLS ((signed)sizeof(CELL)) -/* must always be 16 bits */ -#define CHARS ((signed)sizeof(u16)) - #define WORD_SIZE (CELLS*8) #define HALF_WORD_SIZE (CELLS*4) #define HALF_WORD_MASK (((unsigned long)1<aux == F) + return ch; + else + { + F_BYTE_ARRAY *aux = untag_object(string->aux); + return (cget(BREF(aux,index * sizeof(u16))) << 8) | ch; + } +} + +void set_string_nth(F_STRING* string, CELL index, CELL value) +{ + bput(SREF(string,index),value & 0xff); + + if(string->aux == F) + { + if(value <= 0xff) + return; + else + { + string->aux = tag_object(allot_byte_array( + untag_fixnum_fast(string->length) + * sizeof(u16))); + } + } + + F_BYTE_ARRAY *aux = untag_object(string->aux); + cput(BREF(aux,index * sizeof(u16)),value >> 8); +} /* untagged */ F_STRING* allot_string_internal(CELL capacity) { - F_STRING* string = allot_object(STRING_TYPE, - sizeof(F_STRING) + (capacity + 1) * CHARS); + F_STRING *string = allot_object(STRING_TYPE,string_size(capacity)); /* 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 char* string for C library calls. */ - set_string_nth(string,capacity,0); string->length = tag_fixnum(capacity); string->hashcode = F; string->aux = F; + set_string_nth(string,capacity,0); return string; } void fill_string(F_STRING *string, CELL start, CELL capacity, CELL fill) { if(fill == 0) - memset((void*)SREF(string,start),'\0', - (capacity - start) * CHARS); + memset((void*)SREF(string,start),'\0',capacity - start); else { CELL i; @@ -466,7 +495,7 @@ DEFINE_PRIMITIVE(string) dpush(tag_object(allot_string(length,initial))); } -F_STRING* reallot_string(F_STRING* string, CELL capacity, u16 fill) +F_STRING* reallot_string(F_STRING* string, CELL capacity, CELL fill) { CELL to_copy = string_capacity(string); if(capacity < to_copy) @@ -476,7 +505,7 @@ F_STRING* reallot_string(F_STRING* string, CELL capacity, u16 fill) F_STRING *new_string = allot_string_internal(capacity); UNREGISTER_UNTAGGED(string); - memcpy(new_string + 1,string + 1,to_copy * CHARS); + memcpy(new_string + 1,string + 1,to_copy); fill_string(new_string,to_copy,capacity,fill); return new_string; @@ -530,7 +559,7 @@ bool check_string(F_STRING *s, CELL max) CELL i; for(i = 0; i < capacity; i++) { - u16 ch = string_nth(s,i); + CELL ch = string_nth(s,i); if(ch == '\0' || ch >= (1 << (max * 8))) return false; } @@ -572,7 +601,7 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size) } \ type *to_##type##_string(F_STRING *s, bool check) \ { \ - if(sizeof(type) == sizeof(u16)) \ + if(sizeof(type) == sizeof(char)) \ { \ if(check && !check_string(s,sizeof(type))) \ general_error(ERROR_C_STRING,tag_object(s),F,NULL); \ @@ -597,16 +626,16 @@ F_BYTE_ARRAY *allot_c_string(CELL capacity, CELL size) STRING_TO_MEMORY(char); STRING_TO_MEMORY(u16); -DEFINE_PRIMITIVE(char_slot) +DEFINE_PRIMITIVE(string_nth) { - F_STRING* string = untag_object(dpop()); + F_STRING *string = untag_object(dpop()); CELL index = untag_fixnum_fast(dpop()); dpush(tag_fixnum(string_nth(string,index))); } -DEFINE_PRIMITIVE(set_char_slot) +DEFINE_PRIMITIVE(set_string_nth) { - F_STRING* string = untag_object(dpop()); + F_STRING *string = untag_object(dpop()); CELL index = untag_fixnum_fast(dpop()); CELL value = untag_fixnum_fast(dpop()); set_string_nth(string,index,value); diff --git a/vm/types.h b/vm/types.h index dca54e5951..6f4234af34 100755 --- a/vm/types.h +++ b/vm/types.h @@ -11,7 +11,7 @@ INLINE CELL string_capacity(F_STRING* str) INLINE CELL string_size(CELL size) { - return sizeof(F_STRING) + (size + 1) * CHARS; + return sizeof(F_STRING) + size + 1; } DEFINE_UNTAG(F_BYTE_ARRAY,BYTE_ARRAY_TYPE,byte_array) @@ -83,7 +83,8 @@ INLINE CELL array_capacity(F_ARRAY* array) return array->capacity >> TAG_BITS; } -#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index * CHARS) +#define BREF(byte_array,index) ((CELL)byte_array + sizeof(F_BYTE_ARRAY) + index) +#define SREF(string,index) ((CELL)string + sizeof(F_STRING) + index) INLINE F_STRING* untag_string(CELL tagged) { @@ -91,16 +92,6 @@ INLINE F_STRING* untag_string(CELL tagged) return untag_object(tagged); } -INLINE CELL string_nth(F_STRING* string, CELL index) -{ - return cget(SREF(string,index)); -} - -INLINE void set_string_nth(F_STRING* string, CELL index, u16 value) -{ - cput(SREF(string,index),value); -} - DEFINE_UNTAG(F_QUOTATION,QUOTATION_TYPE,quotation) DEFINE_UNTAG(F_WORD,WORD_TYPE,word) @@ -141,7 +132,7 @@ DECLARE_PRIMITIVE(resize_float_array); F_STRING* allot_string_internal(CELL capacity); F_STRING* allot_string(CELL capacity, CELL fill); DECLARE_PRIMITIVE(string); -F_STRING *reallot_string(F_STRING *string, CELL capacity, u16 fill); +F_STRING *reallot_string(F_STRING *string, CELL capacity, CELL fill); DECLARE_PRIMITIVE(resize_string); F_STRING *memory_to_char_string(const char *string, CELL length); @@ -166,8 +157,12 @@ u16* to_u16_string(F_STRING *s, bool check); DLLEXPORT u16 *unbox_u16_string(void); DECLARE_PRIMITIVE(string_to_u16_alien); -DECLARE_PRIMITIVE(char_slot); -DECLARE_PRIMITIVE(set_char_slot); +/* String getters and setters */ +CELL string_nth(F_STRING* string, CELL index); +void set_string_nth(F_STRING* string, CELL index, CELL value); + +DECLARE_PRIMITIVE(string_nth); +DECLARE_PRIMITIVE(set_string_nth); F_WORD *allot_word(CELL vocab, CELL name); DECLARE_PRIMITIVE(word);