2004-07-16 02:26:21 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
|
|
|
/* untagged */
|
2004-12-24 02:52:02 -05:00
|
|
|
F_ARRAY* allot_array(CELL type, CELL capacity)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
2004-12-10 21:46:42 -05:00
|
|
|
F_ARRAY* array;
|
|
|
|
array = allot_object(type,sizeof(F_ARRAY) + capacity * CELLS);
|
2005-01-27 20:06:10 -05:00
|
|
|
array->capacity = tag_fixnum(capacity);
|
2004-07-16 02:26:21 -04:00
|
|
|
return array;
|
|
|
|
}
|
|
|
|
|
|
|
|
/* untagged */
|
2005-01-29 16:39:30 -05:00
|
|
|
F_ARRAY* array(CELL type, CELL capacity, CELL fill)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
int i;
|
|
|
|
|
2005-01-29 16:39:30 -05:00
|
|
|
F_ARRAY* array = allot_array(type, capacity);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
|
|
|
for(i = 0; i < capacity; i++)
|
|
|
|
put(AREF(array,i),fill);
|
|
|
|
|
|
|
|
return array;
|
|
|
|
}
|
|
|
|
|
2005-01-27 20:06:10 -05:00
|
|
|
void primitive_array(void)
|
|
|
|
{
|
|
|
|
F_FIXNUM capacity = to_fixnum(dpop());
|
|
|
|
if(capacity < 0)
|
|
|
|
general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
|
|
|
|
maybe_garbage_collection();
|
2005-01-29 16:39:30 -05:00
|
|
|
dpush(tag_object(array(ARRAY_TYPE,capacity,F)));
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_tuple(void)
|
|
|
|
{
|
|
|
|
F_FIXNUM capacity = to_fixnum(dpop());
|
|
|
|
if(capacity < 0)
|
|
|
|
general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
|
|
|
|
maybe_garbage_collection();
|
|
|
|
dpush(tag_object(array(TUPLE_TYPE,capacity,F)));
|
2005-01-27 20:06:10 -05:00
|
|
|
}
|
|
|
|
|
2004-12-24 02:52:02 -05:00
|
|
|
F_ARRAY* grow_array(F_ARRAY* array, CELL capacity, CELL fill)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
/* later on, do an optimization: if end of array is here, just grow */
|
|
|
|
int i;
|
2004-12-24 02:52:02 -05:00
|
|
|
F_ARRAY* new_array;
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL curr_cap = array_capacity(array);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-01-27 20:06:10 -05:00
|
|
|
if(curr_cap >= capacity)
|
2004-12-24 02:52:02 -05:00
|
|
|
return array;
|
|
|
|
|
|
|
|
new_array = allot_array(untag_header(array->header),capacity);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-01-29 16:39:30 -05:00
|
|
|
memcpy(new_array + 1,array + 1,curr_cap * CELLS);
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-01-27 20:06:10 -05:00
|
|
|
for(i = curr_cap; i < capacity; i++)
|
2004-07-16 02:26:21 -04:00
|
|
|
put(AREF(new_array,i),fill);
|
|
|
|
|
|
|
|
return new_array;
|
|
|
|
}
|
|
|
|
|
2004-12-24 02:52:02 -05:00
|
|
|
void primitive_grow_array(void)
|
|
|
|
{
|
2005-01-27 20:06:10 -05:00
|
|
|
F_ARRAY* array;
|
|
|
|
CELL capacity;
|
|
|
|
maybe_garbage_collection();
|
|
|
|
array = untag_array(dpop());
|
|
|
|
capacity = to_fixnum(dpop());
|
2004-12-24 02:52:02 -05:00
|
|
|
dpush(tag_object(grow_array(array,capacity,F)));
|
|
|
|
}
|
|
|
|
|
|
|
|
F_ARRAY* shrink_array(F_ARRAY* array, CELL capacity)
|
2004-08-24 23:46:55 -04:00
|
|
|
{
|
2004-12-10 21:46:42 -05:00
|
|
|
F_ARRAY* new_array = allot_array(untag_header(array->header),capacity);
|
2004-08-24 23:46:55 -04:00
|
|
|
memcpy(new_array + 1,array + 1,capacity * CELLS);
|
|
|
|
return new_array;
|
|
|
|
}
|
|
|
|
|
2004-12-10 21:46:42 -05:00
|
|
|
void fixup_array(F_ARRAY* array)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
int i = 0;
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL capacity = array_capacity(array);
|
2005-01-27 20:06:10 -05:00
|
|
|
for(i = 0; i < capacity; i++)
|
2004-12-25 02:55:03 -05:00
|
|
|
data_fixup((void*)AREF(array,i));
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
2004-12-10 21:46:42 -05:00
|
|
|
void collect_array(F_ARRAY* array)
|
2004-07-16 02:26:21 -04:00
|
|
|
{
|
|
|
|
int i = 0;
|
2005-02-20 19:03:37 -05:00
|
|
|
CELL capacity = array_capacity(array);
|
2005-01-27 20:06:10 -05:00
|
|
|
for(i = 0; i < capacity; i++)
|
2005-02-19 23:25:21 -05:00
|
|
|
copy_handle((void*)AREF(array,i));
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|