/* Copyright 2003-2004,2006,2008-2018,2020 Free Software Foundation, Inc. This file is part of Guile. Guile is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. Guile is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with Guile. If not, see . */ #ifdef HAVE_CONFIG_H # include #endif #include #include #include #define SCM_BUILDING_DEPRECATED_CODE #include "boolean.h" #include "bitvectors.h" #include "deprecation.h" #include "gc.h" #include "gsubr.h" #include "strings.h" #include "deprecated.h" #if (SCM_ENABLE_DEPRECATED == 1) #ifndef MAXPATHLEN #define MAXPATHLEN 80 #endif /* ndef MAXPATHLEN */ #ifndef X_OK #define X_OK 1 #endif /* ndef X_OK */ char * scm_find_executable (const char *name) { char tbuf[MAXPATHLEN]; int i = 0, c; FILE *f; scm_c_issue_deprecation_warning ("scm_find_executable is deprecated."); /* fprintf(stderr, "s_f_e checking access %s ->%d\n", name, access(name, X_OK)); fflush(stderr); */ if (access (name, X_OK)) return 0L; f = fopen (name, "r"); if (!f) return 0L; if ((fgetc (f) == '#') && (fgetc (f) == '!')) { while (1) switch (c = fgetc (f)) { case /*WHITE_SPACES */ ' ': case '\t': case '\r': case '\f': case EOF: tbuf[i] = 0; fclose (f); return strdup (tbuf); default: tbuf[i++] = c; break; } } fclose (f); return strdup (name); } SCM_DEFINE (scm_bit_count, "bit-count", 2, 0, 0, (SCM b, SCM bitvector), "Return the number of occurrences of the boolean @var{b} in\n" "@var{bitvector}.") #define FUNC_NAME s_scm_bit_count { int bit = scm_to_bool (b); size_t count = 0, len; scm_c_issue_deprecation_warning ("bit-count is deprecated. Use bitvector-count, or a loop over array-ref " "if array support is needed."); if (scm_is_true (scm_bitvector_p (bitvector))) { len = scm_to_size_t (scm_bitvector_length (bitvector)); count = scm_to_size_t (scm_bitvector_count (bitvector)); } else { scm_t_array_handle handle; size_t off; ssize_t inc; scm_bitvector_elements (bitvector, &handle, &off, &len, &inc); for (size_t i = 0; i < len; i++) if (scm_is_true (scm_array_handle_ref (&handle, i*inc))) count++; scm_array_handle_release (&handle); } return scm_from_size_t (bit ? count : len-count); } #undef FUNC_NAME SCM_DEFINE (scm_bit_position, "bit-position", 3, 0, 0, (SCM item, SCM v, SCM k), "Return the index of the first occurrence of @var{item} in bit\n" "vector @var{v}, starting from @var{k}. If there is no\n" "@var{item} entry between @var{k} and the end of\n" "@var{v}, then return @code{#f}. For example,\n" "\n" "@example\n" "(bit-position #t #*000101 0) @result{} 3\n" "(bit-position #f #*0001111 3) @result{} #f\n" "@end example") #define FUNC_NAME s_scm_bit_position { scm_c_issue_deprecation_warning ("bit-position is deprecated. Use bitvector-position, or " "array-ref in a loop if you need generic arrays instead."); if (scm_is_true (scm_bitvector_p (v))) return scm_bitvector_position (v, item, k); scm_t_array_handle handle; size_t off, len; ssize_t inc; scm_bitvector_elements (v, &handle, &off, &len, &inc); int bit = scm_to_bool (item); size_t first_bit = scm_to_unsigned_integer (k, 0, len); SCM res = SCM_BOOL_F; for (size_t i = first_bit; i < len; i++) { SCM elt = scm_array_handle_ref (&handle, i*inc); if ((bit && scm_is_true (elt)) || (!bit && scm_is_false (elt))) { res = scm_from_size_t (i); break; } } scm_array_handle_release (&handle); return res; } #undef FUNC_NAME SCM scm_istr2bve (SCM str) { scm_t_array_handle handle; size_t len = scm_i_string_length (str); SCM vec = scm_c_make_bitvector (len, SCM_UNDEFINED); SCM res = vec; uint32_t mask; size_t k, j; const char *c_str; uint32_t *data; scm_c_issue_deprecation_warning ("scm_istr2bve is deprecated. " "Read from a string instead, prefixed with `#*'."); data = scm_bitvector_writable_elements (vec, &handle, NULL, NULL, NULL); c_str = scm_i_string_chars (str); for (k = 0; k < (len + 31) / 32; k++) { data[k] = 0L; j = len - k * 32; if (j > 32) j = 32; for (mask = 1L; j--; mask <<= 1) switch (*c_str++) { case '0': break; case '1': data[k] |= mask; break; default: res = SCM_BOOL_F; goto exit; } } exit: scm_array_handle_release (&handle); scm_remember_upto_here_1 (str); return res; } void scm_i_init_deprecated () { #include "deprecated.x" } #endif /* SCM_ENABLE_DEPRECATD == 1 */