static SCM scm_elev_scm_spline (const char *who, void elev_scm_spline (size_t new_degree, size_t degree, ssize_t stride, const SCM *spline, ssize_t result_stride, SCM *result), SCM new_degree, SCM spline) { scm_t_array_handle handle; scm_t_array_handle handle2; scm_dynwind_begin (0); const size_t _new_degree = scm_to_size_t (new_degree); scm_array_get_handle (spline, &handle); scm_dynwind_array_handle_release (&handle); assert_c_rank_1_or_2_array (who, spline, &handle); size_t dim; ssize_t stride; scm_array_handle_get_vector_dim_and_stride (who, spline, &handle, &dim, &stride); const SCM *_spline = scm_array_handle_elements (&handle); if (_new_degree < dim - 1) the_new_degree_is_not_an_elevation (who, new_degree, scm_from_size_t (dim - 1), spline); SCM result = scm_make_array (SCM_UNSPECIFIED, scm_list_1 (scm_oneplus (new_degree))); scm_array_get_handle (result, &handle2); scm_dynwind_array_handle_release (&handle2); SCM *_result = scm_array_handle_writable_elements (&handle2); elev_scm_spline (_new_degree, dim - 1, stride, _spline, 1, _result); scm_dynwind_end (); return result; }
static double *material_grid_array(const material_grid *g) { #ifdef HAVE_SCM_ARRAY_GET_HANDLE scm_array_get_handle(g->matgrid, &cur_material_grid_array_handle); return (double *) scm_array_handle_uniform_writable_elements( &cur_material_grid_array_handle); #else CHECK(SCM_ARRAYP(g->matgrid), "bug: matgrid is not an array"); return (double *) SCM_CELL_WORD_1(SCM_ARRAY_V(g->matgrid)); #endif }
static int rafill (SCM dst, SCM fill) { scm_t_array_handle h; size_t n, i; ssize_t inc; scm_array_get_handle (SCM_I_ARRAY_V (dst), &h); i = SCM_I_ARRAY_BASE (dst); inc = SCM_I_ARRAY_DIMS (dst)->inc; n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1); dst = SCM_I_ARRAY_V (dst); for (; n-- > 0; i += inc) h.vset (h.vector, i, fill); scm_array_handle_release (&h); return 1; }
SCM dijkstra(SCM scm_weights, SCM scm_start, SCM scm_cut_corners_p) { int row = scm_to_int(SCM_CAR(scm_start)); int col = scm_to_int(SCM_CAR(SCM_CDR(scm_start))); SCM dimensions = scm_array_dimensions(scm_weights); int rows = scm_to_int(SCM_CAR(dimensions)); int cols = scm_to_int(SCM_CAR(SCM_CDR(dimensions))); int cut_corners_p = scm_to_bool(scm_cut_corners_p); int * weights = calloc(rows * cols, sizeof(int *)); WeightedPoint ** weighted_paths = calloc(rows, sizeof(WeightedPoint *)); scm_t_array_handle weights_handle; scm_array_get_handle(scm_weights, &weights_handle); int i_row, i_col; for(i_row = 0; i_row < rows; i_row++) { weighted_paths[i_row] = calloc(cols, sizeof(WeightedPoint)); for(i_col = 0; i_col < cols; i_col++) { ssize_t pos = scm_array_handle_pos(&weights_handle, scm_list_2(scm_from_int(i_row), scm_from_int(i_col))); weights[i_row * cols + i_col] = scm_to_int(scm_array_handle_ref(&weights_handle, pos)); } } scm_array_handle_release(&weights_handle); find_paths(weighted_paths, (Point){col, row}, cut_corners_p, weights, rows, cols); SCM scm_paths = scm_make_array(scm_from_int(0), dimensions); for(i_row = 0; i_row < rows; i_row++) { for(i_col = 0; i_col < cols; i_col++) { scm_array_set_x(scm_paths, scm_list_2(scm_from_int(weighted_paths[i_row][i_col].prev.y), scm_from_int(weighted_paths[i_row][i_col] .prev.x)), scm_list_2(scm_from_int(i_row), scm_from_int(i_col))); } free(weighted_paths[i_row]); } free(weighted_paths); free(weights); return scm_paths; }
const SCM * scm_vector_elements (SCM vec, scm_t_array_handle *h, size_t *lenp, ssize_t *incp) { /* it's unsafe to access the memory of a weak vector */ if (SCM_I_WVECTP (vec)) scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector"); scm_array_get_handle (vec, h); if (1 != scm_array_handle_rank (h)) { scm_array_handle_release (h); scm_wrong_type_arg_msg (NULL, 0, vec, "rank 1 array of Scheme values"); } if (lenp) { scm_t_array_dim *dim = scm_array_handle_dims (h); *lenp = dim->ubnd - dim->lbnd + 1; *incp = dim->inc; } return scm_array_handle_elements (h); }