Head

GCC Code Coverage Report

Directory:	../src/		Exec	Total	Coverage
File:	/home/joels/Current/lispbm/src/lbm_defrag_mem.c	Lines:	126	128	98.4 %
Date:	2025-04-09 11:39:30	Branches:	43	51	84.3 %


/*
    Copyright 2024, 2025 Joel Svensson        svenssonjoel@yahoo.se

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#include <lbm_defrag_mem.h>
#include <heap.h>
#include <lbm_memory.h>

static inline lbm_uint bs2ws(lbm_uint bs) {
  return bs % sizeof(lbm_uint) == 0 ? bs / sizeof(lbm_uint) : (bs / sizeof(lbm_uint)) + 1;
}

#define DEFRAG_MEM_HEADER_SIZE 2
#define DEFRAG_MEM_HEADER_BYTES  (DEFRAG_MEM_HEADER_SIZE*sizeof(lbm_uint))
#define DEFRAG_MEM_DATA(X) &(X)[DEFRAG_MEM_HEADER_SIZE];
// length and flags.
// Currently only one flag that tells if we should do a compaction before allocation.
#define DEFRAG_MEM_SIZE(X) X[0]
#define DEFRAG_MEM_FLAGS(X) X[1]

// TODO: We can move the GC index to the end (or elsewhere) of an array to save space in these
//       headers in the case of ByteArrays.
#define DEFRAG_ALLOC_SIZE(X) X[0]
#define DEFRAG_ALLOC_DATA(X) X[1]
//#define DEFRAG_ALLOC_INDEX(X) X[2] // GC index for traversal of high-level arrays
#define DEFRAG_ALLOC_CELLPTR(X) X[2]
#define DEFRAG_ALLOC_ARRAY_HEADER_SIZE 3

lbm_value lbm_defrag_mem_create(lbm_uint nbytes) {
  lbm_value res = ENC_SYM_TERROR;
  lbm_uint nwords = bs2ws(nbytes); // multiple of 4.
  if (nwords > 0) {
    res = ENC_SYM_MERROR;
    lbm_uint *data = (lbm_uint*)lbm_malloc(DEFRAG_MEM_HEADER_BYTES + nwords * sizeof(lbm_uint));
    if (data) {
      memset((uint8_t*)data , 0, DEFRAG_MEM_HEADER_BYTES + nwords*sizeof(lbm_uint));
      data[0] = nwords;
      data[1] = 0;      //flags
      lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_DEFRAG_MEM, (lbm_uint)data, ENC_SYM_DEFRAG_MEM_TYPE);
      if (cell == ENC_SYM_MERROR) {
        lbm_free(data);
      } else {
        res = cell;
      }
    }
  }
  return res;
}

static void free_defrag_allocation(lbm_uint *allocation) {
  lbm_uint size = DEFRAG_ALLOC_SIZE(allocation); // array allocation is size in bytes
  // a defrag-mem allocation is always bigger than 0
  lbm_uint nwords = bs2ws(size) +  DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
  lbm_value cell_back_ptr = DEFRAG_ALLOC_CELLPTR(allocation);

  // I have a feeling that it should be impossible for the
  // cell to be recovered if we end up here.
  // if the cell is recovered, then the data should also have been
  // cleared in the defrag_mem.

  cell_back_ptr = lbm_set_ptr_type(cell_back_ptr, LBM_TYPE_CONS);
  bool marked = lbm_cdr(cell_back_ptr) & LBM_GC_MASK;
  lbm_value new_cdr = marked ? (ENC_SYM_NIL | LBM_GC_MARKED) : ENC_SYM_NIL;
  lbm_set_car_and_cdr(cell_back_ptr, ENC_SYM_NIL, new_cdr);
  // possible optimize, if not marked. dont bother setting anything.

  for (lbm_uint i = 0; i < nwords; i ++) {
    allocation[i] = 0;
  }
}

// Called by GC.
// As it is called by GC, gc bits may be set and needs to be
// honored!
void lbm_defrag_mem_destroy(lbm_uint *defrag_mem) {
  lbm_uint nwords = DEFRAG_MEM_SIZE(defrag_mem);
  lbm_uint *defrag_data = DEFRAG_MEM_DATA(defrag_mem);
  for (lbm_uint i = 0; i < nwords;) {
    lbm_uint a = defrag_data[i];
    if (a != 0) {
      lbm_uint *allocation = &defrag_data[i];
      lbm_uint alloc_words =
        DEFRAG_ALLOC_ARRAY_HEADER_SIZE +
        bs2ws(DEFRAG_ALLOC_SIZE(allocation));
      free_defrag_allocation(allocation);
      i += alloc_words;
    }
    else i ++;
  }
  lbm_free(defrag_mem);
}


static void lbm_defrag_mem_defrag(lbm_uint *defrag_mem, lbm_uint bytes) {
  lbm_uint mem_size = ((lbm_uint*)defrag_mem)[0]; // mem size words
  lbm_uint *mem_data = DEFRAG_MEM_DATA(defrag_mem);
  lbm_uint hole_start = 0;

  lbm_uint until_size =  DEFRAG_ALLOC_ARRAY_HEADER_SIZE + bs2ws(bytes); // defrag until hole is this size or complete defrag.

  for (lbm_uint i = 0; i < mem_size; ) {
    // check if there is an allocation here
    if (mem_data[i] != 0) {
      lbm_uint *source = &mem_data[i];
      lbm_uint *target = &mem_data[hole_start];
      lbm_uint alloc_bytes = DEFRAG_ALLOC_SIZE(source);
      lbm_uint alloc_words = bs2ws(alloc_bytes);
      // move allocation into hole
      if (hole_start == i) {
        i += alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
        hole_start = i;
      } else {
        lbm_uint move_dist = i - hole_start;
        if (move_dist >= until_size) break;
        lbm_uint clear_ix = (hole_start + alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE);
        memmove(target, source, (alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE) * sizeof(lbm_uint));
        memset(&mem_data[clear_ix],0, move_dist* sizeof(lbm_uint));
        DEFRAG_ALLOC_DATA(target) = (lbm_uint)&target[DEFRAG_ALLOC_ARRAY_HEADER_SIZE];
        lbm_value cell = DEFRAG_ALLOC_CELLPTR(target);

        lbm_set_car(cell,(lbm_uint)target);
        // move home and i forwards.
        // i can move to the original end of allocation.
        hole_start += alloc_words +  DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
        i += alloc_words +  DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
      }
    } else {
      // no allocation hole remains but i increments.
      i ++;
    }
  }
}

// Allocate an array from the defragable pool
// these arrays must be recognizable by GC so that
// gc can free them by performing a call into the defrag_mem api.
// At the same time they need to be just bytearrays..
// Allocation must always scan from start.
//

#define INIT 0
#define FREE_LEN 1

// An array allocated in defragmem has the following layout inside of the defrag mem
//
// [header (size, data-ptr) cell_back_ptr | data | padding ]

lbm_value lbm_defrag_mem_alloc_internal(lbm_uint *defrag_mem, lbm_uint bytes, lbm_uint type) {

  if (bytes == 0) return ENC_SYM_EERROR;
  lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, type);

  if (cell == ENC_SYM_MERROR) {
    return cell;
  }

  lbm_uint mem_size = DEFRAG_MEM_SIZE(defrag_mem);
  lbm_uint *mem_data = DEFRAG_MEM_DATA(defrag_mem);

  lbm_uint num_words = bs2ws(bytes);
  lbm_uint alloc_words = num_words +  DEFRAG_ALLOC_ARRAY_HEADER_SIZE;

  uint8_t state = INIT;
  lbm_uint free_words = 0;
  lbm_uint free_start = 0;
  bool alloc_found = false;
  lbm_value res = ENC_SYM_MERROR;

  for (lbm_uint i = 0; i < mem_size;) {
    switch(state) {
    case INIT:
      if (mem_data[i] == 0) {
        free_start = i;
        free_words = 1;
        state = FREE_LEN;
        i++;
      } else {
        // jump to next spot
        i += bs2ws(mem_data[i]) + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
      }
      break;
    case FREE_LEN:
      if (mem_data[i] == 0) {
        free_words ++;
        if (free_words >= alloc_words) {
          alloc_found = true;
        } else {
          i ++;
        }
      } else {
        state = INIT;
        i++;
      }
      break;
    }
    if (alloc_found) break;
  }
  if (alloc_found) {
    lbm_uint *allocation = (lbm_uint*)&mem_data[free_start];
    DEFRAG_ALLOC_SIZE(allocation) = bytes;
    DEFRAG_ALLOC_DATA(allocation) = (lbm_uint)&allocation[DEFRAG_ALLOC_ARRAY_HEADER_SIZE]; //data starts after back_ptr
    DEFRAG_ALLOC_CELLPTR(allocation) = cell;
    lbm_set_car(cell, (lbm_uint)allocation);
    res = cell;
  } else {
    DEFRAG_MEM_FLAGS(defrag_mem) = 1;
    lbm_set_car_and_cdr(cell, ENC_SYM_NIL, ENC_SYM_NIL);
  }
  return res;
}

lbm_value lbm_defrag_mem_alloc(lbm_uint *defrag_mem, lbm_uint bytes) {

  lbm_value res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_ARRAY_TYPE); // Try to allocate
  if (lbm_is_symbol_merror(res)) {
    if (DEFRAG_MEM_FLAGS(defrag_mem)) { //if we already performed GC, then also defrag
      lbm_defrag_mem_defrag(defrag_mem, bytes);
      res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_ARRAY_TYPE); // then try again
      DEFRAG_MEM_FLAGS(defrag_mem) = 0;
    }
  }
  if (!lbm_is_symbol_merror(res)) {
    res = lbm_set_ptr_type(res, LBM_TYPE_ARRAY);
  }
  return res;
}

// Allocate a high-level array from DM area
/* lbm_value lbm_defrag_mem_alloc_lisparray(lbm_uint *defrag_mem, lbm_uint elts) { */

