native/sbuf.c

   1 #include "factor.h"
   2
   3 SBUF* sbuf(FIXNUM capacity)
   4 {
   5         SBUF* sbuf = allot_object(SBUF_TYPE,sizeof(SBUF));
   6         sbuf->top = 0;
   7         sbuf->string = string(capacity,'\0');
   8         return sbuf;
   9 }
  10
  11 void primitive_sbufp(void)
  12 {
  13         check_non_empty(env.dt);
  14         env.dt = tag_boolean(typep(SBUF_TYPE,env.dt));
  15 }
  16
  17 void primitive_sbuf(void)
  18 {
  19         env.dt = tag_object(sbuf(to_fixnum(env.dt)));
  20 }
  21
  22 void primitive_sbuf_length(void)
  23 {
  24         env.dt = tag_fixnum(untag_sbuf(env.dt)->top);
  25 }
  26
  27 void primitive_set_sbuf_length(void)
  28 {
  29         SBUF* sbuf = untag_sbuf(env.dt);
  30         FIXNUM length = to_fixnum(dpop());
  31         sbuf->top = length;
  32         if(length < 0)
  33                 range_error(env.dt,length,sbuf->top);
  34         else if(length > sbuf->string->capacity)
  35                 sbuf->string = grow_string(sbuf->string,length,F);
  36         env.dt = dpop(); /* don't forget this! */
  37 }
  38
  39 void primitive_sbuf_nth(void)
  40 {
  41         SBUF* sbuf = untag_sbuf(env.dt);
  42         CELL index = to_fixnum(dpop());
  43
  44         if(index < 0 || index >= sbuf->top)
  45                 range_error(env.dt,index,sbuf->top);
  46         env.dt = string_nth(sbuf->string,index);
  47 }
  48
  49 void sbuf_ensure_capacity(SBUF* sbuf, int top)
  50 {
  51         STRING* string = sbuf->string;
  52         CELL capacity = string->capacity;
  53         if(top >= capacity)
  54                 sbuf->string = grow_string(string,top * 2 + 1,F);
  55         sbuf->top = top;
  56 }
  57
  58 void set_sbuf_nth(SBUF* sbuf, CELL index, CHAR value)
  59 {
  60         if(index < 0)
  61                 range_error(tag_object(sbuf),index,sbuf->top);
  62         else if(index >= sbuf->top)
  63                 sbuf_ensure_capacity(sbuf,index + 1);
  64
  65         /* the following does not check bounds! */
  66         set_string_nth(sbuf->string,index,value);
  67 }
  68
  69 void primitive_set_sbuf_nth(void)
  70 {
  71         SBUF* sbuf = untag_sbuf(env.dt);
  72         FIXNUM index = to_fixnum(dpop());
  73         CELL value = dpop();
  74         check_non_empty(value);
  75
  76         set_sbuf_nth(sbuf,index,value);
  77
  78         env.dt = dpop(); /* don't forget this! */
  79 }
  80
  81 void sbuf_append_string(SBUF* sbuf, STRING* string)
  82 {
  83         CELL top = sbuf->top;
  84         CELL strlen = string->capacity;
  85         sbuf_ensure_capacity(sbuf,top + strlen);
  86         memcpy((void*)((CELL)sbuf->string + sizeof(STRING) + top * CHARS),
  87                 (void*)((CELL)string + sizeof(STRING)),strlen * CHARS);
  88 }
  89
  90 void primitive_sbuf_append(void)
  91 {
  92         SBUF* sbuf = untag_sbuf(env.dt);
  93         CELL object = dpop();
  94         check_non_empty(object);
  95         env.dt = dpop();
  96         switch(type_of(object))
  97         {
  98         case FIXNUM_TYPE:
  99         case BIGNUM_TYPE:
 100                 set_sbuf_nth(sbuf,sbuf->top,to_fixnum(object));
 101                 break;
 102         case STRING_TYPE:
 103                 sbuf_append_string(sbuf,untag_string(object));
 104                 break;
 105         default:
 106                 type_error(STRING_TYPE,object);
 107                 break;
 108         }
 109 }
 110
 111 STRING* sbuf_to_string(SBUF* sbuf)
 112 {
 113         STRING* string = allot_string(sbuf->top);
 114         memcpy(string + 1,sbuf->string + 1,sbuf->top * CHARS);
 115         hash_string(string);
 116         return string;
 117 }
 118
 119 void primitive_sbuf_to_string(void)
 120 {
 121         env.dt = tag_object(sbuf_to_string(untag_sbuf(env.dt)));
 122 }
 123
 124 void fixup_sbuf(SBUF* sbuf)
 125 {
 126         sbuf->string = (STRING*)((CELL)sbuf->string
 127                 + (active->base - relocation_base));
 128 }
 129
 130 void collect_sbuf(SBUF* sbuf)
 131 {
 132         sbuf->string = copy_untagged_object(sbuf->string,
 133                 sizeof(sbuf->string) + sbuf->string->capacity);
 134 }