GCC Code Coverage Report

Directory: ../src/
File: /home/joels/Current/lispbm/src/extensions/matvec_extensions.c
Date: 2024-11-05 17:11:09
Exec Total Coverage
Lines: 184 188 97.9%
Functions: 17 17 100.0%
Branches: 69 116 59.5%
Line Branch Exec Source
1 /*
2 Copyright 2023 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 "extensions.h"
19 #include "lbm_utils.h"
20 #include "lbm_custom_type.h"
21
22 #include <math.h>
23
24 static const char *vector_float_desc = "Vector-Float";
25 static const char *matrix_float_desc = "Matrix-Float";
26
27 typedef struct {
28 lbm_uint size;
29 float data[1];
30 } vector_float_t;
31
32 28 static bool common_destructor(lbm_uint value) {
33 28 lbm_free((void*)value);
34 28 return true;
35 }
36
37 420 static lbm_value vector_float_allocate(lbm_uint size) {
38 420 vector_float_t *mem = lbm_malloc( 1 * sizeof(lbm_uint) +
39 size * sizeof(float));
40
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 420 times.
 420 if (!mem) return ENC_SYM_MERROR;
41 420 mem->size = size;
42 420 lbm_value res = 0;
43 420 lbm_custom_type_create((lbm_uint)mem,
44 common_destructor,
45 vector_float_desc,
46 &res);
47 420 return res;
48 }
49
50 504 static bool is_vector_float(lbm_value v) {
51
3/4
✓ Branch 1 taken 476 times.
✓ Branch 2 taken 28 times.
✓ Branch 4 taken 476 times.
✗ Branch 5 not taken.
 504 return (lbm_is_custom(v) && ((lbm_uint)lbm_get_custom_descriptor(v) == (lbm_uint)vector_float_desc));
52 }
53
54 /* **************************************************
55 * Matrices stored in row-major form
56 */
57
58 typedef struct {
59 lbm_uint rows;
60 lbm_uint cols;
61 float data[1];
62 } matrix_float_t;
63
64 28 static lbm_value matrix_float_allocate(unsigned int rows, unsigned int cols) {
65 28 matrix_float_t *mem = lbm_malloc(1 * sizeof(lbm_uint) +
66 28 1 * sizeof(lbm_uint) +
67 28 rows * cols * sizeof(float));
68
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 28 times.
 28 if (!mem) return ENC_SYM_MERROR;
69 28 mem->rows = rows;
70 28 mem->cols = cols;
71 28 lbm_value res = 0;
72 28 lbm_custom_type_create((lbm_uint)mem,
73 common_destructor,
74 matrix_float_desc,
75 &res);
76 28 return res;
77 }
78
79 28 static bool is_matrix_float(lbm_value m) {
80
2/4
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
✓ Branch 4 taken 28 times.
✗ Branch 5 not taken.
 28 return (lbm_is_custom(m) && (lbm_uint)lbm_get_custom_descriptor(m) == (lbm_uint)matrix_float_desc);
81 }
82
83 /* **************************************************
84 * Extension implementations
85 */
86
87 196 static lbm_value ext_vector(lbm_value *args, lbm_uint argn) {
88
89
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 196 times.
 196 LBM_CHECK_NUMBER_ALL();
90
91
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 196 times.
 196 if (argn < 1) return ENC_SYM_TERROR;
92
93 196 lbm_value vec = vector_float_allocate(argn);
94
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 196 times.
 196 if (lbm_is_error(vec)) return vec;
95
96 196 vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(vec);
97
98
2/2
✓ Branch 0 taken 700 times.
✓ Branch 1 taken 196 times.
 896 for (lbm_uint i = 0; i < argn; i ++) {
99 700 lvec->data[i] = lbm_dec_as_float(args[i]);
100 }
101 196 return vec;
102 }
103
104 140 static lbm_value ext_list_to_vector(lbm_value *args, lbm_uint argn) {
105
106 140 lbm_value res = ENC_SYM_TERROR;
107
108
2/4
✓ Branch 0 taken 140 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 140 times.
✗ Branch 3 not taken.
 280 if (argn == 1 &&
109 140 lbm_is_list(args[0])) {
110
111 140 bool nums = true;
112 140 unsigned int len = lbm_list_length_pred(args[0], &nums, lbm_is_number);
113
114
2/4
✓ Branch 0 taken 140 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 140 times.
✗ Branch 3 not taken.
 140 if (len > 0 && nums) {
115 140 lbm_value vec = vector_float_allocate(len);
116
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 140 times.
 140 if (lbm_is_error(vec)) return vec;
117 140 vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(vec);
118
119 140 lbm_value curr = args[0];
120 140 unsigned int i = 0;
121
2/2
✓ Branch 1 taken 504 times.
✓ Branch 2 taken 140 times.
 644 while (lbm_is_cons(curr)) {
122 504 lvec->data[i] = lbm_dec_as_float(lbm_car(curr));
123 504 i ++;
124 504 curr = lbm_cdr(curr);
125 }
126 140 res = vec;
127 }
128 }
129 140 return res;
130 }
131
132 112 static lbm_value ext_vector_to_list(lbm_value *args, lbm_uint argn) {
133
134 112 lbm_value res = ENC_SYM_TERROR;
135
2/4
✓ Branch 0 taken 112 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 112 times.
✗ Branch 4 not taken.
 112 if (argn == 1 && is_vector_float(args[0])) {
136 112 vector_float_t *lvec = (vector_float_t*)lbm_get_custom_value(args[0]);
137
138 112 lbm_value result = lbm_heap_allocate_list(lvec->size);
139
1/2
✓ Branch 1 taken 112 times.
✗ Branch 2 not taken.
 112 if (lbm_is_cons(result)) {
140 112 lbm_value curr = result;
141
2/2
✓ Branch 0 taken 392 times.
✓ Branch 1 taken 112 times.
 504 for (lbm_uint i = 0; i < lvec->size; i ++) {
142 392 lbm_value f_val = lbm_enc_float(lvec->data[i]);
143
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 392 times.
 392 if (lbm_is_error(f_val)) {
144 ✗ result = f_val;
145 ✗ break;
146 }
147 392 lbm_set_car(curr, f_val);
148 392 curr = lbm_cdr(curr);
149 }
150 112 res = result;
151 }
152 }
153 112 return res;
154 }
155
156 112 static lbm_value ext_vproj(lbm_value *args, lbm_uint argn) {
157 112 lbm_value res = ENC_SYM_TERROR;
158
2/4
✓ Branch 0 taken 112 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 112 times.
✗ Branch 3 not taken.
 224 if (argn == 2 &&
159
1/2
✓ Branch 1 taken 112 times.
✗ Branch 2 not taken.
 224 is_vector_float(args[0]) &&
160 112 lbm_is_number(args[1])) {
161 112 vector_float_t *vec = (vector_float_t*)lbm_get_custom_value(args[0]);
162 112 uint32_t i = lbm_dec_as_u32(args[1]);
163
1/2
✓ Branch 0 taken 112 times.
✗ Branch 1 not taken.
 112 if (i < vec->size) {
164 112 res = lbm_enc_float(vec->data[i]);
165 }
166 }
167 112 return res;
168 }
169
170 56 static lbm_value ext_axpy(lbm_value *args, lbm_uint argn ) {
171
172 56 lbm_value res = ENC_SYM_TERROR;
173
174
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 56 times.
 56 if (argn != 3) return res;
175 56 lbm_value a = args[0];
176 56 lbm_value x = args[1];
177 56 lbm_value y = args[2];
178
179
3/6
✓ Branch 1 taken 56 times.
✗ Branch 2 not taken.
✓ Branch 4 taken 56 times.
✗ Branch 5 not taken.
✓ Branch 7 taken 56 times.
✗ Branch 8 not taken.
 56 if (is_vector_float(x) && is_vector_float(y) && lbm_is_number(a)) {
180
181 56 float alpha = lbm_dec_as_float(a);
182 56 vector_float_t *X = (vector_float_t*)lbm_get_custom_value(x);
183 56 vector_float_t *Y = (vector_float_t*)lbm_get_custom_value(y);
184
185
1/2
✓ Branch 0 taken 56 times.
✗ Branch 1 not taken.
 56 if (X->size == Y->size) {
186
187 56 lbm_uint res_size = X->size;
188
189 56 res = vector_float_allocate(res_size);
190
1/2
✓ Branch 1 taken 56 times.
✗ Branch 2 not taken.
 56 if (!lbm_is_symbol_merror(res)) {
191
192 56 vector_float_t *R = (vector_float_t*)lbm_get_custom_value(res);
193
194
2/2
✓ Branch 0 taken 224 times.
✓ Branch 1 taken 56 times.
 280 for (unsigned i = 0; i < res_size; i ++) {
195 224 R->data[i] = alpha * X->data[i] + Y->data[i];
196 }
197 }
198 }
199 }
200 56 return res;
201 }
202
203 28 static lbm_value ext_dot(lbm_value *args, lbm_uint argn) {
204
205 28 lbm_value res = ENC_SYM_TERROR;
206
207
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 28 times.
 28 if (argn != 2) return res;
208 28 lbm_value x = args[0];
209 28 lbm_value y = args[1];
210
211
2/4
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
✓ Branch 4 taken 28 times.
✗ Branch 5 not taken.
 28 if (is_vector_float(x) && is_vector_float(y)) {
212
213 28 vector_float_t *X = (vector_float_t*)lbm_get_custom_value(x);
214 28 vector_float_t *Y = (vector_float_t*)lbm_get_custom_value(y);
215
216
1/2
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
 28 if (X->size == Y->size) {
217 28 lbm_uint res_size = X->size;
218
219 28 float f_res = 0;
220
2/2
✓ Branch 0 taken 84 times.
✓ Branch 1 taken 28 times.
 112 for (unsigned i = 0; i < res_size; i ++) {
221 84 f_res += X->data[i] * Y->data[i];
222 }
223 28 res = lbm_enc_float(f_res);
224 }
225 }
226 28 return res;
227 }
228
229 56 static float vector_float_mag(vector_float_t *v) {
230 56 float mag = 0.0;
231
2/2
✓ Branch 0 taken 224 times.
✓ Branch 1 taken 56 times.
 280 for (unsigned int i = 0; i < v->size; i ++) {
232 224 mag += (v->data[i] * v->data[i]);
233 }
234 56 mag = sqrtf(mag);
235 56 return mag;
236 }
237
238 84 static lbm_value ext_mag(lbm_value *args, lbm_uint argn) {
239 84 lbm_value res = ENC_SYM_TERROR;
240
241
3/4
✓ Branch 0 taken 84 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 56 times.
✓ Branch 3 taken 28 times.
 168 if (argn == 1 &&
242 84 is_vector_float(args[0])) {
243 56 vector_float_t *v = (vector_float_t *)lbm_get_custom_value(args[0]);
244 56 float mag = vector_float_mag(v);
245 56 res = lbm_enc_float(mag);
246 }
247 84 return res;
248 }
249
250 28 static lbm_value ext_vmult(lbm_value *args, lbm_uint argn) {
251 28 lbm_value res = ENC_SYM_TERROR;
252
2/4
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 28 times.
✗ Branch 3 not taken.
 56 if (argn == 2 &&
253
1/2
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
 56 lbm_is_number(args[0]) &&
254 28 is_vector_float(args[1])) {
255
256 28 float alpha = lbm_dec_as_float(args[0]);
257 28 vector_float_t *x = (vector_float_t *)lbm_get_custom_value(args[1]);
258 28 lbm_value y = vector_float_allocate(x->size);
259 28 res = y;
260
1/2
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
 28 if (!lbm_is_error(y)) {
261 28 vector_float_t *y_vec = (vector_float_t *)lbm_get_custom_value(y);
262
2/2
✓ Branch 0 taken 84 times.
✓ Branch 1 taken 28 times.
 112 for (unsigned int i = 0; i < x->size; i ++) {
263 84 y_vec->data[i] = alpha * x->data[i];
264 }
265 }
266 }
267 28 return res;
268 }
269
270 28 static lbm_value ext_list_to_matrix(lbm_value *args, lbm_uint argn) {
271
272 28 lbm_value res = ENC_SYM_TERROR;
273
274
2/4
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 28 times.
✗ Branch 3 not taken.
 56 if (argn == 2 &&
275
1/2
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
 56 lbm_is_number(args[0]) &&
276 28 lbm_is_list(args[1])) {
277
278 28 bool nums = true;
279 28 unsigned int len = lbm_list_length_pred(args[1], &nums, lbm_is_number);
280
281
2/4
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 28 times.
✗ Branch 3 not taken.
 28 if (len > 0 && nums) {
282 28 uint32_t cols = lbm_dec_as_u32(args[0]);
283 28 uint32_t rows = len / cols;
284
285
1/2
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
 28 if (len % cols == 0) {
286 28 lbm_value mat = matrix_float_allocate(rows, cols);
287
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 28 times.
 28 if (lbm_is_error(mat)) return mat;
288 28 matrix_float_t *lmat = (matrix_float_t*)lbm_get_custom_value(mat);
289
290 28 lbm_value curr = args[1];
291 28 unsigned int i = 0;
292
2/2
✓ Branch 1 taken 252 times.
✓ Branch 2 taken 28 times.
 280 while (lbm_is_cons(curr)) {
293 252 lmat->data[i] = lbm_dec_as_float(lbm_car(curr));
294 252 i ++;
295 252 curr = lbm_cdr(curr);
296 }
297 28 res = mat;
298 }
299 }
300 }
301 28 return res;
302 }
303
304 28 static lbm_value ext_matrix_to_list(lbm_value *args, lbm_uint argn) {
305
306 28 lbm_value res = ENC_SYM_TERROR;
307
2/4
✓ Branch 0 taken 28 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 28 times.
✗ Branch 4 not taken.
 28 if (argn == 1 && is_matrix_float(args[0])) {
308 28 matrix_float_t *lmat = (matrix_float_t*)lbm_get_custom_value(args[0]);
309 28 lbm_uint size = lmat->rows * lmat->cols;
310
311 28 res = lbm_heap_allocate_list(size);
312
1/2
✓ Branch 1 taken 28 times.
✗ Branch 2 not taken.
 28 if (lbm_is_cons(res)) {
313 28 lbm_value curr = res;
314
2/2
✓ Branch 0 taken 252 times.
✓ Branch 1 taken 28 times.
 280 for (unsigned int i = 0; i < size; i ++) {
315 252 lbm_value f_val = lbm_enc_float(lmat->data[i]);
316
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 252 times.
 252 if (lbm_is_error(f_val)) {
317 ✗ res = f_val;
318 ✗ break;
319 }
320 252 lbm_set_car(curr, f_val);
321 252 curr = lbm_cdr(curr);
322 }
323 }
324 }
325 28 return res;
326 }
327
328
329
330 /* **************************************************
331 * Initialization
332 */
333
334 21504 void lbm_matvec_extensions_init(void) {
335 // Vectors
336 21504 lbm_add_extension("vector", ext_vector);
337 21504 lbm_add_extension("list-to-vector", ext_list_to_vector);
338 21504 lbm_add_extension("vector-to-list", ext_vector_to_list);
339 21504 lbm_add_extension("vproj", ext_vproj);
340 21504 lbm_add_extension("axpy", ext_axpy);
341 21504 lbm_add_extension("dot", ext_dot);
342 21504 lbm_add_extension("mag", ext_mag);
343 21504 lbm_add_extension("vmult", ext_vmult);
344
345 // Matrices
346 21504 lbm_add_extension("list-to-matrix", ext_list_to_matrix);
347 21504 lbm_add_extension("matrix-to-list", ext_matrix_to_list);
348 21504 }
349
350