/*   size_t bytes = elts * sizeof(lbm_uint); */
/*   lbm_value res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_LISPARRAY_TYPE); // Try to allocate */
/*   if (lbm_is_symbol_merror(res)) { */
/*     if (DEFRAG_MEM_FLAGS(defrag_mem)) { //if we already performed GC, then also defrag */
/*       lbm_defrag_mem_defrag(defrag_mem, bytes); */
/*       res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_LISPARRAY_TYPE); // then try again */
/*       DEFRAG_MEM_FLAGS(defrag_mem) = 0; */
/*     } */
/*   } */
/*   if (!lbm_is_symbol_merror(res)) { */
/*     res = lbm_set_ptr_type(res, LBM_TYPE_LISPARRAY); */
/*   } */
/*   return res; */
/* } */



// IF GC frees a defrag allocation, the cell pointing to it will also be destroyed by GC.

// is it guaranteed there are no copies of a heap-cell representing a defrag allocation.
// Same guarantee must hold for arrays in general or it would not be possible to explicitly free
// any array.

// At the time of free from GC all we have is the pointer.
void lbm_defrag_mem_free(lbm_uint* data) {
  lbm_uint nbytes = data[0];
  lbm_uint words_to_wipe = DEFRAG_ALLOC_ARRAY_HEADER_SIZE + bs2ws(nbytes);
  for (lbm_uint i = 0; i < words_to_wipe; i ++) {
    data[i] = 0;
  }
}



