native/array.c

   1 #include "factor.h"
   2
   3 /* the array is full of undefined data, and must be correctly filled before the
   4 next GC. */
   5 F_ARRAY* allot_array(CELL type, CELL capacity)
   6 {
   7         F_ARRAY *array;
   8
   9         if(capacity < 0)
  10                 general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
  11
  12         array = allot_object(type,array_size(capacity));
  13         array->capacity = tag_fixnum(capacity);
  14         return array;
  15 }
  16
  17 /* WARNING: fill must be an immediate type:
  18 either be F or a fixnum.
  19
  20 if you want to use pass a pointer, you _must_ hit
  21 the write barrier manually with a write_barrier()
  22 call with the returned object. */
  23 F_ARRAY* array(CELL type, CELL capacity, CELL fill)
  24 {
  25         int i; F_ARRAY* array = allot_array(type, capacity);
  26         for(i = 0; i < capacity; i++)
  27                 put(AREF(array,i),fill);
  28         return array;
  29 }
  30
  31 void primitive_array(void)
  32 {
  33         CELL size = to_fixnum(dpop());
  34         maybe_gc(array_size(size));
  35         dpush(tag_object(array(ARRAY_TYPE,size,F)));
  36 }
  37
  38 void primitive_tuple(void)
  39 {
  40         CELL size = to_fixnum(dpop());
  41         maybe_gc(array_size(size));
  42         dpush(tag_object(array(TUPLE_TYPE,size,F)));
  43 }
  44
  45 void primitive_byte_array(void)
  46 {
  47         CELL size = to_fixnum(dpop());
  48         maybe_gc(array_size(size));
  49         dpush(tag_object(array(BYTE_ARRAY_TYPE,size,0)));
  50 }
  51
  52 /* see note about fill in array() */
  53 F_ARRAY* resize_array(F_ARRAY* array, CELL capacity, CELL fill)
  54 {
  55         int i;
  56         F_ARRAY* new_array;
  57
  58         CELL to_copy = array_capacity(array);
  59         if(capacity < to_copy)
  60                 to_copy = capacity;
  61
  62         new_array = allot_array(untag_header(array->header),capacity);
  63
  64         memcpy(new_array + 1,array + 1,to_copy * CELLS);
  65
  66         for(i = to_copy; i < capacity; i++)
  67                 put(AREF(new_array,i),fill);
  68
  69         return new_array;
  70 }
  71
  72 void primitive_resize_array(void)
  73 {
  74         F_ARRAY* array;
  75         CELL capacity = to_fixnum(dpeek2());
  76         maybe_gc(array_size(capacity));
  77         array = untag_array_fast(dpop());
  78         drepl(tag_object(resize_array(array,capacity,F)));
  79 }
  80
  81 void fixup_array(F_ARRAY* array)
  82 {
  83         int i = 0; CELL capacity = array_capacity(array);
  84         for(i = 0; i < capacity; i++)
  85                 data_fixup((void*)AREF(array,i));
  86 }
  87
  88 void collect_array(F_ARRAY* array)
  89 {
  90         int i = 0; CELL capacity = array_capacity(array);
  91         for(i = 0; i < capacity; i++)
  92                 copy_handle((void*)AREF(array,i));
  93 }