| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | /* | ||
| 2 | Copyright 2018, 2020, 2022 - 2025 Joel Svensson svenssonjoel@yahoo.se | ||
| 3 | 2022 Benjamin Vedder | ||
| 4 | |||
| 5 | This program is free software: you can redistribute it and/or modify | ||
| 6 | it under the terms of the GNU General Public License as published by | ||
| 7 | the Free Software Foundation, either version 3 of the License, or | ||
| 8 | (at your option) any later version. | ||
| 9 | |||
| 10 | This program is distributed in the hope that it will be useful, | ||
| 11 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 12 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 13 | GNU General Public License for more details. | ||
| 14 | |||
| 15 | You should have received a copy of the GNU General Public License | ||
| 16 | along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 17 | */ | ||
| 18 | |||
| 19 | #include <stdio.h> | ||
| 20 | #include <stdlib.h> | ||
| 21 | #include <stdint.h> | ||
| 22 | #include <stdarg.h> | ||
| 23 | #include <inttypes.h> | ||
| 24 | #include <lbm_memory.h> | ||
| 25 | #include <lbm_custom_type.h> | ||
| 26 | #include <lbm_defrag_mem.h> | ||
| 27 | #include <lbm_image.h> | ||
| 28 | |||
| 29 | #include "heap.h" | ||
| 30 | #include "symrepr.h" | ||
| 31 | #include "stack.h" | ||
| 32 | #include "lbm_channel.h" | ||
| 33 | #include "platform_mutex.h" | ||
| 34 | #include "eval_cps.h" | ||
| 35 | #ifdef VISUALIZE_HEAP | ||
| 36 | #include "heap_vis.h" | ||
| 37 | #endif | ||
| 38 | |||
| 39 | 67805637 | static inline lbm_value lbm_set_gc_mark(lbm_value x) { | |
| 40 | 67805637 | return x | LBM_GC_MARKED; | |
| 41 | } | ||
| 42 | 67604831 | static inline lbm_value lbm_clr_gc_mark(lbm_value x) { | |
| 43 | 67604831 | return x & ~LBM_GC_MASK; | |
| 44 | } | ||
| 45 | |||
| 46 | 1453912589 | static inline bool lbm_get_gc_mark(lbm_value x) { | |
| 47 | 1453912589 | return x & LBM_GC_MASK; | |
| 48 | } | ||
| 49 | |||
| 50 | 24081 | static inline void gc_mark(lbm_value c) { | |
| 51 | //c must be a cons cell. | ||
| 52 | 24081 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 53 | 24081 | cell->cdr = lbm_set_gc_mark(cell->cdr); | |
| 54 | 24081 | } | |
| 55 | |||
| 56 | 24422 | static inline bool gc_marked(lbm_value c) { | |
| 57 | 24422 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 58 | 24422 | return lbm_get_gc_mark(cell->cdr); | |
| 59 | } | ||
| 60 | |||
| 61 | static inline void gc_clear_mark(lbm_value c) { | ||
| 62 | //c must be a cons cell. | ||
| 63 | lbm_cons_t *cell = lbm_ref_cell(c); | ||
| 64 | cell->cdr = lbm_clr_gc_mark(cell->cdr); | ||
| 65 | } | ||
| 66 | |||
| 67 | // flag is the same bit as mark, but in car | ||
| 68 | 46584 | static inline bool lbm_get_gc_flag(lbm_value x) { | |
| 69 | 46584 | return x & LBM_GC_MARKED; | |
| 70 | } | ||
| 71 | |||
| 72 | 23292 | static inline lbm_value lbm_set_gc_flag(lbm_value x) { | |
| 73 | 23292 | return x | LBM_GC_MARKED; | |
| 74 | } | ||
| 75 | |||
| 76 | 23292 | static inline lbm_value lbm_clr_gc_flag(lbm_value x) { | |
| 77 | 23292 | return x & ~LBM_GC_MASK; | |
| 78 | } | ||
| 79 | |||
| 80 | |||
| 81 | lbm_heap_state_t lbm_heap_state; | ||
| 82 | |||
| 83 | lbm_const_heap_t *lbm_const_heap_state; | ||
| 84 | |||
| 85 | lbm_cons_t *lbm_heaps[2] = {NULL, NULL}; | ||
| 86 | |||
| 87 | static lbm_mutex_t lbm_const_heap_mutex; | ||
| 88 | static bool lbm_const_heap_mutex_initialized = false; | ||
| 89 | |||
| 90 | static lbm_mutex_t lbm_mark_mutex; | ||
| 91 | static bool lbm_mark_mutex_initialized = false; | ||
| 92 | |||
| 93 | #ifdef USE_GC_PTR_REV | ||
| 94 | void lbm_gc_lock(void) { | ||
| 95 | lbm_mutex_lock(&lbm_mark_mutex); | ||
| 96 | } | ||
| 97 | void lbm_gc_unlock(void) { | ||
| 98 | lbm_mutex_unlock(&lbm_mark_mutex); | ||
| 99 | } | ||
| 100 | #else | ||
| 101 | ✗ | void lbm_gc_lock(void) { | |
| 102 | ✗ | } | |
| 103 | ✗ | void lbm_gc_unlock(void) { | |
| 104 | ✗ | } | |
| 105 | #endif | ||
| 106 | |||
| 107 | /****************************************************/ | ||
| 108 | /* ENCODERS DECODERS */ | ||
| 109 | |||
| 110 | 2837949 | lbm_value lbm_enc_i32(int32_t x) { | |
| 111 | #ifndef LBM64 | ||
| 112 | 2837949 | lbm_value i = lbm_cons((lbm_uint)x, ENC_SYM_RAW_I_TYPE); | |
| 113 |
2/2✓ Branch 0 taken 618 times.
✓ Branch 1 taken 2837331 times.
|
2837949 | if (lbm_type_of(i) == LBM_TYPE_SYMBOL) return i; |
| 114 | 2837331 | return lbm_set_ptr_type(i, LBM_TYPE_I32); | |
| 115 | #else | ||
| 116 | return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_I32; | ||
| 117 | #endif | ||
| 118 | } | ||
| 119 | |||
| 120 | 3684951 | lbm_value lbm_enc_u32(uint32_t x) { | |
| 121 | #ifndef LBM64 | ||
| 122 | 3684951 | lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE); | |
| 123 |
2/2✓ Branch 0 taken 1088 times.
✓ Branch 1 taken 3683863 times.
|
3684951 | if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u; |
| 124 | 3683863 | return lbm_set_ptr_type(u, LBM_TYPE_U32); | |
| 125 | #else | ||
| 126 | return (((lbm_uint)x) << LBM_VAL_SHIFT) | LBM_TYPE_U32; | ||
| 127 | #endif | ||
| 128 | } | ||
| 129 | |||
| 130 | 229894192 | lbm_value lbm_enc_float(float x) { | |
| 131 | #ifndef LBM64 | ||
| 132 | lbm_uint t; | ||
| 133 | 229894192 | memcpy(&t, &x, sizeof(lbm_float)); | |
| 134 | 229894192 | lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE); | |
| 135 |
2/2✓ Branch 0 taken 147244 times.
✓ Branch 1 taken 229746948 times.
|
229894192 | if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f; |
| 136 | 229746948 | return lbm_set_ptr_type(f, LBM_TYPE_FLOAT); | |
| 137 | #else | ||
| 138 | lbm_uint t = 0; | ||
| 139 | memcpy(&t, &x, sizeof(float)); | ||
| 140 | return (((lbm_uint)t) << LBM_VAL_SHIFT) | LBM_TYPE_FLOAT; | ||
| 141 | #endif | ||
| 142 | } | ||
| 143 | |||
| 144 | #ifndef LBM64 | ||
| 145 | 8429219 | static lbm_value enc_64_on_32(uint8_t *source, lbm_uint type_qual, lbm_uint type) { | |
| 146 | 8429219 | lbm_value res = lbm_cons(ENC_SYM_NIL,ENC_SYM_NIL); | |
| 147 |
2/2✓ Branch 0 taken 8427033 times.
✓ Branch 1 taken 2186 times.
|
8429219 | if (lbm_type_of(res) != LBM_TYPE_SYMBOL) { |
| 148 | 8427033 | uint8_t* storage = lbm_malloc(sizeof(uint64_t)); | |
| 149 |
2/2✓ Branch 0 taken 8424405 times.
✓ Branch 1 taken 2628 times.
|
8427033 | if (storage) { |
| 150 | 8424405 | memcpy(storage,source, sizeof(uint64_t)); | |
| 151 | 8424405 | lbm_set_car_and_cdr(res, (lbm_uint)storage, type_qual); | |
| 152 | 8424405 | res = lbm_set_ptr_type(res, type); | |
| 153 | } else { | ||
| 154 | 2628 | res = ENC_SYM_MERROR; | |
| 155 | } | ||
| 156 | } | ||
| 157 | 8429219 | return res; | |
| 158 | } | ||
| 159 | #endif | ||
| 160 | |||
| 161 | 4492273 | lbm_value lbm_enc_i64(int64_t x) { | |
| 162 | #ifndef LBM64 | ||
| 163 | 4492273 | return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_I_TYPE, LBM_TYPE_I64); | |
| 164 | #else | ||
| 165 | lbm_value u = lbm_cons((uint64_t)x, ENC_SYM_RAW_I_TYPE); | ||
| 166 | if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u; | ||
| 167 | return lbm_set_ptr_type(u, LBM_TYPE_I64); | ||
| 168 | #endif | ||
| 169 | } | ||
| 170 | |||
| 171 | 3371200 | lbm_value lbm_enc_u64(uint64_t x) { | |
| 172 | #ifndef LBM64 | ||
| 173 | 3371200 | return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_U_TYPE, LBM_TYPE_U64); | |
| 174 | #else | ||
| 175 | lbm_value u = lbm_cons(x, ENC_SYM_RAW_U_TYPE); | ||
| 176 | if (lbm_type_of(u) == LBM_TYPE_SYMBOL) return u; | ||
| 177 | return lbm_set_ptr_type(u, LBM_TYPE_U64); | ||
| 178 | #endif | ||
| 179 | } | ||
| 180 | |||
| 181 | 565746 | lbm_value lbm_enc_double(double x) { | |
| 182 | #ifndef LBM64 | ||
| 183 | 565746 | return enc_64_on_32((uint8_t *)&x, ENC_SYM_IND_F_TYPE, LBM_TYPE_DOUBLE); | |
| 184 | #else | ||
| 185 | lbm_uint t; | ||
| 186 | memcpy(&t, &x, sizeof(double)); | ||
| 187 | lbm_value f = lbm_cons(t, ENC_SYM_RAW_F_TYPE); | ||
| 188 | if (lbm_type_of(f) == LBM_TYPE_SYMBOL) return f; | ||
| 189 | return lbm_set_ptr_type(f, LBM_TYPE_DOUBLE); | ||
| 190 | #endif | ||
| 191 | } | ||
| 192 | |||
| 193 | // Type specific (as opposed to the dec_as_X) functions | ||
| 194 | // should only be run on values KNOWN to represent a value of the type | ||
| 195 | // that the decoder decodes. | ||
| 196 | |||
| 197 | 333562716 | float lbm_dec_float(lbm_value x) { | |
| 198 | #ifndef LBM64 | ||
| 199 | float f_tmp; | ||
| 200 | 333562716 | lbm_uint tmp = lbm_car(x); | |
| 201 | 333562716 | memcpy(&f_tmp, &tmp, sizeof(float)); | |
| 202 | 333562716 | return f_tmp; | |
| 203 | #else | ||
| 204 | uint32_t tmp = (uint32_t)(x >> LBM_VAL_SHIFT); | ||
| 205 | float f_tmp; | ||
| 206 | memcpy(&f_tmp, &tmp, sizeof(float)); | ||
| 207 | return f_tmp; | ||
| 208 | #endif | ||
| 209 | } | ||
| 210 | |||
| 211 | 564847 | double lbm_dec_double(lbm_value x) { | |
| 212 | #ifndef LBM64 | ||
| 213 | 564847 | double d = 0.0; | |
| 214 |
1/2✓ Branch 0 taken 564847 times.
✗ Branch 1 not taken.
|
564847 | if (lbm_is_ptr(x)) { |
| 215 | 564847 | uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car; | |
| 216 | 564847 | memcpy(&d, data, sizeof(double)); | |
| 217 | } | ||
| 218 | 564847 | return d; | |
| 219 | #else | ||
| 220 | double f_tmp; | ||
| 221 | lbm_uint tmp = lbm_car(x); | ||
| 222 | memcpy(&f_tmp, &tmp, sizeof(double)); | ||
| 223 | return f_tmp; | ||
| 224 | #endif | ||
| 225 | } | ||
| 226 | |||
| 227 | 7013756 | uint64_t lbm_dec_u64(lbm_value x) { | |
| 228 | #ifndef LBM64 | ||
| 229 | 7013756 | uint64_t u = 0; | |
| 230 |
1/2✓ Branch 0 taken 7013756 times.
✗ Branch 1 not taken.
|
7013756 | if (lbm_is_ptr(x)) { |
| 231 | 7013756 | uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car; | |
| 232 | 7013756 | memcpy(&u, data, 8); | |
| 233 | } | ||
| 234 | 7013756 | return u; | |
| 235 | #else | ||
| 236 | return (uint64_t)lbm_car(x); | ||
| 237 | #endif | ||
| 238 | } | ||
| 239 | |||
| 240 | 9254413 | int64_t lbm_dec_i64(lbm_value x) { | |
| 241 | #ifndef LBM64 | ||
| 242 | 9254413 | int64_t i = 0; | |
| 243 |
1/2✓ Branch 0 taken 9254413 times.
✗ Branch 1 not taken.
|
9254413 | if (lbm_is_ptr(x)) { |
| 244 | 9254413 | uint32_t *data = (uint32_t*)lbm_ref_cell(x)->car; | |
| 245 | 9254413 | memcpy(&i, data, 8); | |
| 246 | } | ||
| 247 | 9254413 | return i; | |
| 248 | #else | ||
| 249 | return (int64_t)lbm_car(x); | ||
| 250 | #endif | ||
| 251 | } | ||
| 252 | |||
| 253 | 797441 | char *lbm_dec_str(lbm_value val) { | |
| 254 | 797441 | char *res = 0; | |
| 255 |
2/2✓ Branch 0 taken 797293 times.
✓ Branch 1 taken 148 times.
|
797441 | if (lbm_is_array_r(val)) { |
| 256 | 797293 | lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(val); | |
| 257 |
1/2✓ Branch 0 taken 797293 times.
✗ Branch 1 not taken.
|
797293 | if (array) { |
| 258 | 797293 | res = (char *)array->data; | |
| 259 | } | ||
| 260 | } | ||
| 261 | 797441 | return res; | |
| 262 | } | ||
| 263 | |||
| 264 | 603498 | lbm_array_header_t *lbm_dec_array_r(lbm_value val) { | |
| 265 | 603498 | lbm_array_header_t *array = NULL; | |
| 266 |
2/2✓ Branch 0 taken 602111 times.
✓ Branch 1 taken 1387 times.
|
603498 | if (lbm_is_array_r(val)) { |
| 267 | 602111 | array = (lbm_array_header_t *)lbm_car(val); | |
| 268 | } | ||
| 269 | 603498 | return array; | |
| 270 | } | ||
| 271 | |||
| 272 | 59591 | lbm_array_header_t *lbm_dec_array_rw(lbm_value val) { | |
| 273 | 59591 | lbm_array_header_t *array = NULL; | |
| 274 |
2/2✓ Branch 0 taken 59505 times.
✓ Branch 1 taken 86 times.
|
59591 | if (lbm_is_array_rw(val)) { |
| 275 | 59505 | array = (lbm_array_header_t *)lbm_car(val); | |
| 276 | } | ||
| 277 | 59591 | return array; | |
| 278 | } | ||
| 279 | |||
| 280 | 12736034 | lbm_char_channel_t *lbm_dec_channel(lbm_value val) { | |
| 281 | 12736034 | lbm_char_channel_t *res = NULL; | |
| 282 | |||
| 283 |
1/2✓ Branch 0 taken 12736034 times.
✗ Branch 1 not taken.
|
12736034 | if (lbm_type_of(val) == LBM_TYPE_CHANNEL) { |
| 284 | 12736034 | res = (lbm_char_channel_t *)lbm_car(val); | |
| 285 | } | ||
| 286 | 12736034 | return res; | |
| 287 | } | ||
| 288 | |||
| 289 | 3374 | lbm_uint lbm_dec_custom(lbm_value val) { | |
| 290 | 3374 | lbm_uint res = 0; | |
| 291 |
1/2✓ Branch 0 taken 3374 times.
✗ Branch 1 not taken.
|
3374 | if (lbm_type_of(val) == LBM_TYPE_CUSTOM) { |
| 292 | 3374 | res = (lbm_uint)lbm_car(val); | |
| 293 | } | ||
| 294 | 3374 | return res; | |
| 295 | } | ||
| 296 | |||
| 297 | 60948 | uint8_t lbm_dec_as_char(lbm_value a) { | |
| 298 | 60948 | uint8_t r = 0; | |
| 299 |
9/10✓ Branch 0 taken 60701 times.
✓ Branch 1 taken 51 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 28 times.
✓ Branch 4 taken 28 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 28 times.
✓ Branch 7 taken 28 times.
✓ Branch 8 taken 28 times.
✗ Branch 9 not taken.
|
60948 | switch (lbm_type_of_functional(a)) { |
| 300 | 60701 | case LBM_TYPE_CHAR: | |
| 301 | 60701 | r = (uint8_t)lbm_dec_char(a); break; | |
| 302 | 51 | case LBM_TYPE_I: | |
| 303 | 51 | r = (uint8_t)lbm_dec_i(a); break; | |
| 304 | 28 | case LBM_TYPE_U: | |
| 305 | 28 | r = (uint8_t)lbm_dec_u(a); break; | |
| 306 | 28 | case LBM_TYPE_I32: | |
| 307 | 28 | r = (uint8_t)lbm_dec_i32(a); break; | |
| 308 | 28 | case LBM_TYPE_U32: | |
| 309 | 28 | r = (uint8_t)lbm_dec_u32(a); break; | |
| 310 | 28 | case LBM_TYPE_FLOAT: | |
| 311 | 28 | r = (uint8_t)lbm_dec_float(a); break; | |
| 312 | 28 | case LBM_TYPE_I64: | |
| 313 | 28 | r = (uint8_t)lbm_dec_i64(a); break; | |
| 314 | 28 | case LBM_TYPE_U64: | |
| 315 | 28 | r = (uint8_t)lbm_dec_u64(a); break; | |
| 316 | 28 | case LBM_TYPE_DOUBLE: | |
| 317 | 28 | r = (uint8_t) lbm_dec_double(a); break; | |
| 318 | } | ||
| 319 | 60948 | return r; | |
| 320 | } | ||
| 321 | |||
| 322 | 8915159 | uint32_t lbm_dec_as_u32(lbm_value a) { | |
| 323 | 8915159 | uint32_t r = 0; | |
| 324 |
8/9✓ Branch 0 taken 562265 times.
✓ Branch 1 taken 1701536 times.
✓ Branch 2 taken 1852501 times.
✓ Branch 3 taken 4798686 times.
✓ Branch 4 taken 31 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 84 times.
✓ Branch 7 taken 28 times.
✗ Branch 8 not taken.
|
8915159 | switch (lbm_type_of_functional(a)) { |
| 325 | 562265 | case LBM_TYPE_CHAR: | |
| 326 | 562265 | r = (uint32_t)lbm_dec_char(a); break; | |
| 327 | 1701536 | case LBM_TYPE_I: | |
| 328 | 1701536 | r = (uint32_t)lbm_dec_i(a); break; | |
| 329 | 1852501 | case LBM_TYPE_U: | |
| 330 | 1852501 | r = (uint32_t)lbm_dec_u(a); break; | |
| 331 | 4798686 | case LBM_TYPE_I32: /* fall through */ | |
| 332 | case LBM_TYPE_U32: | ||
| 333 | 4798686 | r = (uint32_t)lbm_dec_u32(a); break; | |
| 334 | 31 | case LBM_TYPE_FLOAT: | |
| 335 | 31 | r = (uint32_t)lbm_dec_float(a); break; | |
| 336 | 28 | case LBM_TYPE_I64: | |
| 337 | 28 | r = (uint32_t)lbm_dec_i64(a); break; | |
| 338 | 84 | case LBM_TYPE_U64: | |
| 339 | 84 | r = (uint32_t)lbm_dec_u64(a); break; | |
| 340 | 28 | case LBM_TYPE_DOUBLE: | |
| 341 | 28 | r = (uint32_t)lbm_dec_double(a); break; | |
| 342 | } | ||
| 343 | 8915159 | return r; | |
| 344 | } | ||
| 345 | |||
| 346 | 246233988 | int32_t lbm_dec_as_i32(lbm_value a) { | |
| 347 | 246233988 | int32_t r = 0; | |
| 348 |
10/10✓ Branch 0 taken 6276905 times.
✓ Branch 1 taken 236274328 times.
✓ Branch 2 taken 8196 times.
✓ Branch 3 taken 3672189 times.
✓ Branch 4 taken 30 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 56 times.
✓ Branch 7 taken 56 times.
✓ Branch 8 taken 28 times.
✓ Branch 9 taken 2172 times.
|
246233988 | switch (lbm_type_of_functional(a)) { |
| 349 | 6276905 | case LBM_TYPE_CHAR: | |
| 350 | 6276905 | r = (int32_t)lbm_dec_char(a); break; | |
| 351 | 236274328 | case LBM_TYPE_I: | |
| 352 | 236274328 | r = (int32_t)lbm_dec_i(a); break; | |
| 353 | 8196 | case LBM_TYPE_U: | |
| 354 | 8196 | r = (int32_t)lbm_dec_u(a); break; | |
| 355 | 3672189 | case LBM_TYPE_I32: | |
| 356 | 3672189 | r = (int32_t)lbm_dec_i32(a); break; | |
| 357 | 30 | case LBM_TYPE_U32: | |
| 358 | 30 | r = (int32_t)lbm_dec_u32(a); break; | |
| 359 | 28 | case LBM_TYPE_FLOAT: | |
| 360 | 28 | r = (int32_t)lbm_dec_float(a); break; | |
| 361 | 56 | case LBM_TYPE_I64: | |
| 362 | 56 | r = (int32_t)lbm_dec_i64(a); break; | |
| 363 | 56 | case LBM_TYPE_U64: | |
| 364 | 56 | r = (int32_t)lbm_dec_u64(a); break; | |
| 365 | 28 | case LBM_TYPE_DOUBLE: | |
| 366 | 28 | r = (int32_t) lbm_dec_double(a); break; | |
| 367 | } | ||
| 368 | 246233988 | return r; | |
| 369 | } | ||
| 370 | |||
| 371 | 6729254 | int64_t lbm_dec_as_i64(lbm_value a) { | |
| 372 | 6729254 | int64_t r = 0; | |
| 373 |
10/10✓ Branch 0 taken 562560 times.
✓ Branch 1 taken 1401389 times.
✓ Branch 2 taken 168 times.
✓ Branch 3 taken 168 times.
✓ Branch 4 taken 168 times.
✓ Branch 5 taken 68 times.
✓ Branch 6 taken 4764557 times.
✓ Branch 7 taken 112 times.
✓ Branch 8 taken 56 times.
✓ Branch 9 taken 8 times.
|
6729254 | switch (lbm_type_of_functional(a)) { |
| 374 | 562560 | case LBM_TYPE_CHAR: | |
| 375 | 562560 | r = (int64_t)lbm_dec_char(a); break; | |
| 376 | 1401389 | case LBM_TYPE_I: | |
| 377 | 1401389 | r = (int64_t)lbm_dec_i(a); break; | |
| 378 | 168 | case LBM_TYPE_U: | |
| 379 | 168 | r = (int64_t)lbm_dec_u(a); break; | |
| 380 | 168 | case LBM_TYPE_I32: | |
| 381 | 168 | r = (int64_t)lbm_dec_i32(a); break; | |
| 382 | 168 | case LBM_TYPE_U32: | |
| 383 | 168 | r = (int64_t)lbm_dec_u32(a); break; | |
| 384 | 68 | case LBM_TYPE_FLOAT: | |
| 385 | 68 | r = (int64_t)lbm_dec_float(a); break; | |
| 386 | 4764557 | case LBM_TYPE_I64: | |
| 387 | 4764557 | r = (int64_t)lbm_dec_i64(a); break; | |
| 388 | 112 | case LBM_TYPE_U64: | |
| 389 | 112 | r = (int64_t)lbm_dec_u64(a); break; | |
| 390 | 56 | case LBM_TYPE_DOUBLE: | |
| 391 | 56 | r = (int64_t) lbm_dec_double(a); break; | |
| 392 | } | ||
| 393 | 6729254 | return r; | |
| 394 | } | ||
| 395 | |||
| 396 | 4488482 | uint64_t lbm_dec_as_u64(lbm_value a) { | |
| 397 | 4488482 | uint64_t r = 0; | |
| 398 |
9/10✓ Branch 0 taken 562532 times.
✓ Branch 1 taken 280592 times.
✓ Branch 2 taken 168 times.
✓ Branch 3 taken 168 times.
✓ Branch 4 taken 168 times.
✓ Branch 5 taken 56 times.
✓ Branch 6 taken 168 times.
✓ Branch 7 taken 3644574 times.
✓ Branch 8 taken 56 times.
✗ Branch 9 not taken.
|
4488482 | switch (lbm_type_of_functional(a)) { |
| 399 | 562532 | case LBM_TYPE_CHAR: | |
| 400 | 562532 | r = (uint64_t)lbm_dec_char(a); break; | |
| 401 | 280592 | case LBM_TYPE_I: | |
| 402 | 280592 | r = (uint64_t)lbm_dec_i(a); break; | |
| 403 | 168 | case LBM_TYPE_U: | |
| 404 | 168 | r = (uint64_t)lbm_dec_u(a); break; | |
| 405 | 168 | case LBM_TYPE_I32: | |
| 406 | 168 | r = (uint64_t)lbm_dec_i32(a); break; | |
| 407 | 168 | case LBM_TYPE_U32: | |
| 408 | 168 | r = (uint64_t)lbm_dec_u32(a); break; | |
| 409 | 56 | case LBM_TYPE_FLOAT: | |
| 410 | 56 | r = (uint64_t)lbm_dec_float(a); break; | |
| 411 | 168 | case LBM_TYPE_I64: | |
| 412 | 168 | r = (uint64_t)lbm_dec_i64(a); break; | |
| 413 | 3644574 | case LBM_TYPE_U64: | |
| 414 | 3644574 | r = (uint64_t)lbm_dec_u64(a); break; | |
| 415 | 56 | case LBM_TYPE_DOUBLE: | |
| 416 | 56 | r = (uint64_t)lbm_dec_double(a); break; | |
| 417 | } | ||
| 418 | 4488482 | return r; | |
| 419 | } | ||
| 420 | |||
| 421 | /* lbm_uint lbm_dec_as_uint(lbm_value a) { */ | ||
| 422 | /* lbm_uint r = 0; */ | ||
| 423 | /* switch (lbm_type_of_functional(a)) { */ | ||
| 424 | /* case LBM_TYPE_CHAR: */ | ||
| 425 | /* r = (lbm_uint)lbm_dec_char(a); break; */ | ||
| 426 | /* case LBM_TYPE_I: */ | ||
| 427 | /* r = (lbm_uint)lbm_dec_i(a); break; */ | ||
| 428 | /* case LBM_TYPE_U: */ | ||
| 429 | /* r = (lbm_uint)lbm_dec_u(a); break; */ | ||
| 430 | /* case LBM_TYPE_I32: */ | ||
| 431 | /* r = (lbm_uint)lbm_dec_i32(a); break; */ | ||
| 432 | /* case LBM_TYPE_U32: */ | ||
| 433 | /* r = (lbm_uint)lbm_dec_u32(a); break; */ | ||
| 434 | /* case LBM_TYPE_FLOAT: */ | ||
| 435 | /* r = (lbm_uint)lbm_dec_float(a); break; */ | ||
| 436 | /* case LBM_TYPE_I64: */ | ||
| 437 | /* r = (lbm_uint)lbm_dec_i64(a); break; */ | ||
| 438 | /* case LBM_TYPE_U64: */ | ||
| 439 | /* r = (lbm_uint) lbm_dec_u64(a); break; */ | ||
| 440 | /* case LBM_TYPE_DOUBLE: */ | ||
| 441 | /* r = (lbm_uint)lbm_dec_double(a); break; */ | ||
| 442 | /* } */ | ||
| 443 | /* return r; */ | ||
| 444 | /* } */ | ||
| 445 | |||
| 446 | /* lbm_int lbm_dec_as_int(lbm_value a) { */ | ||
| 447 | /* lbm_int r = 0; */ | ||
| 448 | /* switch (lbm_type_of_functional(a)) { */ | ||
| 449 | /* case LBM_TYPE_CHAR: */ | ||
| 450 | /* r = (lbm_int)lbm_dec_char(a); break; */ | ||
| 451 | /* case LBM_TYPE_I: */ | ||
| 452 | /* r = (lbm_int)lbm_dec_i(a); break; */ | ||
| 453 | /* case LBM_TYPE_U: */ | ||
| 454 | /* r = (lbm_int)lbm_dec_u(a); break; */ | ||
| 455 | /* case LBM_TYPE_I32: */ | ||
| 456 | /* r = (lbm_int)lbm_dec_i32(a); break; */ | ||
| 457 | /* case LBM_TYPE_U32: */ | ||
| 458 | /* r = (lbm_int)lbm_dec_u32(a); break; */ | ||
| 459 | /* case LBM_TYPE_FLOAT: */ | ||
| 460 | /* r = (lbm_int)lbm_dec_float(a); break; */ | ||
| 461 | /* case LBM_TYPE_I64: */ | ||
| 462 | /* r = (lbm_int)lbm_dec_i64(a); break; */ | ||
| 463 | /* case LBM_TYPE_U64: */ | ||
| 464 | /* r = (lbm_int)lbm_dec_u64(a); break; */ | ||
| 465 | /* case LBM_TYPE_DOUBLE: */ | ||
| 466 | /* r = (lbm_int)lbm_dec_double(a); break; */ | ||
| 467 | /* } */ | ||
| 468 | /* return r; */ | ||
| 469 | /* } */ | ||
| 470 | |||
| 471 | 375496030 | float lbm_dec_as_float(lbm_value a) { | |
| 472 | 375496030 | float r = 0; | |
| 473 |
10/10✓ Branch 0 taken 103748350 times.
✓ Branch 1 taken 168075782 times.
✓ Branch 2 taken 140 times.
✓ Branch 3 taken 140 times.
✓ Branch 4 taken 197 times.
✓ Branch 5 taken 103671009 times.
✓ Branch 6 taken 140 times.
✓ Branch 7 taken 140 times.
✓ Branch 8 taken 28 times.
✓ Branch 9 taken 104 times.
|
375496030 | switch (lbm_type_of_functional(a)) { |
| 474 | 103748350 | case LBM_TYPE_CHAR: | |
| 475 | 103748350 | r = (float)lbm_dec_char(a); break; | |
| 476 | 168075782 | case LBM_TYPE_I: | |
| 477 | 168075782 | r = (float)lbm_dec_i(a); break; | |
| 478 | 140 | case LBM_TYPE_U: | |
| 479 | 140 | r = (float)lbm_dec_u(a); break; | |
| 480 | 140 | case LBM_TYPE_I32: | |
| 481 | 140 | r = (float)lbm_dec_i32(a); break; | |
| 482 | 197 | case LBM_TYPE_U32: | |
| 483 | 197 | r = (float)lbm_dec_u32(a); break; | |
| 484 | 103671009 | case LBM_TYPE_FLOAT: | |
| 485 | 103671009 | r = (float)lbm_dec_float(a); break; | |
| 486 | 140 | case LBM_TYPE_I64: | |
| 487 | 140 | r = (float)lbm_dec_i64(a); break; | |
| 488 | 140 | case LBM_TYPE_U64: | |
| 489 | 140 | r = (float)lbm_dec_u64(a); break; | |
| 490 | 28 | case LBM_TYPE_DOUBLE: | |
| 491 | 28 | r = (float)lbm_dec_double(a); break; | |
| 492 | } | ||
| 493 | 375496030 | return r; | |
| 494 | } | ||
| 495 | |||
| 496 | 564020 | double lbm_dec_as_double(lbm_value a) { | |
| 497 | 564020 | double r = 0; | |
| 498 |
9/10✓ Branch 0 taken 281169 times.
✓ Branch 1 taken 280626 times.
✓ Branch 2 taken 140 times.
✓ Branch 3 taken 140 times.
✓ Branch 4 taken 140 times.
✓ Branch 5 taken 386 times.
✓ Branch 6 taken 140 times.
✓ Branch 7 taken 140 times.
✓ Branch 8 taken 1139 times.
✗ Branch 9 not taken.
|
564020 | switch (lbm_type_of_functional(a)) { |
| 499 | 281169 | case LBM_TYPE_CHAR: | |
| 500 | 281169 | r = (double)lbm_dec_char(a); break; | |
| 501 | 280626 | case LBM_TYPE_I: | |
| 502 | 280626 | r = (double)lbm_dec_i(a); break; | |
| 503 | 140 | case LBM_TYPE_U: | |
| 504 | 140 | r = (double)lbm_dec_u(a); break; | |
| 505 | 140 | case LBM_TYPE_I32: | |
| 506 | 140 | r = (double)lbm_dec_i32(a); break; | |
| 507 | 140 | case LBM_TYPE_U32: | |
| 508 | 140 | r = (double)lbm_dec_u32(a); break; | |
| 509 | 386 | case LBM_TYPE_FLOAT: | |
| 510 | 386 | r = (double)lbm_dec_float(a); break; | |
| 511 | 140 | case LBM_TYPE_I64: | |
| 512 | 140 | r = (double)lbm_dec_i64(a); break; | |
| 513 | 140 | case LBM_TYPE_U64: | |
| 514 | 140 | r = (double)lbm_dec_u64(a); break; | |
| 515 | 1139 | case LBM_TYPE_DOUBLE: | |
| 516 | 1139 | r = (double)lbm_dec_double(a); break; | |
| 517 | } | ||
| 518 | 564020 | return r; | |
| 519 | } | ||
| 520 | |||
| 521 | /****************************************************/ | ||
| 522 | /* HEAP MANAGEMENT */ | ||
| 523 | |||
| 524 | 22390 | static bool generate_freelist(size_t num_cells) { | |
| 525 | 22390 | size_t i = 0; | |
| 526 | |||
| 527 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
|
22390 | if (!lbm_heap_state.heap) return false; |
| 528 | |||
| 529 | 22390 | lbm_heap_state.freelist = lbm_enc_cons_ptr(0); | |
| 530 | |||
| 531 | lbm_cons_t *t; | ||
| 532 | |||
| 533 | // Add all cells to free list | ||
| 534 |
2/2✓ Branch 0 taken 205398154 times.
✓ Branch 1 taken 22390 times.
|
205420544 | for (i = 1; i < num_cells; i ++) { |
| 535 | 205398154 | t = lbm_ref_cell(lbm_enc_cons_ptr(i-1)); | |
| 536 | 205398154 | t->car = ENC_SYM_RECOVERED; // all cars in free list are "RECOVERED" | |
| 537 | 205398154 | t->cdr = lbm_enc_cons_ptr(i); | |
| 538 | } | ||
| 539 | |||
| 540 | // Replace the incorrect pointer at the last cell. | ||
| 541 | 22390 | t = lbm_ref_cell(lbm_enc_cons_ptr(num_cells-1)); | |
| 542 | 22390 | t->cdr = ENC_SYM_NIL; | |
| 543 | |||
| 544 | 22390 | return true; | |
| 545 | } | ||
| 546 | |||
| 547 | 594687 | void lbm_nil_freelist(void) { | |
| 548 | 594687 | lbm_heap_state.freelist = ENC_SYM_NIL; | |
| 549 | 594687 | lbm_heap_state.num_free = 0; | |
| 550 | 594687 | } | |
| 551 | |||
| 552 | 22390 | static void heap_init_state(lbm_cons_t *addr, lbm_uint num_cells, | |
| 553 | lbm_uint* gc_stack_storage, lbm_uint gc_stack_size) { | ||
| 554 | 22390 | lbm_heap_state.heap = addr; | |
| 555 | 22390 | lbm_heap_state.heap_bytes = (unsigned int)(num_cells * sizeof(lbm_cons_t)); | |
| 556 | 22390 | lbm_heap_state.heap_size = num_cells; | |
| 557 | |||
| 558 | 22390 | lbm_stack_create(&lbm_heap_state.gc_stack, gc_stack_storage, gc_stack_size); | |
| 559 | |||
| 560 | 22390 | lbm_heap_state.num_free = num_cells; | |
| 561 | 22390 | lbm_heap_state.num_alloc_arrays = 0; | |
| 562 | 22390 | lbm_heap_state.gc_num = 0; | |
| 563 | 22390 | lbm_heap_state.gc_marked = 0; | |
| 564 | 22390 | lbm_heap_state.gc_recovered = 0; | |
| 565 | 22390 | lbm_heap_state.gc_recovered_arrays = 0; | |
| 566 | 22390 | lbm_heap_state.gc_least_free = num_cells; | |
| 567 | 22390 | lbm_heap_state.gc_last_free = num_cells; | |
| 568 | 22390 | } | |
| 569 | |||
| 570 | 594687 | void lbm_heap_new_freelist_length(void) { | |
| 571 | 594687 | lbm_heap_state.gc_last_free = lbm_heap_state.num_free; | |
| 572 |
2/2✓ Branch 0 taken 4099 times.
✓ Branch 1 taken 590588 times.
|
594687 | if (lbm_heap_state.num_free < lbm_heap_state.gc_least_free) |
| 573 | 4099 | lbm_heap_state.gc_least_free = lbm_heap_state.num_free; | |
| 574 | 594687 | } | |
| 575 | |||
| 576 | 22390 | bool lbm_heap_init(lbm_cons_t *addr, lbm_uint num_cells, | |
| 577 | lbm_uint gc_stack_size) { | ||
| 578 | |||
| 579 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
|
22390 | if (((uintptr_t)addr % 8) != 0) return false; |
| 580 | |||
| 581 | 22390 | memset(addr,0, sizeof(lbm_cons_t) * num_cells); | |
| 582 | |||
| 583 | 22390 | lbm_uint *gc_stack_storage = (lbm_uint*)lbm_malloc(gc_stack_size * sizeof(lbm_uint)); | |
| 584 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
|
22390 | if (gc_stack_storage == NULL) return 0; |
| 585 | |||
| 586 | 22390 | heap_init_state(addr, num_cells, | |
| 587 | gc_stack_storage, gc_stack_size); | ||
| 588 | |||
| 589 | 22390 | lbm_heaps[0] = addr; | |
| 590 | |||
| 591 | 22390 | return generate_freelist(num_cells); | |
| 592 | } | ||
| 593 | |||
| 594 | |||
| 595 | 550195605 | lbm_value lbm_heap_allocate_cell(lbm_type ptr_type, lbm_value car, lbm_value cdr) { | |
| 596 | lbm_value r; | ||
| 597 | 550195605 | lbm_value cell = lbm_heap_state.freelist; | |
| 598 |
2/2✓ Branch 0 taken 550039592 times.
✓ Branch 1 taken 156013 times.
|
550195605 | if (cell) { |
| 599 | 550039592 | lbm_uint heap_ix = lbm_dec_ptr(cell); | |
| 600 | 550039592 | lbm_heap_state.freelist = lbm_heap_state.heap[heap_ix].cdr; | |
| 601 | 550039592 | lbm_heap_state.num_free--; | |
| 602 | 550039592 | lbm_heap_state.heap[heap_ix].car = car; | |
| 603 | 550039592 | lbm_heap_state.heap[heap_ix].cdr = cdr; | |
| 604 | 550039592 | r = lbm_set_ptr_type(cell, ptr_type); | |
| 605 | } else { | ||
| 606 | 156013 | r = ENC_SYM_MERROR; | |
| 607 | } | ||
| 608 | 550195605 | return r; | |
| 609 | } | ||
| 610 | |||
| 611 | 1257587 | lbm_value lbm_heap_allocate_list(lbm_uint n) { | |
| 612 |
2/2✓ Branch 0 taken 3368 times.
✓ Branch 1 taken 1254219 times.
|
1257587 | if (n == 0) return ENC_SYM_NIL; |
| 613 |
2/2✓ Branch 0 taken 1634 times.
✓ Branch 1 taken 1252585 times.
|
1254219 | if (lbm_heap_num_free() < n) return ENC_SYM_MERROR; |
| 614 | // Here the freelist is guaranteed to be a cons_cell. | ||
| 615 | |||
| 616 | 1252585 | lbm_value curr = lbm_heap_state.freelist; | |
| 617 | 1252585 | lbm_value res = curr; | |
| 618 | |||
| 619 | 1252585 | lbm_cons_t *c_cell = NULL; | |
| 620 | 1252585 | lbm_uint count = 0; | |
| 621 | do { | ||
| 622 | 6467514 | c_cell = lbm_ref_cell(curr); | |
| 623 | 6467514 | c_cell->car = ENC_SYM_NIL; | |
| 624 | 6467514 | curr = c_cell->cdr; | |
| 625 | 6467514 | count ++; | |
| 626 |
2/2✓ Branch 0 taken 5214929 times.
✓ Branch 1 taken 1252585 times.
|
6467514 | } while (count < n); |
| 627 | 1252585 | lbm_heap_state.freelist = curr; | |
| 628 | 1252585 | c_cell->cdr = ENC_SYM_NIL; | |
| 629 | 1252585 | lbm_heap_state.num_free-=count; | |
| 630 | 1252585 | return res; | |
| 631 | } | ||
| 632 | |||
| 633 | 21978639 | lbm_value lbm_heap_allocate_list_init_va(unsigned int n, va_list valist) { | |
| 634 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 21978639 times.
|
21978639 | if (n == 0) return ENC_SYM_NIL; |
| 635 |
2/2✓ Branch 0 taken 33189 times.
✓ Branch 1 taken 21945450 times.
|
21978639 | if (lbm_heap_num_free() < n) return ENC_SYM_MERROR; |
| 636 | |||
| 637 | 21945450 | lbm_value curr = lbm_heap_state.freelist; | |
| 638 | 21945450 | lbm_value res = curr; | |
| 639 | |||
| 640 | 21945450 | lbm_cons_t *c_cell = NULL; | |
| 641 | 21945450 | unsigned int count = 0; | |
| 642 | do { | ||
| 643 | 44174756 | c_cell = lbm_ref_cell(curr); | |
| 644 | 44174756 | c_cell->car = va_arg(valist, lbm_value); | |
| 645 | 44174756 | curr = c_cell->cdr; | |
| 646 | 44174756 | count ++; | |
| 647 |
2/2✓ Branch 0 taken 22229306 times.
✓ Branch 1 taken 21945450 times.
|
44174756 | } while (count < n); |
| 648 | 21945450 | lbm_heap_state.freelist = curr; | |
| 649 | 21945450 | c_cell->cdr = ENC_SYM_NIL; | |
| 650 | 21945450 | lbm_heap_state.num_free-=count; | |
| 651 | 21945450 | return res; | |
| 652 | } | ||
| 653 | |||
| 654 | 21978639 | lbm_value lbm_heap_allocate_list_init(unsigned int n, ...) { | |
| 655 | va_list valist; | ||
| 656 | 21978639 | va_start(valist, n); | |
| 657 | 21978639 | lbm_value r = lbm_heap_allocate_list_init_va(n, valist); | |
| 658 | 21978639 | va_end(valist); | |
| 659 | 21978639 | return r; | |
| 660 | } | ||
| 661 | |||
| 662 | ✗ | lbm_uint lbm_heap_num_allocated(void) { | |
| 663 | ✗ | return lbm_heap_state.heap_size - lbm_heap_state.num_free; | |
| 664 | } | ||
| 665 | ✗ | lbm_uint lbm_heap_size(void) { | |
| 666 | ✗ | return lbm_heap_state.heap_size; | |
| 667 | } | ||
| 668 | |||
| 669 | ✗ | lbm_uint lbm_heap_size_bytes(void) { | |
| 670 | ✗ | return lbm_heap_state.heap_bytes; | |
| 671 | } | ||
| 672 | |||
| 673 | 261 | void lbm_get_heap_state(lbm_heap_state_t *res) { | |
| 674 | 261 | *res = lbm_heap_state; | |
| 675 | 261 | } | |
| 676 | |||
| 677 | ✗ | lbm_uint lbm_get_gc_stack_max(void) { | |
| 678 | ✗ | return lbm_get_max_stack(&lbm_heap_state.gc_stack); | |
| 679 | } | ||
| 680 | |||
| 681 | ✗ | lbm_uint lbm_get_gc_stack_size(void) { | |
| 682 | ✗ | return lbm_heap_state.gc_stack.size; | |
| 683 | } | ||
| 684 | |||
| 685 | 281676 | static inline void value_assign(lbm_value *a, lbm_value b) { | |
| 686 | 281676 | lbm_value a_old = *a & LBM_GC_MASK; | |
| 687 | 281676 | *a = a_old | (b & ~LBM_GC_MASK); | |
| 688 | 281676 | } | |
| 689 | |||
| 690 | #ifdef LBM_USE_GC_PTR_REV | ||
| 691 | /* ************************************************************ | ||
| 692 | Deutch-Schorr-Waite (DSW) pointer reversal GC for 2-ptr cells | ||
| 693 | with a hack-solution for the lisp-array case (n-ptr cells). | ||
| 694 | |||
| 695 | DSW visits each branch node 3 times compared to 2 times for | ||
| 696 | the stack based recursive mark. | ||
| 697 | Where the stack based recursive mark performs a stack push/pop, | ||
| 698 | DSW rearranges the, current, prev, next and a ptr field on | ||
| 699 | the heap. | ||
| 700 | |||
| 701 | DSW changes the structure of the heap and it introduces an | ||
| 702 | invalid pointer (LBM_PTR_NULL) temporarily during marking. | ||
| 703 | Since the heap will be "messed up" while marking, a mutex | ||
| 704 | is introuded to keep other processes out of the heap while | ||
| 705 | marking. | ||
| 706 | */ | ||
| 707 | |||
| 708 | static int do_nothing(lbm_value v, bool shared, void *arg) { | ||
| 709 | (void) v; | ||
| 710 | (void) shared; | ||
| 711 | (void) arg; | ||
| 712 | return TRAV_FUN_SUBTREE_CONTINUE; | ||
| 713 | } | ||
| 714 | |||
| 715 | void lbm_gc_mark_phase(lbm_value root) { | ||
| 716 | lbm_mutex_lock(&lbm_const_heap_mutex); | ||
| 717 | lbm_ptr_rev_trav(do_nothing, root, NULL); | ||
| 718 | lbm_mutex_unlock(&lbm_const_heap_mutex); | ||
| 719 | } | ||
| 720 | |||
| 721 | #else | ||
| 722 | // //////////////////////////////////////////////////////////// | ||
| 723 | // Check if a value is currently on the stack | ||
| 724 | // This is a temporary hack to make arrays with cycles work | ||
| 725 | // with Garbage collection. It is an O(stack_size) sollution, there | ||
| 726 | // are O(1) sollutions that has a constant cost even in non-array cases. | ||
| 727 | |||
| 728 | 21842 | bool active_ptr(lbm_value p) { | |
| 729 | 21842 | lbm_stack_t *s = &lbm_heap_state.gc_stack; | |
| 730 | 21842 | bool r = false; | |
| 731 |
2/2✓ Branch 0 taken 260 times.
✓ Branch 1 taken 21842 times.
|
22102 | for (lbm_uint i = 0; i < s->sp; i ++) { |
| 732 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 260 times.
|
260 | if (p == s->data[i]) { |
| 733 | ✗ | r = true; | |
| 734 | ✗ | break; | |
| 735 | } | ||
| 736 | } | ||
| 737 | 21842 | return r; | |
| 738 | } | ||
| 739 | |||
| 740 | // //////////////////////////////////////////////////////////// | ||
| 741 | // Explicit stack "recursive" mark phase | ||
| 742 | |||
| 743 | // Trees are marked in a left subtree before rigth subtree, car first then cdr, | ||
| 744 | // way to favor lisp lists. This means that stack will grow slowly when | ||
| 745 | // marking right-leaning (cdr-recursive) data-structures while left-leaning | ||
| 746 | // (car-recursive) structures uses a lot of stack. | ||
| 747 | |||
| 748 | // Lisp arrays contain an extra book-keeping field to keep track | ||
| 749 | // of how far into the array the marking process has gone. | ||
| 750 | |||
| 751 | // TODO: DSW should be used as a last-resort if the GC stack is exhausted. | ||
| 752 | // If we use DSW as last-resort can we get away with a way smaller | ||
| 753 | // GC stack and unchanged performance (on sensible programs)? | ||
| 754 | |||
| 755 | extern eval_context_t *ctx_running; | ||
| 756 | 9666136 | void lbm_gc_mark_phase(lbm_value root) { | |
| 757 | lbm_value t_ptr; | ||
| 758 | 9666136 | lbm_stack_t *s = &lbm_heap_state.gc_stack; | |
| 759 | 9666136 | s->data[s->sp++] = root; | |
| 760 | |||
| 761 |
2/2✓ Branch 0 taken 47357637 times.
✓ Branch 1 taken 9666136 times.
|
57023773 | while (!lbm_stack_is_empty(s)) { |
| 762 | lbm_value curr; | ||
| 763 | 47357637 | lbm_pop(s, &curr); | |
| 764 | |||
| 765 | 106383598 | mark_shortcut: | |
| 766 | |||
| 767 |
2/2✓ Branch 0 taken 65548798 times.
✓ Branch 1 taken 40834800 times.
|
106383598 | if (!lbm_is_ptr(curr) || |
| 768 |
2/2✓ Branch 0 taken 305 times.
✓ Branch 1 taken 65548493 times.
|
65548798 | (curr & LBM_PTR_TO_CONSTANT_BIT)) { |
| 769 | 45330262 | continue; | |
| 770 | } | ||
| 771 | |||
| 772 | 65548493 | lbm_cons_t *cell = &lbm_heap_state.heap[lbm_dec_ptr(curr)]; | |
| 773 | |||
| 774 |
2/2✓ Branch 0 taken 4474273 times.
✓ Branch 1 taken 61074220 times.
|
65548493 | if (lbm_get_gc_mark(cell->cdr)) { |
| 775 | 4474273 | continue; | |
| 776 | } | ||
| 777 | |||
| 778 | 61074220 | t_ptr = lbm_type_of(curr); | |
| 779 | |||
| 780 | // An array is marked in O(N) time using an additional 32bit | ||
| 781 | // value per array that keeps track of how far into the array GC | ||
| 782 | // has progressed. | ||
| 783 |
2/2✓ Branch 0 taken 21842 times.
✓ Branch 1 taken 61052378 times.
|
61074220 | if (t_ptr == LBM_TYPE_LISPARRAY) { |
| 784 | // O(stack_size) cost when seeing array. This protects | ||
| 785 | // against gc recursing into arrays via cycles. | ||
| 786 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 21842 times.
|
21842 | if (active_ptr(curr)) { |
| 787 | ✗ | continue; // Already in process of marking this array, abort cycle! | |
| 788 | } | ||
| 789 | 21842 | lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car; | |
| 790 | 21842 | lbm_value *arrdata = (lbm_value *)arr->data; | |
| 791 | 21842 | uint32_t index = arr->index; | |
| 792 |
2/2✓ Branch 0 taken 21832 times.
✓ Branch 1 taken 10 times.
|
21842 | if (arr->size > 0) { |
| 793 | 21832 | lbm_push(s, curr); // put array back as bookkeeping. | |
| 794 | // Potential optimization. | ||
| 795 | // 1. CONS pointers are set to curr and recurse. | ||
| 796 | // 2. Any other ptr is marked immediately and index is increased. | ||
| 797 |
3/4✓ Branch 0 taken 1140 times.
✓ Branch 1 taken 20692 times.
✓ Branch 2 taken 1140 times.
✗ Branch 3 not taken.
|
21832 | if (lbm_is_ptr(arrdata[index]) && ((arrdata[index] & LBM_PTR_TO_CONSTANT_BIT) == 0) && |
| 798 |
2/2✓ Branch 0 taken 986 times.
✓ Branch 1 taken 154 times.
|
1140 | !((arrdata[index] & LBM_CONTINUATION_INTERNAL) == LBM_CONTINUATION_INTERNAL)) { |
| 799 | 986 | lbm_cons_t *elt = &lbm_heap_state.heap[lbm_dec_ptr(arrdata[index])]; | |
| 800 |
2/2✓ Branch 0 taken 958 times.
✓ Branch 1 taken 28 times.
|
986 | if (!lbm_get_gc_mark(elt->cdr)) { |
| 801 | 958 | curr = arrdata[index]; | |
| 802 | 958 | arr->index++; | |
| 803 | 958 | goto mark_shortcut; | |
| 804 | } | ||
| 805 | } | ||
| 806 |
2/2✓ Branch 0 taken 18528 times.
✓ Branch 1 taken 2346 times.
|
20874 | if (index < ((arr->size/(sizeof(lbm_value))) - 1)) { |
| 807 | 18528 | arr->index++; | |
| 808 | 18528 | continue; | |
| 809 | } | ||
| 810 | 2346 | arr->index = 0; | |
| 811 | 2346 | lbm_pop(s, &curr); // Remove array from GC stack as we are done marking it. | |
| 812 | } | ||
| 813 | 2356 | cell->cdr = lbm_set_gc_mark(cell->cdr); | |
| 814 | 2356 | lbm_heap_state.gc_marked ++; | |
| 815 | 2356 | continue; | |
| 816 |
2/2✓ Branch 0 taken 303186 times.
✓ Branch 1 taken 60749192 times.
|
61052378 | } else if (t_ptr == LBM_TYPE_CHANNEL) { |
| 817 | 303186 | cell->cdr = lbm_set_gc_mark(cell->cdr); | |
| 818 | 303186 | lbm_heap_state.gc_marked ++; | |
| 819 | // TODO: Can channels be explicitly freed ? | ||
| 820 |
1/2✓ Branch 0 taken 303186 times.
✗ Branch 1 not taken.
|
303186 | if (cell->car != ENC_SYM_NIL) { |
| 821 | 303186 | lbm_char_channel_t *chan = (lbm_char_channel_t *)cell->car; | |
| 822 | 303186 | curr = chan->dependency; | |
| 823 | 303186 | goto mark_shortcut; | |
| 824 | } | ||
| 825 | ✗ | continue; | |
| 826 | } | ||
| 827 | |||
| 828 | 60749192 | cell->cdr = lbm_set_gc_mark(cell->cdr); | |
| 829 | 60749192 | lbm_heap_state.gc_marked ++; | |
| 830 | |||
| 831 |
2/2✓ Branch 0 taken 58721817 times.
✓ Branch 1 taken 2027375 times.
|
60749192 | if (t_ptr == LBM_TYPE_CONS) { |
| 832 |
2/2✓ Branch 0 taken 37672015 times.
✓ Branch 1 taken 21049802 times.
|
58721817 | if (lbm_is_ptr(cell->cdr)) { |
| 833 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 37672015 times.
|
37672015 | if (!lbm_push(s, cell->cdr)) { |
| 834 | ✗ | lbm_critical_error(); | |
| 835 | ✗ | break; | |
| 836 | } | ||
| 837 | } | ||
| 838 | 58721817 | curr = cell->car; | |
| 839 | 58721817 | goto mark_shortcut; // Skip a push/pop | |
| 840 | } | ||
| 841 | } | ||
| 842 | 9666136 | } | |
| 843 | #endif | ||
| 844 | |||
| 845 | //Environments are proper lists with a 2 element list stored in each car. | ||
| 846 | 19637856 | void lbm_gc_mark_env(lbm_value env) { | |
| 847 | 19637856 | lbm_value curr = env; | |
| 848 | lbm_cons_t *c; | ||
| 849 | |||
| 850 |
2/2✓ Branch 0 taken 3363411 times.
✓ Branch 1 taken 19637856 times.
|
23001267 | while (lbm_is_ptr(curr)) { |
| 851 | 3363411 | c = lbm_ref_cell(curr); | |
| 852 | 3363411 | c->cdr = lbm_set_gc_mark(c->cdr); // mark the environent list structure. | |
| 853 | 3363411 | lbm_cons_t *b = lbm_ref_cell(c->car); | |
| 854 | 3363411 | b->cdr = lbm_set_gc_mark(b->cdr); // mark the binding list head cell. | |
| 855 | 3363411 | lbm_gc_mark_phase(b->cdr); // mark the bound object. | |
| 856 | 3363411 | lbm_heap_state.gc_marked +=2; | |
| 857 | 3363411 | curr = c->cdr; | |
| 858 | } | ||
| 859 | 19637856 | } | |
| 860 | |||
| 861 | |||
| 862 | 607872 | void lbm_gc_mark_aux(lbm_uint *aux_data, lbm_uint aux_size) { | |
| 863 |
2/2✓ Branch 0 taken 13760190 times.
✓ Branch 1 taken 607872 times.
|
14368062 | for (lbm_uint i = 0; i < aux_size; i ++) { |
| 864 |
2/2✓ Branch 0 taken 8036920 times.
✓ Branch 1 taken 5723270 times.
|
13760190 | if (lbm_is_ptr(aux_data[i])) { |
| 865 | 8036920 | lbm_type pt_t = lbm_type_of(aux_data[i]); | |
| 866 | 8036920 | lbm_uint pt_v = lbm_dec_ptr(aux_data[i]); | |
| 867 |
3/4✓ Branch 0 taken 8036920 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 3996485 times.
✓ Branch 3 taken 4040435 times.
|
8036920 | if( pt_t >= LBM_POINTER_TYPE_FIRST && |
| 868 | 3996485 | pt_t <= LBM_POINTER_TYPE_LAST && | |
| 869 |
1/2✓ Branch 0 taken 3996485 times.
✗ Branch 1 not taken.
|
3996485 | pt_v < lbm_heap_state.heap_size) { |
| 870 | 3996485 | lbm_gc_mark_phase(aux_data[i]); | |
| 871 | } | ||
| 872 | } | ||
| 873 | } | ||
| 874 | 607872 | } | |
| 875 | |||
| 876 | 1219504 | void lbm_gc_mark_roots(lbm_uint *roots, lbm_uint num_roots) { | |
| 877 |
2/2✓ Branch 0 taken 1836370 times.
✓ Branch 1 taken 1219504 times.
|
3055874 | for (lbm_uint i = 0; i < num_roots; i ++) { |
| 878 | 1836370 | lbm_gc_mark_phase(roots[i]); | |
| 879 | } | ||
| 880 | 1219504 | } | |
| 881 | |||
| 882 | // Sweep moves non-marked heap objects to the free list. | ||
| 883 | 594687 | int lbm_gc_sweep_phase(void) { | |
| 884 | 594687 | unsigned int i = 0; | |
| 885 | 594687 | lbm_cons_t *heap = (lbm_cons_t *)lbm_heap_state.heap; | |
| 886 | |||
| 887 |
2/2✓ Branch 0 taken 1388338688 times.
✓ Branch 1 taken 594687 times.
|
1388933375 | for (i = 0; i < lbm_heap_state.heap_size; i ++) { |
| 888 |
2/2✓ Branch 0 taken 67604831 times.
✓ Branch 1 taken 1320733857 times.
|
1388338688 | if ( lbm_get_gc_mark(heap[i].cdr)) { |
| 889 | 67604831 | heap[i].cdr = lbm_clr_gc_mark(heap[i].cdr); | |
| 890 | } else { | ||
| 891 | // Check if this cell is a pointer to an array | ||
| 892 | // and free it. | ||
| 893 |
2/2✓ Branch 0 taken 293829881 times.
✓ Branch 1 taken 1026903976 times.
|
1320733857 | if (lbm_type_of(heap[i].cdr) == LBM_TYPE_SYMBOL) { |
| 894 |
7/7✓ Branch 0 taken 8398004 times.
✓ Branch 1 taken 29008 times.
✓ Branch 2 taken 585311 times.
✓ Branch 3 taken 306697 times.
✓ Branch 4 taken 2 times.
✓ Branch 5 taken 28 times.
✓ Branch 6 taken 284510831 times.
|
293829881 | switch(heap[i].cdr) { |
| 895 | |||
| 896 | 8398004 | case ENC_SYM_IND_I_TYPE: /* fall through */ | |
| 897 | case ENC_SYM_IND_U_TYPE: | ||
| 898 | case ENC_SYM_IND_F_TYPE: | ||
| 899 | 8398004 | lbm_memory_free((lbm_uint*)heap[i].car); | |
| 900 | 8398004 | break; | |
| 901 | 29008 | case ENC_SYM_DEFRAG_LISPARRAY_TYPE: /* fall through */ | |
| 902 | case ENC_SYM_DEFRAG_ARRAY_TYPE: | ||
| 903 | 29008 | lbm_defrag_mem_free((lbm_uint*)heap[i].car); | |
| 904 | 29008 | break; | |
| 905 | 585311 | case ENC_SYM_LISPARRAY_TYPE: /* fall through */ | |
| 906 | case ENC_SYM_ARRAY_TYPE:{ | ||
| 907 | 585311 | lbm_array_header_t *arr = (lbm_array_header_t*)heap[i].car; | |
| 908 | 585311 | lbm_memory_free((lbm_uint *)arr->data); | |
| 909 | 585311 | lbm_heap_state.gc_recovered_arrays++; | |
| 910 | 585311 | lbm_memory_free((lbm_uint *)arr); | |
| 911 | 585311 | } break; | |
| 912 | 306697 | case ENC_SYM_CHANNEL_TYPE:{ | |
| 913 | 306697 | lbm_char_channel_t *chan = (lbm_char_channel_t*)heap[i].car; | |
| 914 | 306697 | lbm_memory_free((lbm_uint*)chan->state); | |
| 915 | 306697 | lbm_memory_free((lbm_uint*)chan); | |
| 916 | 306697 | } break; | |
| 917 | 2 | case ENC_SYM_CUSTOM_TYPE: { | |
| 918 | 2 | lbm_uint *t = (lbm_uint*)heap[i].car; | |
| 919 | 2 | lbm_custom_type_destroy(t); | |
| 920 | 2 | lbm_memory_free(t); | |
| 921 | 2 | } break; | |
| 922 | 28 | case ENC_SYM_DEFRAG_MEM_TYPE: { | |
| 923 | 28 | lbm_uint *ptr = (lbm_uint *)heap[i].car; | |
| 924 | 28 | lbm_defrag_mem_destroy(ptr); | |
| 925 | 28 | } break; | |
| 926 | 284510831 | default: | |
| 927 | 284510831 | break; | |
| 928 | } | ||
| 929 | } | ||
| 930 | // create pointer to use as new freelist | ||
| 931 | 1320733857 | lbm_uint addr = lbm_enc_cons_ptr(i); | |
| 932 | |||
| 933 | // Clear the "freed" cell. | ||
| 934 | 1320733857 | heap[i].car = ENC_SYM_RECOVERED; | |
| 935 | 1320733857 | heap[i].cdr = lbm_heap_state.freelist; | |
| 936 | 1320733857 | lbm_heap_state.freelist = addr; | |
| 937 | 1320733857 | lbm_heap_state.num_free++; | |
| 938 | 1320733857 | lbm_heap_state.gc_recovered ++; | |
| 939 | } | ||
| 940 | } | ||
| 941 | 594687 | return 1; | |
| 942 | } | ||
| 943 | |||
| 944 | 594687 | void lbm_gc_state_inc(void) { | |
| 945 | 594687 | lbm_heap_state.gc_num ++; | |
| 946 | 594687 | lbm_heap_state.gc_recovered = 0; | |
| 947 | 594687 | lbm_heap_state.gc_marked = 0; | |
| 948 | 594687 | } | |
| 949 | |||
| 950 | // construct, alter and break apart | ||
| 951 | 549152998 | lbm_value lbm_cons(lbm_value car, lbm_value cdr) { | |
| 952 | 549152998 | return lbm_heap_allocate_cell(LBM_TYPE_CONS, car, cdr); | |
| 953 | } | ||
| 954 | |||
| 955 | 539393713 | lbm_value lbm_car(lbm_value c){ | |
| 956 |
2/2✓ Branch 0 taken 539392896 times.
✓ Branch 1 taken 817 times.
|
539393713 | if (lbm_is_ptr(c) ){ |
| 957 | 539392896 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 958 | 539392896 | return cell->car; | |
| 959 | } | ||
| 960 |
2/2✓ Branch 0 taken 47 times.
✓ Branch 1 taken 770 times.
|
817 | return c ? ENC_SYM_TERROR : c; //nil if c == nil |
| 961 | } | ||
| 962 | |||
| 963 | // TODO: Many comparisons "is this the nil symbol" can be | ||
| 964 | // streamlined a bit. NIL is 0 and cannot be confused with any other | ||
| 965 | // lbm_value. | ||
| 966 | |||
| 967 | 1727108 | lbm_value lbm_caar(lbm_value c) { | |
| 968 | 1727108 | lbm_value tmp = ENC_SYM_NIL; | |
| 969 |
2/2✓ Branch 0 taken 1727021 times.
✓ Branch 1 taken 87 times.
|
1727108 | if (lbm_is_ptr(c)) { |
| 970 | 1727021 | tmp = lbm_ref_cell(c)->car; | |
| 971 |
1/2✓ Branch 0 taken 1727021 times.
✗ Branch 1 not taken.
|
1727021 | if (lbm_is_ptr(tmp)) { |
| 972 | 1727021 | return lbm_ref_cell(tmp)->car; | |
| 973 | } | ||
| 974 | } | ||
| 975 |
2/4✓ Branch 0 taken 87 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 87 times.
✗ Branch 3 not taken.
|
87 | return c || tmp ? ENC_SYM_TERROR : c; //nil if not something else |
| 976 | } | ||
| 977 | |||
| 978 | |||
| 979 | 11989 | lbm_value lbm_cadr(lbm_value c) { | |
| 980 | 11989 | lbm_value tmp = ENC_SYM_NIL; | |
| 981 |
1/2✓ Branch 0 taken 11989 times.
✗ Branch 1 not taken.
|
11989 | if (lbm_is_ptr(c)) { |
| 982 | 11989 | tmp = lbm_ref_cell(c)->cdr; | |
| 983 |
1/2✓ Branch 0 taken 11989 times.
✗ Branch 1 not taken.
|
11989 | if (lbm_is_ptr(tmp)) { |
| 984 | 11989 | return lbm_ref_cell(tmp)->car; | |
| 985 | } | ||
| 986 | } | ||
| 987 | ✗ | return c || tmp ? ENC_SYM_TERROR : c; | |
| 988 | } | ||
| 989 | |||
| 990 | 78046579 | lbm_value lbm_cdr(lbm_value c){ | |
| 991 |
2/2✓ Branch 0 taken 77479946 times.
✓ Branch 1 taken 566633 times.
|
78046579 | if (lbm_is_ptr(c)) { |
| 992 | 77479946 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 993 | 77479946 | return cell->cdr; | |
| 994 | } | ||
| 995 |
1/2✓ Branch 0 taken 566633 times.
✗ Branch 1 not taken.
|
566633 | return c ? ENC_SYM_TERROR: c; |
| 996 | } | ||
| 997 | |||
| 998 | ✗ | lbm_value lbm_cddr(lbm_value c) { | |
| 999 | ✗ | if (lbm_is_ptr(c)) { | |
| 1000 | ✗ | lbm_value tmp = lbm_ref_cell(c)->cdr; | |
| 1001 | ✗ | if (lbm_is_ptr(tmp)) { | |
| 1002 | ✗ | return lbm_ref_cell(tmp)->cdr; | |
| 1003 | } | ||
| 1004 | } | ||
| 1005 | ✗ | return c ? ENC_SYM_TERROR : c; | |
| 1006 | } | ||
| 1007 | |||
| 1008 | 6858491 | int lbm_set_car(lbm_value c, lbm_value v) { | |
| 1009 | 6858491 | int r = 0; | |
| 1010 | |||
| 1011 |
2/2✓ Branch 0 taken 6858463 times.
✓ Branch 1 taken 28 times.
|
6858491 | if (lbm_type_of(c) == LBM_TYPE_CONS) { |
| 1012 | 6858463 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 1013 | 6858463 | cell->car = v; | |
| 1014 | 6858463 | r = 1; | |
| 1015 | } | ||
| 1016 | 6858491 | return r; | |
| 1017 | } | ||
| 1018 | |||
| 1019 | 101371179 | int lbm_set_cdr(lbm_value c, lbm_value v) { | |
| 1020 | 101371179 | int r = 0; | |
| 1021 |
2/2✓ Branch 0 taken 100804635 times.
✓ Branch 1 taken 566544 times.
|
101371179 | if (lbm_is_cons_rw(c)){ |
| 1022 | 100804635 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 1023 | 100804635 | cell->cdr = v; | |
| 1024 | 100804635 | r = 1; | |
| 1025 | } | ||
| 1026 | 101371179 | return r; | |
| 1027 | } | ||
| 1028 | |||
| 1029 | 8505665 | int lbm_set_car_and_cdr(lbm_value c, lbm_value car_val, lbm_value cdr_val) { | |
| 1030 | 8505665 | int r = 0; | |
| 1031 |
1/2✓ Branch 0 taken 8505665 times.
✗ Branch 1 not taken.
|
8505665 | if (lbm_is_cons_rw(c)) { |
| 1032 | 8505665 | lbm_cons_t *cell = lbm_ref_cell(c); | |
| 1033 | 8505665 | cell->car = car_val; | |
| 1034 | 8505665 | cell->cdr = cdr_val; | |
| 1035 | 8505665 | r = 1; | |
| 1036 | } | ||
| 1037 | 8505665 | return r; | |
| 1038 | } | ||
| 1039 | |||
| 1040 | /* calculate length of a proper list */ | ||
| 1041 | 1252766 | lbm_uint lbm_list_length(lbm_value c) { | |
| 1042 | 1252766 | lbm_uint len = 0; | |
| 1043 | |||
| 1044 |
2/2✓ Branch 0 taken 5969833 times.
✓ Branch 1 taken 1252766 times.
|
7222599 | while (lbm_is_cons(c)){ |
| 1045 | 5969833 | len ++; | |
| 1046 | 5969833 | c = lbm_cdr(c); | |
| 1047 | } | ||
| 1048 | 1252766 | return len; | |
| 1049 | } | ||
| 1050 | |||
| 1051 | 11316 | lbm_value lbm_list_destructive_reverse(lbm_value list) { | |
| 1052 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 11316 times.
|
11316 | if (lbm_type_of(list) == LBM_TYPE_SYMBOL) { |
| 1053 | ✗ | return list; | |
| 1054 | } | ||
| 1055 | 11316 | lbm_value curr = list; | |
| 1056 | 11316 | lbm_value last_cell = ENC_SYM_NIL; | |
| 1057 | |||
| 1058 |
2/2✓ Branch 0 taken 29165 times.
✓ Branch 1 taken 11316 times.
|
40481 | while (lbm_is_cons_rw(curr)) { |
| 1059 | 29165 | lbm_value next = lbm_cdr(curr); | |
| 1060 | 29165 | lbm_set_cdr(curr, last_cell); | |
| 1061 | 29165 | last_cell = curr; | |
| 1062 | 29165 | curr = next; | |
| 1063 | } | ||
| 1064 | 11316 | return last_cell; | |
| 1065 | } | ||
| 1066 | |||
| 1067 | |||
| 1068 | 330340 | lbm_value lbm_list_copy(int *m, lbm_value list) { | |
| 1069 | 330340 | lbm_value curr = list; | |
| 1070 | 330340 | lbm_uint n = lbm_list_length(list); | |
| 1071 | 330340 | lbm_uint copy_n = n; | |
| 1072 |
4/4✓ Branch 0 taken 6174 times.
✓ Branch 1 taken 324166 times.
✓ Branch 2 taken 5414 times.
✓ Branch 3 taken 760 times.
|
330340 | if (*m >= 0 && (lbm_uint)*m < n) { |
| 1073 | 5414 | copy_n = (lbm_uint)*m; | |
| 1074 |
2/2✓ Branch 0 taken 295762 times.
✓ Branch 1 taken 29164 times.
|
324926 | } else if (*m == -1) { |
| 1075 | 295762 | *m = (int)n; // TODO: smaller range in target variable. | |
| 1076 | } | ||
| 1077 |
2/2✓ Branch 0 taken 231 times.
✓ Branch 1 taken 330109 times.
|
330340 | if (copy_n == 0) return ENC_SYM_NIL; |
| 1078 | 330109 | lbm_uint new_list = lbm_heap_allocate_list(copy_n); | |
| 1079 |
2/2✓ Branch 0 taken 610 times.
✓ Branch 1 taken 329499 times.
|
330109 | if (lbm_is_symbol(new_list)) return new_list; |
| 1080 | 329499 | lbm_value curr_targ = new_list; | |
| 1081 | |||
| 1082 |
4/4✓ Branch 0 taken 3766461 times.
✓ Branch 1 taken 324159 times.
✓ Branch 2 taken 3761121 times.
✓ Branch 3 taken 5340 times.
|
4090620 | while (lbm_is_cons(curr) && copy_n > 0) { |
| 1083 | 3761121 | lbm_value v = lbm_car(curr); | |
| 1084 | 3761121 | lbm_set_car(curr_targ, v); | |
| 1085 | 3761121 | curr_targ = lbm_cdr(curr_targ); | |
| 1086 | 3761121 | curr = lbm_cdr(curr); | |
| 1087 | 3761121 | copy_n --; | |
| 1088 | } | ||
| 1089 | |||
| 1090 | 329499 | return new_list; | |
| 1091 | } | ||
| 1092 | |||
| 1093 | // Append for proper lists only | ||
| 1094 | // Destructive update of list1. | ||
| 1095 | 24178 | lbm_value lbm_list_append(lbm_value list1, lbm_value list2) { | |
| 1096 | |||
| 1097 |
2/4✓ Branch 0 taken 24178 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 24178 times.
✗ Branch 3 not taken.
|
48356 | if(lbm_is_list_rw(list1) && |
| 1098 | 24178 | lbm_is_list(list2)) { | |
| 1099 | |||
| 1100 | 24178 | lbm_value curr = list1; | |
| 1101 |
2/2✓ Branch 0 taken 31645 times.
✓ Branch 1 taken 24178 times.
|
55823 | while(lbm_type_of(lbm_cdr(curr)) == LBM_TYPE_CONS) { |
| 1102 | 31645 | curr = lbm_cdr(curr); | |
| 1103 | } | ||
| 1104 |
2/2✓ Branch 0 taken 30 times.
✓ Branch 1 taken 24148 times.
|
24178 | if (lbm_is_symbol_nil(curr)) return list2; |
| 1105 | 24148 | lbm_set_cdr(curr, list2); | |
| 1106 | 24148 | return list1; | |
| 1107 | } | ||
| 1108 | ✗ | return ENC_SYM_EERROR; | |
| 1109 | } | ||
| 1110 | |||
| 1111 | 84 | lbm_value lbm_list_drop(unsigned int n, lbm_value ls) { | |
| 1112 | 84 | lbm_value curr = ls; | |
| 1113 |
4/4✓ Branch 0 taken 728 times.
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 700 times.
✓ Branch 3 taken 28 times.
|
784 | while (lbm_type_of_functional(curr) == LBM_TYPE_CONS && |
| 1114 | n > 0) { | ||
| 1115 | 700 | curr = lbm_cdr(curr); | |
| 1116 | 700 | n --; | |
| 1117 | } | ||
| 1118 | 84 | return curr; | |
| 1119 | } | ||
| 1120 | |||
| 1121 | 184800 | lbm_value lbm_index_list(lbm_value l, int32_t n) { | |
| 1122 | 184800 | lbm_value curr = l; | |
| 1123 | |||
| 1124 |
2/2✓ Branch 0 taken 113 times.
✓ Branch 1 taken 184687 times.
|
184800 | if (n < 0) { |
| 1125 | 113 | int32_t len = (int32_t)lbm_list_length(l); | |
| 1126 | 113 | n = len + n; | |
| 1127 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 113 times.
|
113 | if (n < 0) return ENC_SYM_NIL; |
| 1128 | } | ||
| 1129 | |||
| 1130 |
4/4✓ Branch 0 taken 280638 times.
✓ Branch 1 taken 30 times.
✓ Branch 2 taken 95868 times.
✓ Branch 3 taken 184770 times.
|
280668 | while (lbm_is_cons(curr) && |
| 1131 | n > 0) { | ||
| 1132 | 95868 | curr = lbm_cdr(curr); | |
| 1133 | 95868 | n --; | |
| 1134 | } | ||
| 1135 |
2/2✓ Branch 0 taken 184770 times.
✓ Branch 1 taken 30 times.
|
184800 | if (lbm_is_cons(curr)) { |
| 1136 | 184770 | return lbm_car(curr); | |
| 1137 | } else { | ||
| 1138 | 30 | return ENC_SYM_NIL; | |
| 1139 | } | ||
| 1140 | } | ||
| 1141 | |||
| 1142 | // High-level arrays are just bytearrays but with a different tag and pointer type. | ||
| 1143 | // These arrays will be inspected by GC and the elements of the array will be marked. | ||
| 1144 | |||
| 1145 | // Arrays are part of the heap module because their lifespan is managed | ||
| 1146 | // by the garbage collector. The data in the array is not stored | ||
| 1147 | // in the "heap of cons cells". | ||
| 1148 | 590615 | int lbm_heap_allocate_array_base(lbm_value *res, bool byte_array, lbm_uint size){ | |
| 1149 | |||
| 1150 | 590615 | lbm_uint tag = ENC_SYM_ARRAY_TYPE; | |
| 1151 | 590615 | lbm_uint type = LBM_TYPE_ARRAY; | |
| 1152 | 590615 | lbm_array_header_t *array = NULL; | |
| 1153 | 590615 | lbm_array_header_extended_t *ext_array = NULL; | |
| 1154 | |||
| 1155 |
2/2✓ Branch 0 taken 307919 times.
✓ Branch 1 taken 282696 times.
|
590615 | if (byte_array) { |
| 1156 | 307919 | array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t)); | |
| 1157 | } else { | ||
| 1158 | 282696 | tag = ENC_SYM_LISPARRAY_TYPE; | |
| 1159 | 282696 | type = LBM_TYPE_LISPARRAY; | |
| 1160 | 282696 | size = sizeof(lbm_value) * size; | |
| 1161 | 282696 | array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_extended_t)); | |
| 1162 | 282696 | ext_array = (lbm_array_header_extended_t*)array; | |
| 1163 | } | ||
| 1164 |
2/2✓ Branch 0 taken 589714 times.
✓ Branch 1 taken 901 times.
|
590615 | if (array) { |
| 1165 |
2/2✓ Branch 0 taken 281836 times.
✓ Branch 1 taken 307878 times.
|
589714 | if (!byte_array) ext_array->index = 0; |
| 1166 | |||
| 1167 | 589714 | array->data = NULL; | |
| 1168 | 589714 | array->size = size; | |
| 1169 |
2/2✓ Branch 0 taken 589562 times.
✓ Branch 1 taken 152 times.
|
589714 | if ( size > 0) { |
| 1170 | 589562 | array->data = (lbm_uint*)lbm_malloc(size); | |
| 1171 |
2/2✓ Branch 0 taken 5752 times.
✓ Branch 1 taken 583810 times.
|
589562 | if (array->data == NULL) { |
| 1172 | 5752 | lbm_memory_free((lbm_uint*)array); | |
| 1173 | 5752 | goto allocate_array_merror; | |
| 1174 | } | ||
| 1175 | // It is more important to zero out high-level arrays. | ||
| 1176 | // 0 is symbol NIL which is perfectly safe for the GC to inspect. | ||
| 1177 | 583810 | memset(array->data, 0, size); | |
| 1178 | } | ||
| 1179 | // allocating a cell for array's heap-presence | ||
| 1180 | 583962 | lbm_value cell = lbm_heap_allocate_cell(type, (lbm_uint) array, tag); | |
| 1181 |
2/2✓ Branch 0 taken 351 times.
✓ Branch 1 taken 583611 times.
|
583962 | if (cell == ENC_SYM_MERROR) { |
| 1182 | 351 | lbm_memory_free((lbm_uint*)array->data); | |
| 1183 | 351 | lbm_memory_free((lbm_uint*)array); | |
| 1184 | 351 | goto allocate_array_merror; | |
| 1185 | } | ||
| 1186 | 583611 | *res = cell; | |
| 1187 | 583611 | lbm_heap_state.num_alloc_arrays ++; | |
| 1188 | 583611 | return 1; | |
| 1189 | } | ||
| 1190 | 901 | allocate_array_merror: | |
| 1191 | 7004 | *res = ENC_SYM_MERROR; | |
| 1192 | 7004 | return 0; | |
| 1193 | } | ||
| 1194 | |||
| 1195 | 307919 | int lbm_heap_allocate_array(lbm_value *res, lbm_uint size){ | |
| 1196 | 307919 | return lbm_heap_allocate_array_base(res, true, size); | |
| 1197 | } | ||
| 1198 | |||
| 1199 | 282696 | int lbm_heap_allocate_lisp_array(lbm_value *res, lbm_uint size) { | |
| 1200 | 282696 | return lbm_heap_allocate_array_base(res, false, size); | |
| 1201 | } | ||
| 1202 | |||
| 1203 | 1126 | int lbm_lift_array(lbm_value *value, char *data, lbm_uint num_elt) { | |
| 1204 | |||
| 1205 | 1126 | lbm_array_header_t *array = NULL; | |
| 1206 | 1126 | lbm_value cell = lbm_heap_allocate_cell(LBM_TYPE_CONS, ENC_SYM_NIL, ENC_SYM_ARRAY_TYPE); | |
| 1207 | |||
| 1208 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1126 times.
|
1126 | if (cell == ENC_SYM_MERROR) { |
| 1209 | ✗ | *value = cell; | |
| 1210 | ✗ | return 0; | |
| 1211 | } | ||
| 1212 | |||
| 1213 | 1126 | array = (lbm_array_header_t*)lbm_malloc(sizeof(lbm_array_header_t)); | |
| 1214 | |||
| 1215 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1126 times.
|
1126 | if (array == NULL) { |
| 1216 | ✗ | lbm_set_car_and_cdr(cell, ENC_SYM_NIL, ENC_SYM_NIL); | |
| 1217 | ✗ | *value = ENC_SYM_MERROR; | |
| 1218 | ✗ | return 0; | |
| 1219 | } | ||
| 1220 | |||
| 1221 | 1126 | array->data = (lbm_uint*)data; | |
| 1222 | 1126 | array->size = num_elt; | |
| 1223 | |||
| 1224 | 1126 | lbm_set_car(cell, (lbm_uint)array); | |
| 1225 | |||
| 1226 | 1126 | cell = lbm_set_ptr_type(cell, LBM_TYPE_ARRAY); | |
| 1227 | 1126 | *value = cell; | |
| 1228 | 1126 | return 1; | |
| 1229 | } | ||
| 1230 | |||
| 1231 | 237774 | lbm_int lbm_heap_array_get_size(lbm_value arr) { | |
| 1232 | |||
| 1233 | 237774 | lbm_int r = -1; | |
| 1234 | 237774 | lbm_array_header_t *header = lbm_dec_array_r(arr); | |
| 1235 |
1/2✓ Branch 0 taken 237774 times.
✗ Branch 1 not taken.
|
237774 | if (header) { |
| 1236 | 237774 | r = (lbm_int)header->size; | |
| 1237 | } | ||
| 1238 | 237774 | return r; | |
| 1239 | } | ||
| 1240 | |||
| 1241 | 119050 | const uint8_t *lbm_heap_array_get_data_ro(lbm_value arr) { | |
| 1242 | 119050 | uint8_t *r = NULL; | |
| 1243 | 119050 | lbm_array_header_t *header = lbm_dec_array_r(arr); | |
| 1244 |
1/2✓ Branch 0 taken 119050 times.
✗ Branch 1 not taken.
|
119050 | if (header) { |
| 1245 | 119050 | r = (uint8_t*)header->data; | |
| 1246 | } | ||
| 1247 | 119050 | return r; | |
| 1248 | } | ||
| 1249 | |||
| 1250 | /* Explicitly freeing an array. | ||
| 1251 | |||
| 1252 | This is a highly unsafe operation and can only be safely | ||
| 1253 | used if the heap cell that points to the array has not been made | ||
| 1254 | accessible to the program. | ||
| 1255 | |||
| 1256 | So This function can be used to free an array in case an array | ||
| 1257 | is being constructed and some error case appears while doing so | ||
| 1258 | If the array still have not become available it can safely be | ||
| 1259 | "explicitly" freed. | ||
| 1260 | |||
| 1261 | The problem is that if the "array" heap-cell is made available to | ||
| 1262 | the program, this cell can easily be duplicated and we would have | ||
| 1263 | to search the entire heap to find all cells pointing to the array | ||
| 1264 | memory in question and "null"-them out before freeing the memory | ||
| 1265 | */ | ||
| 1266 | |||
| 1267 | 112 | int lbm_heap_explicit_free_array(lbm_value arr) { | |
| 1268 | |||
| 1269 | 112 | int r = 0; | |
| 1270 |
2/4✓ Branch 0 taken 112 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 112 times.
✗ Branch 3 not taken.
|
112 | if (lbm_is_array_rw(arr) && lbm_cdr(arr) == ENC_SYM_ARRAY_TYPE) { |
| 1271 | 112 | lbm_array_header_t *header = (lbm_array_header_t*)lbm_car(arr); | |
| 1272 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 112 times.
|
112 | if (header == NULL) { |
| 1273 | ✗ | return 0; | |
| 1274 | } | ||
| 1275 | 112 | lbm_memory_free((lbm_uint*)header->data); | |
| 1276 | 112 | lbm_memory_free((lbm_uint*)header); | |
| 1277 | |||
| 1278 | 112 | arr = lbm_set_ptr_type(arr, LBM_TYPE_CONS); | |
| 1279 | 112 | lbm_set_car(arr, ENC_SYM_NIL); | |
| 1280 | 112 | lbm_set_cdr(arr, ENC_SYM_NIL); | |
| 1281 | 112 | r = 1; | |
| 1282 | } | ||
| 1283 | |||
| 1284 | 112 | return r; | |
| 1285 | } | ||
| 1286 | |||
| 1287 | ✗ | static bool dummy_flash_write(lbm_uint ix, lbm_uint val) { | |
| 1288 | (void)ix; | ||
| 1289 | (void)val; | ||
| 1290 | ✗ | return false; | |
| 1291 | } | ||
| 1292 | |||
| 1293 | static const_heap_write_fun const_heap_write = dummy_flash_write; | ||
| 1294 | |||
| 1295 | 22390 | int lbm_const_heap_init(const_heap_write_fun w_fun, | |
| 1296 | lbm_const_heap_t *heap, | ||
| 1297 | lbm_uint *addr) { | ||
| 1298 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 22390 times.
|
22390 | if (((uintptr_t)addr % 4) != 0) return 0; |
| 1299 | |||
| 1300 |
1/2✓ Branch 0 taken 22390 times.
✗ Branch 1 not taken.
|
22390 | if (!lbm_const_heap_mutex_initialized) { |
| 1301 | 22390 | lbm_mutex_init(&lbm_const_heap_mutex); | |
| 1302 | 22390 | lbm_const_heap_mutex_initialized = true; | |
| 1303 | } | ||
| 1304 | |||
| 1305 |
1/2✓ Branch 0 taken 22390 times.
✗ Branch 1 not taken.
|
22390 | if (!lbm_mark_mutex_initialized) { |
| 1306 | 22390 | lbm_mutex_init(&lbm_mark_mutex); | |
| 1307 | 22390 | lbm_mark_mutex_initialized = true; | |
| 1308 | } | ||
| 1309 | |||
| 1310 | 22390 | const_heap_write = w_fun; | |
| 1311 | |||
| 1312 | 22390 | heap->heap = addr; | |
| 1313 | 22390 | heap->size = 0; | |
| 1314 | 22390 | heap->next = 0; | |
| 1315 | |||
| 1316 | 22390 | lbm_const_heap_state = heap; | |
| 1317 | // ref_cell views the lbm_uint array as an lbm_cons_t array | ||
| 1318 | 22390 | lbm_heaps[1] = (lbm_cons_t*)addr; | |
| 1319 | 22390 | return 1; | |
| 1320 | } | ||
| 1321 | |||
| 1322 | 2891 | lbm_flash_status lbm_allocate_const_cell(lbm_value *res) { | |
| 1323 | 2891 | lbm_flash_status r = LBM_FLASH_FULL; | |
| 1324 | |||
| 1325 | 2891 | lbm_mutex_lock(&lbm_const_heap_mutex); | |
| 1326 | // waste a cell if we have ended up unaligned after writing an array to flash. | ||
| 1327 |
2/2✓ Branch 0 taken 163 times.
✓ Branch 1 taken 2728 times.
|
2891 | if (lbm_const_heap_state->next % 2 == 1) { |
| 1328 | 163 | lbm_const_heap_state->next++; | |
| 1329 | } | ||
| 1330 | |||
| 1331 |
1/2✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
|
2891 | if (lbm_const_heap_state && |
| 1332 |
1/2✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
|
2891 | (lbm_const_heap_state->next+1) < (uint32_t)lbm_image_get_write_index()) { |
| 1333 | // A cons cell uses two words. | ||
| 1334 | 2891 | lbm_value cell = lbm_const_heap_state->next; | |
| 1335 | 2891 | lbm_const_heap_state->next += 2; | |
| 1336 | 2891 | *res = (cell << LBM_ADDRESS_SHIFT) | LBM_PTR_BIT | LBM_TYPE_CONS | LBM_PTR_TO_CONSTANT_BIT; | |
| 1337 | 2891 | r = LBM_FLASH_WRITE_OK; | |
| 1338 | } | ||
| 1339 | 2891 | lbm_mutex_unlock(&lbm_const_heap_mutex); | |
| 1340 | 2891 | return r; | |
| 1341 | } | ||
| 1342 | |||
| 1343 | 28 | lbm_flash_status lbm_allocate_const_raw(lbm_uint nwords, lbm_uint *res) { | |
| 1344 | 28 | lbm_flash_status r = LBM_FLASH_FULL; | |
| 1345 | |||
| 1346 |
1/2✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
|
28 | if (lbm_const_heap_state && |
| 1347 |
1/2✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
|
28 | (lbm_const_heap_state->next + nwords) < (uint32_t)lbm_image_get_write_index()) { |
| 1348 | 28 | lbm_uint ix = lbm_const_heap_state->next; | |
| 1349 | 28 | *res = (lbm_uint)&lbm_const_heap_state->heap[ix]; | |
| 1350 | 28 | lbm_const_heap_state->next += nwords; | |
| 1351 | 28 | r = LBM_FLASH_WRITE_OK; | |
| 1352 | } | ||
| 1353 | 28 | return r; | |
| 1354 | } | ||
| 1355 | |||
| 1356 | 195045 | lbm_flash_status lbm_write_const_raw(lbm_uint *data, lbm_uint n, lbm_uint *res) { | |
| 1357 | |||
| 1358 | 195045 | lbm_flash_status r = LBM_FLASH_FULL; | |
| 1359 | |||
| 1360 |
1/2✓ Branch 0 taken 195045 times.
✗ Branch 1 not taken.
|
195045 | if (lbm_const_heap_state && |
| 1361 |
1/2✓ Branch 0 taken 195045 times.
✗ Branch 1 not taken.
|
195045 | (lbm_const_heap_state->next + n) < (uint32_t)lbm_image_get_write_index()) { |
| 1362 | 195045 | lbm_uint ix = lbm_const_heap_state->next; | |
| 1363 | |||
| 1364 |
2/2✓ Branch 0 taken 218971 times.
✓ Branch 1 taken 195045 times.
|
414016 | for (unsigned int i = 0; i < n; i ++) { |
| 1365 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 218971 times.
|
218971 | if (!const_heap_write(((lbm_uint*)data)[i],ix + i)) |
| 1366 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
| 1367 | } | ||
| 1368 | 195045 | lbm_const_heap_state->next += n; | |
| 1369 | 195045 | *res = (lbm_uint)&lbm_const_heap_state->heap[ix]; | |
| 1370 | 195045 | r = LBM_FLASH_WRITE_OK; | |
| 1371 | } | ||
| 1372 | 195045 | return r; | |
| 1373 | } | ||
| 1374 | |||
| 1375 | 84 | lbm_flash_status lbm_const_write(lbm_uint *tgt, lbm_uint val) { | |
| 1376 | |||
| 1377 |
1/2✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
|
84 | if (lbm_const_heap_state) { |
| 1378 | 84 | lbm_uint flash = (lbm_uint)lbm_const_heap_state->heap; | |
| 1379 | 84 | lbm_uint ix = (((lbm_uint)tgt - flash) / sizeof(lbm_uint)); // byte address to ix | |
| 1380 |
1/2✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
|
84 | if (const_heap_write(val, ix)) { |
| 1381 | 84 | return LBM_FLASH_WRITE_OK; | |
| 1382 | } | ||
| 1383 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
| 1384 | } | ||
| 1385 | ✗ | return LBM_FLASH_FULL; | |
| 1386 | } | ||
| 1387 | |||
| 1388 | 2891 | lbm_flash_status write_const_cdr(lbm_value cell, lbm_value val) { | |
| 1389 | 2891 | lbm_uint addr = lbm_dec_ptr(cell); | |
| 1390 |
1/2✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
|
2891 | if (const_heap_write(val, addr+1)) |
| 1391 | 2891 | return LBM_FLASH_WRITE_OK; | |
| 1392 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
| 1393 | } | ||
| 1394 | |||
| 1395 | 2891 | lbm_flash_status write_const_car(lbm_value cell, lbm_value val) { | |
| 1396 | 2891 | lbm_uint addr = lbm_dec_ptr(cell); | |
| 1397 |
1/2✓ Branch 0 taken 2891 times.
✗ Branch 1 not taken.
|
2891 | if (const_heap_write(val, addr)) |
| 1398 | 2891 | return LBM_FLASH_WRITE_OK; | |
| 1399 | ✗ | return LBM_FLASH_WRITE_ERROR; | |
| 1400 | } | ||
| 1401 | |||
| 1402 | ✗ | lbm_uint lbm_flash_memory_usage(void) { | |
| 1403 | ✗ | return lbm_const_heap_state->next; | |
| 1404 | } | ||
| 1405 | |||
| 1406 | |||
| 1407 | // //////////////////////////////////////////////////////////// | ||
| 1408 | // pointer reversal traversal | ||
| 1409 | // | ||
| 1410 | // Caveats: | ||
| 1411 | // * Structures on the constant heap cannot be traversed using | ||
| 1412 | // pointer reversal. If a dynamic structure is pointing into the | ||
| 1413 | // constant heap, the 'f' will be applied to the constant cons cell on | ||
| 1414 | // the border and then traversal will retreat. | ||
| 1415 | // | ||
| 1416 | // * It may be impossible to detect all kinds of cycles | ||
| 1417 | // if attempting to use and restore the GC in a single pass | ||
| 1418 | // over the tree. To detect cycles all visited nodes must | ||
| 1419 | // remain detectable when traversing all branches! | ||
| 1420 | // | ||
| 1421 | // * Potential fix is to run GC after a complete traversal of the | ||
| 1422 | // entire value in order to restore the GC bits. | ||
| 1423 | // | ||
| 1424 | // * If we leave GC bits set when traversing values, we can use this | ||
| 1425 | // to detect cycles that happen in multiple steps accross values | ||
| 1426 | // in the environment. | ||
| 1427 | // | ||
| 1428 | // * lbm_ptr_rev_trav with the "do_nothing" travfun is the same thing | ||
| 1429 | // as a GC mark phase! Maybe utilize this for code-size | ||
| 1430 | // purposes. This also increases the amount of testing the | ||
| 1431 | // ptr_rev_trav function is subjected to. | ||
| 1432 | |||
| 1433 | 945 | void lbm_ptr_rev_trav(trav_fun f, lbm_value v, void* arg) { | |
| 1434 | |||
| 1435 | 945 | lbm_value curr = v; | |
| 1436 | 945 | lbm_value prev = lbm_enc_cons_ptr(LBM_PTR_NULL); | |
| 1437 | while (true) { | ||
| 1438 | |||
| 1439 | // Run leftwards and process conses until | ||
| 1440 | // hitting a leaf in the left direction. | ||
| 1441 | |||
| 1442 | // If curr is marked here there is a cycle in the graph. | ||
| 1443 | // In case of a cycle or leaf, this first loop is exited. | ||
| 1444 |
2/2✓ Branch 0 taken 75 times.
✓ Branch 1 taken 24462 times.
|
72555 | while (((lbm_is_cons_rw(curr)) || |
| 1445 |
4/4✓ Branch 0 taken 24537 times.
✓ Branch 1 taken 23481 times.
✓ Branch 2 taken 23428 times.
✓ Branch 3 taken 128 times.
|
48093 | (lbm_is_lisp_array_rw(curr))) && !gc_marked(curr)) { |
| 1446 | 23428 | lbm_cons_t *cell = lbm_ref_cell(curr); | |
| 1447 |
2/2✓ Branch 0 taken 23368 times.
✓ Branch 1 taken 60 times.
|
23428 | if (lbm_is_cons(curr)) { |
| 1448 | // In-order traversal | ||
| 1449 |
2/2✓ Branch 0 taken 76 times.
✓ Branch 1 taken 23292 times.
|
23368 | if (f(curr, false, arg) == TRAV_FUN_SUBTREE_DONE) { |
| 1450 | 76 | lbm_gc_mark_phase(curr); | |
| 1451 | 76 | goto trav_backtrack; | |
| 1452 | } | ||
| 1453 | 23292 | gc_mark(curr); | |
| 1454 | |||
| 1455 | 23292 | lbm_value next = 0; | |
| 1456 | 23292 | value_assign(&next, cell->car); | |
| 1457 | 23292 | value_assign(&cell->car, prev); | |
| 1458 | 23292 | value_assign(&prev, curr); | |
| 1459 | 23292 | value_assign(&curr, next); | |
| 1460 | } else { // it is an array | ||
| 1461 | |||
| 1462 | 60 | lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car; | |
| 1463 | 60 | lbm_value *arr_data = (lbm_value *)arr->data; | |
| 1464 | 60 | uint32_t index = arr->index; | |
| 1465 |
2/2✓ Branch 0 taken 6 times.
✓ Branch 1 taken 54 times.
|
60 | if (arr->size == 0) break; |
| 1466 |
1/2✓ Branch 0 taken 54 times.
✗ Branch 1 not taken.
|
54 | if (index == 0) { // index should only be 0 or there is a potential cycle |
| 1467 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 54 times.
|
54 | if (f(curr, false, arg) == TRAV_FUN_SUBTREE_DONE) { |
| 1468 | ✗ | lbm_gc_mark_phase(curr); | |
| 1469 | ✗ | break; | |
| 1470 | } | ||
| 1471 | 54 | arr->index = 1; | |
| 1472 | 54 | gc_mark(curr); | |
| 1473 | |||
| 1474 | 54 | lbm_value next = 0; | |
| 1475 | 54 | value_assign(&next, arr_data[0]); | |
| 1476 | 54 | value_assign(&arr_data[0], prev); | |
| 1477 | 54 | value_assign(&prev, curr); | |
| 1478 | 54 | value_assign(&curr, next); | |
| 1479 | } | ||
| 1480 | } | ||
| 1481 | } | ||
| 1482 | // Currently there are a few different users of this traversal. | ||
| 1483 | // size, flatten and detect_sharing. | ||
| 1484 | // detect_sharing make use of the shared (true) argument in f(curr, true, arg) | ||
| 1485 | // while the other do not. detect_sharing also assumes it is run once per env item | ||
| 1486 | // while not resetting any GC-bits in between. This detects global sharing. | ||
| 1487 | |||
| 1488 |
4/4✓ Branch 0 taken 866 times.
✓ Branch 1 taken 23730 times.
✓ Branch 2 taken 128 times.
✓ Branch 3 taken 738 times.
|
24596 | if (lbm_is_ptr(curr) && gc_marked(curr)) { |
| 1489 | // gc bit set so this subtree is already traversed. | ||
| 1490 | // f is called with true to indicate visited node. | ||
| 1491 | // if this happens during a sharing discovery phase, curr will be added to sharing table. | ||
| 1492 | 128 | f(curr, true, arg); | |
| 1493 | // In this case f should not be able to return subtree continue. | ||
| 1494 | // The only correct return value from f is PROCEED. | ||
| 1495 |
2/2✓ Branch 0 taken 3 times.
✓ Branch 1 taken 24465 times.
|
24468 | } else if (!lbm_is_cons(curr) || // Found a leaf |
| 1496 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 3 times.
|
3 | (curr & LBM_PTR_TO_CONSTANT_BIT)) { |
| 1497 |
4/4✓ Branch 0 taken 738 times.
✓ Branch 1 taken 23730 times.
✓ Branch 2 taken 735 times.
✓ Branch 3 taken 3 times.
|
24468 | if (lbm_is_ptr(curr) && !(curr & LBM_PTR_TO_CONSTANT_BIT)) gc_mark(curr); // Mark it so that the mandatory GC does not swipe it. |
| 1498 | 24468 | f(curr, false, arg); | |
| 1499 | } | ||
| 1500 | |||
| 1501 | // Now either prev has the "flag" set or it doesnt. | ||
| 1502 | // If the flag is set that means that the prev node | ||
| 1503 | // have had both its car and cdr visited. So that node is done! | ||
| 1504 | // | ||
| 1505 | // If the flag is not set, jump down to SWAP | ||
| 1506 | |||
| 1507 | ✗ | trav_backtrack: | |
| 1508 |
2/2✓ Branch 0 taken 46584 times.
✓ Branch 1 taken 945 times.
|
95547 | while ((lbm_is_cons(prev) && |
| 1509 |
2/2✓ Branch 0 taken 23292 times.
✓ Branch 1 taken 23292 times.
|
94113 | (lbm_dec_ptr(prev) != LBM_PTR_NULL) && // is LBM_NULL a cons type? |
| 1510 |
4/4✓ Branch 0 taken 47529 times.
✓ Branch 1 taken 489 times.
✓ Branch 2 taken 489 times.
✓ Branch 3 taken 24237 times.
|
119328 | lbm_get_gc_flag(lbm_car(prev))) || |
| 1511 | 24726 | lbm_is_lisp_array_rw(prev)) { | |
| 1512 | 23781 | lbm_cons_t *cell = lbm_ref_cell(prev); | |
| 1513 |
2/2✓ Branch 0 taken 23292 times.
✓ Branch 1 taken 489 times.
|
23781 | if (lbm_is_cons(prev)) { |
| 1514 | |||
| 1515 | // clear the flag | ||
| 1516 | // This means that we are done with a "CDR" child. | ||
| 1517 | // prev = [ a , b ][flag = 1] | ||
| 1518 | // => | ||
| 1519 | // prev = [ a , b ][flag = 0] | ||
| 1520 | |||
| 1521 | //gc_clear_mark(prev); | ||
| 1522 | 23292 | cell->car = lbm_clr_gc_flag(cell->car); | |
| 1523 | // Move on downwards until | ||
| 1524 | // finding a cons cell without flag or NULL | ||
| 1525 | |||
| 1526 | // curr = c | ||
| 1527 | // prev = [ a , b ][flag = 0] | ||
| 1528 | // => | ||
| 1529 | // prev = [ a , c ][flag = 0] | ||
| 1530 | // curr = prev | ||
| 1531 | // prev = b | ||
| 1532 | |||
| 1533 | 23292 | lbm_value next = 0; | |
| 1534 | 23292 | value_assign(&next, cell->cdr); | |
| 1535 | 23292 | value_assign(&cell->cdr, curr); | |
| 1536 | 23292 | value_assign(&curr, prev); | |
| 1537 | 23292 | value_assign(&prev, next); | |
| 1538 | } else { // is an array | ||
| 1539 | 489 | lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car; | |
| 1540 | 489 | lbm_value *arr_data = (lbm_value *)arr->data; | |
| 1541 | 489 | size_t arr_size = (size_t)arr->size / sizeof(lbm_value); | |
| 1542 | 489 | lbm_value next = 0; | |
| 1543 |
2/2✓ Branch 0 taken 54 times.
✓ Branch 1 taken 435 times.
|
489 | if (arr->index == arr_size) { |
| 1544 | 54 | value_assign(&next, arr_data[arr->index-1]); | |
| 1545 | 54 | value_assign(&arr_data[arr->index-1], curr); | |
| 1546 | 54 | value_assign(&curr, prev); | |
| 1547 | 54 | value_assign(&prev, next); | |
| 1548 | 54 | arr->index = 0; | |
| 1549 | } else { | ||
| 1550 | 435 | break; | |
| 1551 | } | ||
| 1552 | } | ||
| 1553 | } | ||
| 1554 | |||
| 1555 | // SWAP | ||
| 1556 | |||
| 1557 | // if the prev node is NULL we have traced backwards all the | ||
| 1558 | // way back to where curr == v. Another alternative is that | ||
| 1559 | // the input v was an Atom. We are done! | ||
| 1560 |
3/4✓ Branch 0 taken 24672 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 945 times.
✓ Branch 3 taken 23727 times.
|
49344 | if (lbm_is_ptr(prev) && |
| 1561 | 24672 | lbm_dec_ptr(prev) == LBM_PTR_NULL) { | |
| 1562 | 945 | if (lbm_is_cons(curr)) { | |
| 1563 | //gc_clear_mark(curr); | ||
| 1564 | } | ||
| 1565 | //done = true; | ||
| 1566 | 945 | break; | |
| 1567 | } | ||
| 1568 | |||
| 1569 | // if the prev node is not NULL then we should move | ||
| 1570 | // down to the prev node and start process its remaining child. | ||
| 1571 |
2/2✓ Branch 0 taken 23292 times.
✓ Branch 1 taken 435 times.
|
23727 | else if (lbm_is_cons(prev)) { |
| 1572 | |||
| 1573 | 23292 | lbm_cons_t *cell = lbm_ref_cell(prev); | |
| 1574 | 23292 | lbm_value next = 0; | |
| 1575 | |||
| 1576 | |||
| 1577 | // prev = [ p , cdr ][flag = 0] | ||
| 1578 | // => | ||
| 1579 | // prev = [ p , cdr ][flag = 1] | ||
| 1580 | |||
| 1581 | 23292 | cell->car = lbm_set_gc_flag(cell->car); | |
| 1582 | |||
| 1583 | // switch to processing the cdr field and set the flag. | ||
| 1584 | // curr = c | ||
| 1585 | // prev = [ a, b ][flag = 1] | ||
| 1586 | // => | ||
| 1587 | // prev = [ c, a ][flag = 1] | ||
| 1588 | // curr = b | ||
| 1589 | |||
| 1590 | 23292 | value_assign(&next, cell->car); | |
| 1591 | 23292 | value_assign(&cell->car, curr); | |
| 1592 | 23292 | value_assign(&curr, cell->cdr); | |
| 1593 | 23292 | value_assign(&cell->cdr, next); | |
| 1594 |
1/2✓ Branch 0 taken 435 times.
✗ Branch 1 not taken.
|
435 | } else if (lbm_is_lisp_array_rw(prev)) { |
| 1595 | 435 | lbm_cons_t *cell = lbm_ref_cell(prev); | |
| 1596 | 435 | lbm_array_header_extended_t *arr = (lbm_array_header_extended_t*)cell->car; | |
| 1597 | 435 | lbm_value *arr_data = (lbm_value *)arr->data; | |
| 1598 | 435 | lbm_value next = 0; | |
| 1599 | |||
| 1600 | 435 | value_assign(&next, arr_data[arr->index-1]); | |
| 1601 | 435 | value_assign(&arr_data[arr->index-1], curr); | |
| 1602 | 435 | value_assign(&curr, arr_data[arr->index]); | |
| 1603 | 435 | value_assign(&arr_data[arr->index], next); | |
| 1604 | 435 | arr->index = arr->index + 1; | |
| 1605 | } | ||
| 1606 | } | ||
| 1607 | 945 | } | |
| 1608 |