Generated by: GCOVR (Version 4.2)

Line	Branch	Exec	Source
1			/*
2			Copyright 2024, 2025 Joel Svensson svenssonjoel@yahoo.se
3
4			This program is free software: you can redistribute it and/or modify
5			it under the terms of the GNU General Public License as published by
6			the Free Software Foundation, either version 3 of the License, or
7			(at your option) any later version.
8
9			This program is distributed in the hope that it will be useful,
10			but WITHOUT ANY WARRANTY; without even the implied warranty of
11			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12			GNU General Public License for more details.
13
14			You should have received a copy of the GNU General Public License
15			along with this program. If not, see <http://www.gnu.org/licenses/>.
16			*/
17
18			#include <lbm_defrag_mem.h>
19			#include <heap.h>
20			#include <lbm_memory.h>
21
22		339444	static inline lbm_uint bs2ws(lbm_uint bs) {
23	✓✓	339444	return bs % sizeof(lbm_uint) == 0 ? bs / sizeof(lbm_uint) : (bs / sizeof(lbm_uint)) + 1;
24			}
25
26			#define DEFRAG_MEM_HEADER_SIZE 2
27			#define DEFRAG_MEM_HEADER_BYTES (DEFRAG_MEM_HEADER_SIZE*sizeof(lbm_uint))
28			#define DEFRAG_MEM_DATA(X) &(X)[DEFRAG_MEM_HEADER_SIZE];
29			// length and flags.
30			// Currently only one flag that tells if we should do a compaction before allocation.
31			#define DEFRAG_MEM_SIZE(X) X[0]
32			#define DEFRAG_MEM_FLAGS(X) X[1]
33
34			// TODO: We can move the GC index to the end (or elsewhere) of an array to save space in these
35			// headers in the case of ByteArrays.
36			#define DEFRAG_ALLOC_SIZE(X) X[0]
37			#define DEFRAG_ALLOC_DATA(X) X[1]
38			//#define DEFRAG_ALLOC_INDEX(X) X[2] // GC index for traversal of high-level arrays
39			#define DEFRAG_ALLOC_CELLPTR(X) X[2]
40			#define DEFRAG_ALLOC_ARRAY_HEADER_SIZE 3
41
42		168	lbm_value lbm_defrag_mem_create(lbm_uint nbytes) {
43		168	lbm_value res = ENC_SYM_TERROR;
44		168	lbm_uint nwords = bs2ws(nbytes); // multiple of 4.
45	✓✗	168	if (nwords > 0) {
46		168	res = ENC_SYM_MERROR;
47		168	lbm_uint data = (lbm_uint)lbm_malloc(DEFRAG_MEM_HEADER_BYTES + nwords * sizeof(lbm_uint));
48	✓✗	168	if (data) {
49		168	memset((uint8_t)data , 0, DEFRAG_MEM_HEADER_BYTES + nwordssizeof(lbm_uint));
50		168	data[0] = nwords;
51		168	data[1] = 0; //flags
52		168	lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_DEFRAG_MEM, (lbm_uint)data, ENC_SYM_DEFRAG_MEM_TYPE);
53	✗✓	168	if (cell == ENC_SYM_MERROR) {
54			lbm_free(data);
55			} else {
56		168	res = cell;
57			}
58			}
59			}
60		168	return res;
61			}
62
63		84	static void free_defrag_allocation(lbm_uint *allocation) {
64		84	lbm_uint size = DEFRAG_ALLOC_SIZE(allocation); // array allocation is size in bytes
65			// a defrag-mem allocation is always bigger than 0
66		84	lbm_uint nwords = bs2ws(size) + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
67		84	lbm_value cell_back_ptr = DEFRAG_ALLOC_CELLPTR(allocation);
68
69			// I have a feeling that it should be impossible for the
70			// cell to be recovered if we end up here.
71			// if the cell is recovered, then the data should also have been
72			// cleared in the defrag_mem.
73
74		84	cell_back_ptr = lbm_set_ptr_type(cell_back_ptr, LBM_TYPE_CONS);
75		84	bool marked = lbm_cdr(cell_back_ptr) & LBM_GC_MASK;
76	✓✗	84	lbm_value new_cdr = marked ? (ENC_SYM_NIL \| LBM_GC_MARKED) : ENC_SYM_NIL;
77		84	lbm_set_car_and_cdr(cell_back_ptr, ENC_SYM_NIL, new_cdr);
78			// possible optimize, if not marked. dont bother setting anything.
79
80	✓✓	588	for (lbm_uint i = 0; i < nwords; i ++) {
81		504	allocation[i] = 0;
82			}
83		84	}
84
85			// Called by GC.
86			// As it is called by GC, gc bits may be set and needs to be
87			// honored!
88		28	void lbm_defrag_mem_destroy(lbm_uint *defrag_mem) {
89		28	lbm_uint nwords = DEFRAG_MEM_SIZE(defrag_mem);
90		28	lbm_uint *defrag_data = DEFRAG_MEM_DATA(defrag_mem);
91	✓✓	308	for (lbm_uint i = 0; i < nwords;) {
92		280	lbm_uint a = defrag_data[i];
93	✓✓	280	if (a != 0) {
94		84	lbm_uint *allocation = &defrag_data[i];
95		84	lbm_uint alloc_words =
96			DEFRAG_ALLOC_ARRAY_HEADER_SIZE +
97		84	bs2ws(DEFRAG_ALLOC_SIZE(allocation));
98		84	free_defrag_allocation(allocation);
99		84	i += alloc_words;
100			}
101		196	else i ++;
102			}
103		28	lbm_free(defrag_mem);
104		28	}
105
106
107		28588	static void lbm_defrag_mem_defrag(lbm_uint *defrag_mem, lbm_uint bytes) {
108		28588	lbm_uint mem_size = ((lbm_uint*)defrag_mem)[0]; // mem size words
109		28588	lbm_uint *mem_data = DEFRAG_MEM_DATA(defrag_mem);
110		28588	lbm_uint hole_start = 0;
111
112		28588	lbm_uint until_size = DEFRAG_ALLOC_ARRAY_HEADER_SIZE + bs2ws(bytes); // defrag until hole is this size or complete defrag.
113
114	✓✓	259252	for (lbm_uint i = 0; i < mem_size; ) {
115			// check if there is an allocation here
116	✓✓	230692	if (mem_data[i] != 0) {
117		58772	lbm_uint *source = &mem_data[i];
118		58772	lbm_uint *target = &mem_data[hole_start];
119		58772	lbm_uint alloc_bytes = DEFRAG_ALLOC_SIZE(source);
120		58772	lbm_uint alloc_words = bs2ws(alloc_bytes);
121			// move allocation into hole
122	✓✓	58772	if (hole_start == i) {
123		58548	i += alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
124		58548	hole_start = i;
125			} else {
126		224	lbm_uint move_dist = i - hole_start;
127	✓✓	224	if (move_dist >= until_size) break;
128		196	lbm_uint clear_ix = (hole_start + alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE);
129		196	memmove(target, source, (alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE) * sizeof(lbm_uint));
130		196	memset(&mem_data[clear_ix],0, move_dist* sizeof(lbm_uint));
131		196	DEFRAG_ALLOC_DATA(target) = (lbm_uint)&target[DEFRAG_ALLOC_ARRAY_HEADER_SIZE];
132		196	lbm_value cell = DEFRAG_ALLOC_CELLPTR(target);
133
134		196	lbm_set_car(cell,(lbm_uint)target);
135			// move home and i forwards.
136			// i can move to the original end of allocation.
137		196	hole_start += alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
138		196	i += alloc_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
139			}
140			} else {
141			// no allocation hole remains but i increments.
142		171920	i ++;
143			}
144			}
145		28588	}
146
147			// Allocate an array from the defragable pool
148			// these arrays must be recognizable by GC so that
149			// gc can free them by performing a call into the defrag_mem api.
150			// At the same time they need to be just bytearrays..
151			// Allocation must always scan from start.
152			//
153
154			#define INIT 0
155			#define FREE_LEN 1
156
157			// An array allocated in defragmem has the following layout inside of the defrag mem
158			//
159			// [header (size, data-ptr) cell_back_ptr \| data \| padding ]
160
161		86772	lbm_value lbm_defrag_mem_alloc_internal(lbm_uint *defrag_mem, lbm_uint bytes, lbm_uint type) {
162
163	✗✓	86772	if (bytes == 0) return ENC_SYM_EERROR;
164		86772	lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, type);
165
166	✗✓	86772	if (cell == ENC_SYM_MERROR) {
167			return cell;
168			}
169
170		86772	lbm_uint mem_size = DEFRAG_MEM_SIZE(defrag_mem);
171		86772	lbm_uint *mem_data = DEFRAG_MEM_DATA(defrag_mem);
172
173		86772	lbm_uint num_words = bs2ws(bytes);
174		86772	lbm_uint alloc_words = num_words + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
175
176		86772	uint8_t state = INIT;
177		86772	lbm_uint free_words = 0;
178		86772	lbm_uint free_start = 0;
179		86772	bool alloc_found = false;
180		86772	lbm_value res = ENC_SYM_MERROR;
181
182	✓✓	913528	for (lbm_uint i = 0; i < mem_size;) {
183	✓✓✗	856408	switch(state) {
184		222740	case INIT:
185	✓✓	222740	if (mem_data[i] == 0) {
186		86772	free_start = i;
187		86772	free_words = 1;
188		86772	state = FREE_LEN;
189		86772	i++;
190			} else {
191			// jump to next spot
192		135968	i += bs2ws(mem_data[i]) + DEFRAG_ALLOC_ARRAY_HEADER_SIZE;
193			}
194		222740	break;
195		633668	case FREE_LEN:
196	✓✓	633668	if (mem_data[i] == 0) {
197		633584	free_words ++;
198	✓✓	633584	if (free_words >= alloc_words) {
199		29652	alloc_found = true;
200			} else {
201		603932	i ++;
202			}
203			} else {
204		84	state = INIT;
205		84	i++;
206			}
207		633668	break;
208			}
209	✓✓	856408	if (alloc_found) break;
210			}
211	✓✓	86772	if (alloc_found) {
212		29652	lbm_uint allocation = (lbm_uint)&mem_data[free_start];
213		29652	DEFRAG_ALLOC_SIZE(allocation) = bytes;
214		29652	DEFRAG_ALLOC_DATA(allocation) = (lbm_uint)&allocation[DEFRAG_ALLOC_ARRAY_HEADER_SIZE]; //data starts after back_ptr
215		29652	DEFRAG_ALLOC_CELLPTR(allocation) = cell;
216		29652	lbm_set_car(cell, (lbm_uint)allocation);
217		29652	res = cell;
218			} else {
219		57120	DEFRAG_MEM_FLAGS(defrag_mem) = 1;
220		57120	lbm_set_car_and_cdr(cell, ENC_SYM_NIL, ENC_SYM_NIL);
221			}
222		86772	return res;
223			}
224
225		58184	lbm_value lbm_defrag_mem_alloc(lbm_uint *defrag_mem, lbm_uint bytes) {
226
227		58184	lbm_value res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_ARRAY_TYPE); // Try to allocate
228	✓✓	58184	if (lbm_is_symbol_merror(res)) {
229	✓✗	28588	if (DEFRAG_MEM_FLAGS(defrag_mem)) { //if we already performed GC, then also defrag
230		28588	lbm_defrag_mem_defrag(defrag_mem, bytes);
231		28588	res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_ARRAY_TYPE); // then try again
232		28588	DEFRAG_MEM_FLAGS(defrag_mem) = 0;
233			}
234			}
235	✓✓	58184	if (!lbm_is_symbol_merror(res)) {
236		29652	res = lbm_set_ptr_type(res, LBM_TYPE_ARRAY);
237			}
238		58184	return res;
239			}
240
241			// Allocate a high-level array from DM area
242			/* lbm_value lbm_defrag_mem_alloc_lisparray(lbm_uint defrag_mem, lbm_uint elts) { /
243
244			/* size_t bytes = elts * sizeof(lbm_uint); */
245			/* lbm_value res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_LISPARRAY_TYPE); // Try to allocate */
246			/* if (lbm_is_symbol_merror(res)) { */
247			/* if (DEFRAG_MEM_FLAGS(defrag_mem)) { //if we already performed GC, then also defrag */
248			/* lbm_defrag_mem_defrag(defrag_mem, bytes); */
249			/* res = lbm_defrag_mem_alloc_internal(defrag_mem, bytes, ENC_SYM_DEFRAG_LISPARRAY_TYPE); // then try again */
250			/* DEFRAG_MEM_FLAGS(defrag_mem) = 0; */
251			/* } */
252			/* } */
253			/* if (!lbm_is_symbol_merror(res)) { */
254			/* res = lbm_set_ptr_type(res, LBM_TYPE_LISPARRAY); */
255			/* } */
256			/* return res; */
257			/* } */
258
259
260
261			// IF GC frees a defrag allocation, the cell pointing to it will also be destroyed by GC.
262
263			// is it guaranteed there are no copies of a heap-cell representing a defrag allocation.
264			// Same guarantee must hold for arrays in general or it would not be possible to explicitly free
265			// any array.
266
267			// At the time of free from GC all we have is the pointer.
268		29008	void lbm_defrag_mem_free(lbm_uint* data) {
269		29008	lbm_uint nbytes = data[0];
270		29008	lbm_uint words_to_wipe = DEFRAG_ALLOC_ARRAY_HEADER_SIZE + bs2ws(nbytes);
271	✓✓	399084	for (lbm_uint i = 0; i < words_to_wipe; i ++) {
272		370076	data[i] = 0;
273			}
274		29008	}
275