summaryrefslogtreecommitdiff
path: root/libguile/gh_data.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/gh_data.c')
-rw-r--r--libguile/gh_data.c286
1 files changed, 286 insertions, 0 deletions
diff --git a/libguile/gh_data.c b/libguile/gh_data.c
new file mode 100644
index 000000000..5992365c8
--- /dev/null
+++ b/libguile/gh_data.c
@@ -0,0 +1,286 @@
+/* Copyright (C) 1995,1996,1987 Free Software Foundation, Inc.
+
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING. If not, write to
+ * the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE. If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way. To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.
+ */
+
+
+/* data initialization and C<->Scheme data conversion */
+
+#include <stdio.h>
+
+#include <gh.h>
+
+/* data conversion C->scheme */
+SCM
+gh_int2scmb (int x)
+{
+ return (x ? SCM_BOOL_T : SCM_BOOL_F);
+}
+SCM
+gh_int2scm (int x)
+{
+ return scm_long2num ((long) x);
+}
+SCM
+gh_ulong2scm (unsigned long x)
+{
+ return scm_ulong2num (x);
+}
+SCM
+gh_long2scm (long x)
+{
+ return scm_long2num (x);
+}
+SCM
+gh_double2scm (double x)
+{
+ return scm_makdbl (x, 0.0);
+}
+SCM
+gh_char2scm (char c)
+{
+ return SCM_MAKICHR (c);
+}
+SCM
+gh_str2scm (char *s, int len)
+{
+ return scm_makfromstr (s, len, 0);
+}
+SCM
+gh_str02scm (char *s)
+{
+ return scm_makfrom0str (s);
+}
+/* Copy LEN characters at SRC into the *existing* Scheme string DST,
+ starting at START. START is an index into DST; zero means the
+ beginning of the string.
+
+ If START + LEN is off the end of DST, signal an out-of-range
+ error. */
+void
+gh_set_substr (char *src, SCM dst, int start, int len)
+{
+ char *dst_ptr, dst_len, effective_length;
+
+ SCM_ASSERT (SCM_NIMP (dst) && SCM_STRINGP (dst), dst, SCM_ARG3,
+ "gh_set_substr");
+ scm_protect_object (dst);
+ dst_ptr = SCM_CHARS (dst);
+ dst_len = SCM_LENGTH (dst);
+ effective_length = (len < dst_len) ? len : dst_len;
+ memcpy (dst_ptr + start, src, effective_length);
+ /* FIXME: must signal an error if len > dst_len */
+ scm_unprotect_object (dst);
+}
+
+/* Return the symbol named SYMBOL_STR. */
+SCM
+gh_symbol2scm (char *symbol_str)
+{
+ return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str)));
+}
+
+
+/* data conversion scheme->C */
+int
+gh_scm2bool (SCM obj)
+{
+ return ((obj) == SCM_BOOL_F) ? 0 : 1;
+}
+unsigned long
+gh_scm2ulong (SCM obj)
+{
+ return scm_num2ulong (obj, (char *) SCM_ARG1, "gh_scm2ulong");
+}
+long
+gh_scm2long (SCM obj)
+{
+ return scm_num2long (obj, (char *) SCM_ARG1, "gh_scm2long");
+}
+int
+gh_scm2int (SCM obj)
+{
+ /* NOTE: possible loss of precision here */
+ return (int) scm_num2long (obj, (char *) SCM_ARG1, "gh_scm2int");
+}
+double
+gh_scm2double (SCM obj)
+{
+ return scm_num2dbl (obj, "gh_scm2double");
+}
+char
+gh_scm2char (SCM obj)
+{
+ return SCM_ICHR (obj);
+}
+
+/* string conversions between C and Scheme */
+
+/* gh_scm2newstr() -- Given a Scheme string STR, return a pointer to a
+ new copy of its contents, followed by a null byte. If lenp is
+ non-null, set *lenp to the string's length.
+
+ This function uses malloc to obtain storage for the copy; the
+ caller is responsible for freeing it.
+
+ Note that Scheme strings may contain arbitrary data, including null
+ characters. This means that null termination is not a reliable way
+ to determine the length of the returned value. However, the
+ function always copies the complete contents of STR, and sets
+ *LEN_P to the true length of the string (when LEN_P is non-null). */
+char *
+gh_scm2newstr (SCM str, int *lenp)
+{
+ char *ret_str;
+ int len;
+
+ SCM_ASSERT (SCM_NIMP (str) && SCM_STRINGP (str), str, SCM_ARG3,
+ "gh_scm2newstr");
+
+ /* protect str from GC while we copy off its data */
+ scm_protect_object (str);
+
+ len = SCM_LENGTH (str);
+
+ ret_str = (char *) malloc ((len + 1) * sizeof (char));
+ /* so we copy tmp_str to ret_str, which is what we will allocate */
+ memcpy (ret_str, SCM_CHARS (str), len);
+ /* now make sure we null-terminate it */
+ ret_str[len] = '\0';
+
+ scm_unprotect_object (str);
+
+ if (lenp != NULL)
+ {
+ *lenp = len;
+ }
+
+ return ret_str;
+}
+
+
+/* Copy LEN characters at START from the Scheme string SRC to memory
+ at DST. START is an index into SRC; zero means the beginning of
+ the string. DST has already been allocated by the caller.
+
+ If START + LEN is off the end of SRC, silently truncate the source
+ region to fit the string. If truncation occurs, the corresponding
+ area of DST is left unchanged. */
+void
+gh_get_substr (SCM src, char *dst, int start, int len)
+{
+ int src_len, effective_length;
+ SCM_ASSERT (SCM_NIMP (src) && SCM_STRINGP (src), src, SCM_ARG3,
+ "gh_get_substr");
+
+ scm_protect_object (src);
+ src_len = SCM_LENGTH (src);
+ effective_length = (len < src_len) ? len : src_len;
+ memcpy (dst + start, SCM_CHARS (src), effective_length * sizeof (char));
+ /* FIXME: must signal an error if len > src_len */
+ scm_unprotect_object (src);
+}
+
+
+/* gh_scm2newsymbol() -- Given a Scheme symbol 'identifier, return a
+ pointer to a string with the symbol characters "identifier",
+ followed by a null byte. If lenp is non-null, set *lenp to the
+ string's length.
+
+ This function uses malloc to obtain storage for the copy; the
+ caller is responsible for freeing it. */
+char *
+gh_symbol2newstr (SCM sym, int *lenp)
+{
+ char *ret_str;
+ int len;
+
+ SCM_ASSERT (SCM_NIMP (sym) && SCM_SYMBOLP (sym), sym, SCM_ARG3,
+ "gh_scm2newsymbol");
+
+ /* protect str from GC while we copy off its data */
+ scm_protect_object (sym);
+
+ len = SCM_LENGTH (sym);
+
+ ret_str = (char *) malloc ((len + 1) * sizeof (char));
+ /* so we copy tmp_str to ret_str, which is what we will allocate */
+ memcpy (ret_str, SCM_CHARS (sym), len);
+ /* now make sure we null-terminate it */
+ ret_str[len] = '\0';
+
+ scm_unprotect_object (sym);
+
+ if (lenp != NULL)
+ {
+ *lenp = len;
+ }
+
+ return ret_str;
+}
+
+
+/* create a new vector of the given length, all initialized to the
+ given value */
+SCM
+gh_vector (SCM length, SCM val)
+{
+ return scm_make_vector (length, val, SCM_UNDEFINED);
+}
+
+/* set the given element of the given vector to the given value */
+SCM
+gh_vset (SCM vec, SCM pos, SCM val)
+{
+ return scm_vector_set_x (vec, pos, val);
+}
+
+/* retrieve the given element of the given vector */
+SCM
+gh_vref (SCM vec, SCM pos)
+{
+ return scm_vector_ref (vec, pos);
+}
+
+/* returns the length of the given vector */
+unsigned long
+gh_vector_length (SCM v)
+{
+ return gh_scm2ulong (scm_vector_length (v));
+}