X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/0c95b57d77efbe82bb0ade78df5d78d6d0f2a641..9bc6fb0a7d91ae9a6c57cedb76022043db413ba5:/libguile/gh_data.c

diff --git a/libguile/gh_data.c b/libguile/gh_data.c
index ffa5b288d..31c9ea730 100644
--- a/libguile/gh_data.c
+++ b/libguile/gh_data.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998, 1999 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 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)
@@ -41,16 +41,13 @@
 
 /* data initialization and C<->Scheme data conversion */
 
-#include <stdio.h>
-
-#include <gh.h>
+#include "libguile/gh.h"
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
 
 /* data conversion C->scheme */
-SCM 
-gh_int2scmb (int x)		/* this is being phased out */
-{
-  return SCM_BOOL(x);
-}
+
 SCM 
 gh_bool2scm (int x)
 {
@@ -74,17 +71,17 @@ gh_long2scm (long x)
 SCM 
 gh_double2scm (double x)
 {
-  return scm_makdbl (x, 0.0);
+  return scm_make_real (x);
 }
 SCM 
 gh_char2scm (char c)
 {
- return SCM_MAKICHR (c);
+ return SCM_MAKE_CHAR (c);
 }
 SCM 
-gh_str2scm (char *s, int len)
+gh_str2scm (const char *s, size_t len)
 {
-  return scm_makfromstr (s, len, 0);
+  return scm_mem2string (s, len);
 }
 SCM 
 gh_str02scm (const char *s)
@@ -98,57 +95,50 @@ gh_str02scm (const char *s)
    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)
+gh_set_substr (char *src, SCM dst, long start, size_t len)
 {
   char *dst_ptr;
-  unsigned long dst_len;
-  unsigned long effective_length;
+  size_t dst_len;
 
-  SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3,
-	      "gh_set_substr");
+  SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3, "gh_set_substr");
 
-  dst_ptr = SCM_CHARS (dst);
-  dst_len = SCM_LENGTH (dst);
-  SCM_ASSERT (len >= 0 && (unsigned) len <= dst_len,
-	      dst, SCM_ARG4, "gh_set_substr");
+  dst_ptr = SCM_STRING_CHARS (dst);
+  dst_len = SCM_STRING_LENGTH (dst);
+  SCM_ASSERT (start + len <= dst_len, dst, SCM_ARG4, "gh_set_substr");
   
-  scm_protect_object (dst);
-  effective_length = ((unsigned) len < dst_len) ? len : dst_len;
-  memmove (dst_ptr + start, src, effective_length);
-  scm_unprotect_object (dst);
+  memmove (dst_ptr + start, src, len);
+  scm_remember_upto_here_1 (dst);
 }
 
 /* Return the symbol named SYMBOL_STR.  */
 SCM 
 gh_symbol2scm (const char *symbol_str)
 {
-  return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str)));
+  return scm_str2symbol(symbol_str);
 }
 
 SCM
-gh_ints2scm (int *d, int n)
+gh_ints2scm (const int *d, long n)
 {
-  int i;
-  SCM v = scm_make_vector(SCM_MAKINUM(n), SCM_UNSPECIFIED);
+  long i;
+  SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
   SCM *velts = SCM_VELTS(v);
 
   for (i = 0; i < n; ++i)
-    velts[i] = (d[i] >= SCM_MOST_NEGATIVE_FIXNUM
-		&& d[i] <= SCM_MOST_POSITIVE_FIXNUM
-		? SCM_MAKINUM (d[i])
-		: scm_long2big (d[i]));
+    velts[i] = (SCM_FIXABLE (d[i]) ? SCM_MAKINUM (d[i]) : scm_i_long2big (d[i]));
+
   return v;
 }
 
 SCM
-gh_doubles2scm (double *d, int n)
+gh_doubles2scm (const double *d, long n)
 {
-  int i;
-  SCM v = scm_make_vector(SCM_MAKINUM(n), SCM_UNSPECIFIED);
+  long i;
+  SCM v = scm_c_make_vector (n, SCM_UNSPECIFIED);
   SCM *velts = SCM_VELTS(v);
 
   for(i = 0; i < n; i++) 
-    velts[i] = scm_makdbl(d[i], 0.0);
+    velts[i] = scm_make_real (d[i]);
   return v;
 }
 
@@ -157,91 +147,80 @@ gh_doubles2scm (double *d, int n)
    you arrange for the elements to be protected from GC while you
    initialize the vector.  */
 static SCM
-makvect (char* m, int len, int type)
+makvect (char *m, size_t len, int type)
 {
-  SCM ans;
-  SCM_NEWCELL (ans);
-  SCM_DEFER_INTS;
-  SCM_SETCHARS (ans, m);
-  SCM_SETLENGTH (ans, len, type);
-  SCM_ALLOW_INTS;
-  return ans;
+  return scm_cell (SCM_MAKE_UVECTOR_TAG (len, type), (scm_t_bits) m);
 }
 
 SCM
-gh_chars2byvect (char *d, int n)
+gh_chars2byvect (const char *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (char), "vector");
+  char *m = scm_gc_malloc (n * sizeof (char), "vector");
   memcpy (m, d, n * sizeof (char));
   return makvect (m, n, scm_tc7_byvect);
 }
 
 SCM
-gh_shorts2svect (short *d, int n)
+gh_shorts2svect (const short *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (short), "vector");
+  char *m = scm_gc_malloc (n * sizeof (short), "vector");
   memcpy (m, d, n * sizeof (short));
   return makvect (m, n, scm_tc7_svect);
 }
 
 SCM
-gh_longs2ivect (long *d, int n)
+gh_longs2ivect (const long *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (long), "vector");
+  char *m = scm_gc_malloc (n * sizeof (long), "vector");
   memcpy (m, d, n * sizeof (long));
   return makvect (m, n, scm_tc7_ivect);
 }
 
 SCM
-gh_ulongs2uvect (unsigned long *d, int n)
+gh_ulongs2uvect (const unsigned long *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (unsigned long), "vector");
+  char *m = scm_gc_malloc (n * sizeof (unsigned long), "vector");
   memcpy (m, d, n * sizeof (unsigned long));
   return makvect (m, n, scm_tc7_uvect);
 }
 
-#ifdef SCM_FLOATS
-#ifdef SCM_SINGLES
 SCM
-gh_floats2fvect (float *d, int n)
+gh_floats2fvect (const float *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (float), "vector");
+  char *m = scm_gc_malloc (n * sizeof (float), "vector");
   memcpy (m, d, n * sizeof (float));
   return makvect (m, n, scm_tc7_fvect);
 }
-#endif
 
 SCM
-gh_doubles2dvect (double *d, int n)
+gh_doubles2dvect (const double *d, long n)
 {
-  char *m = scm_must_malloc (n * sizeof (double), "vector");
+  char *m = scm_gc_malloc (n * sizeof (double), "vector");
   memcpy (m, d, n * sizeof (double));
   return makvect (m, n, scm_tc7_dvect);
 }
 #endif
-#endif
 
 /* data conversion scheme->C */
 int 
 gh_scm2bool (SCM obj)
 {
-  return ((obj) == SCM_BOOL_F) ? 0 : 1;
+  return (SCM_FALSEP (obj)) ? 0 : 1;
 }
 unsigned long 
 gh_scm2ulong (SCM obj)
 {
-  return scm_num2ulong (obj, (char *) SCM_ARG1, "gh_scm2ulong");
+  return scm_num2ulong (obj, SCM_ARG1, "gh_scm2ulong");
 }
 long 
 gh_scm2long (SCM obj)
 {
-  return scm_num2long (obj, (char *) SCM_ARG1, "gh_scm2long");
+  return scm_num2long (obj, 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");
+  return (int) scm_num2int (obj, SCM_ARG1, "gh_scm2int");
 }
 double 
 gh_scm2double (SCM obj)
@@ -250,26 +229,29 @@ gh_scm2double (SCM obj)
 }
 char 
 gh_scm2char (SCM obj)
+#define FUNC_NAME "gh_scm2char"
 {
-  return SCM_ICHR (obj);
+  SCM_VALIDATE_CHAR (SCM_ARG1, obj);
+  return SCM_CHAR (obj);
 }
+#undef FUNC_NAME
 
 /* Convert a vector, weak vector, string, substring or uniform vector
    into an array of chars.  If result array in arg 2 is NULL, malloc a
-   new one. */
+   new one.  If out of memory, return NULL.  */
 char *
 gh_scm2chars (SCM obj, char *m)
 {
-  int i, n;
+  long i, n;
   long v;
   SCM val;
-  if (!SCM_NIMP (obj))
+  if (SCM_IMP (obj))
     scm_wrong_type_arg (0, 0, obj);
   switch (SCM_TYP7 (obj))
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
@@ -284,17 +266,27 @@ gh_scm2chars (SCM obj, char *m)
 	}
       if (m == 0)
 	m = (char *) malloc (n * sizeof (char));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
       break;
 #ifdef HAVE_ARRAYS
     case scm_tc7_byvect:
+      n = SCM_UVECTOR_LENGTH (obj);
+      if (m == 0)
+	m = (char *) malloc (n * sizeof (char));
+      if (m == NULL)
+	return NULL;
+      memcpy (m, SCM_VELTS (obj), n * sizeof (char));
+      break;
 #endif
     case scm_tc7_string:
-    case scm_tc7_substring:
-      n = SCM_LENGTH (obj);
+      n = SCM_STRING_LENGTH (obj);
       if (m == 0)
 	m = (char *) malloc (n * sizeof (char));
+      if (m == NULL)
+	return NULL;
       memcpy (m, SCM_VELTS (obj), n * sizeof (char));
       break;
     default:
@@ -304,20 +296,21 @@ gh_scm2chars (SCM obj, char *m)
 }
 
 /* Convert a vector, weak vector or uniform vector into an array of
-   shorts.  If result array in arg 2 is NULL, malloc a new one. */
+   shorts.  If result array in arg 2 is NULL, malloc a new one.  If
+   out of memory, return NULL.  */
 short *
 gh_scm2shorts (SCM obj, short *m)
 {
-  int i, n;
+  long i, n;
   long v;
   SCM val;
-  if (!SCM_NIMP (obj))
+  if (SCM_IMP (obj))
     scm_wrong_type_arg (0, 0, obj);
   switch (SCM_TYP7 (obj))
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
@@ -332,14 +325,18 @@ gh_scm2shorts (SCM obj, short *m)
 	}
       if (m == 0)
 	m = (short *) malloc (n * sizeof (short));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
       break;
 #ifdef HAVE_ARRAYS
     case scm_tc7_svect:
-      n = SCM_LENGTH (obj);
+      n = SCM_UVECTOR_LENGTH (obj);
       if (m == 0)
 	m = (short *) malloc (n * sizeof (short));
+      if (m == NULL)
+	return NULL;
       memcpy (m, SCM_VELTS (obj), n * sizeof (short));
       break;
 #endif
@@ -350,19 +347,20 @@ gh_scm2shorts (SCM obj, short *m)
 }
 
 /* Convert a vector, weak vector or uniform vector into an array of
-   longs.  If result array in arg 2 is NULL, malloc a new one. */
+   longs.  If result array in arg 2 is NULL, malloc a new one.  If out
+   of memory, return NULL.  */
 long *
 gh_scm2longs (SCM obj, long *m)
 {
-  int i, n;
+  long i, n;
   SCM val;
-  if (!SCM_NIMP (obj))
+  if (SCM_IMP (obj))
     scm_wrong_type_arg (0, 0, obj);
   switch (SCM_TYP7 (obj))
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
@@ -371,18 +369,24 @@ gh_scm2longs (SCM obj, long *m)
 	}
       if (m == 0)
 	m = (long *) malloc (n * sizeof (long));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
-	  m[i] = SCM_INUMP (val) ? SCM_INUM (val) : scm_num2long (val, 0, 0);
+	  m[i] = SCM_INUMP (val) 
+	    ? SCM_INUM (val) 
+	    : scm_num2long (val, 0, NULL);
 	}
       break;
 #ifdef HAVE_ARRAYS
     case scm_tc7_ivect:
     case scm_tc7_uvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_UVECTOR_LENGTH (obj);
       if (m == 0)
 	m = (long *) malloc (n * sizeof (long));
+      if (m == NULL)
+	return NULL;
       memcpy (m, SCM_VELTS (obj), n * sizeof (long));
       break;
 #endif
@@ -393,19 +397,20 @@ gh_scm2longs (SCM obj, long *m)
 }
 
 /* Convert a vector, weak vector or uniform vector into an array of
-   floats.  If result array in arg 2 is NULL, malloc a new one. */
+   floats.  If result array in arg 2 is NULL, malloc a new one.  If
+   out of memory, return NULL.  */
 float *
 gh_scm2floats (SCM obj, float *m)
 {
-  int i, n;
+  long i, n;
   SCM val;
-  if (!SCM_NIMP (obj))
+  if (SCM_IMP (obj))
     scm_wrong_type_arg (0, 0, obj);
   switch (SCM_TYP7 (obj))
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
@@ -415,35 +420,38 @@ gh_scm2floats (SCM obj, float *m)
 	}
       if (m == 0)
 	m = (float *) malloc (n * sizeof (float));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
 	  if (SCM_INUMP (val))
 	    m[i] = SCM_INUM (val);
 	  else if (SCM_BIGP (val))
-	    m[i] = scm_num2long (val, 0, 0);
+	    m[i] = scm_num2long (val, 0, NULL);
 	  else
-	    m[i] = SCM_REALPART (val);
+	    m[i] = SCM_REAL_VALUE (val);
 	}
       break;
 #ifdef HAVE_ARRAYS
-#ifdef SCM_FLOATS
-#ifdef SCM_SINGLES
     case scm_tc7_fvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_UVECTOR_LENGTH (obj);
       if (m == 0)
 	m = (float *) malloc (n * sizeof (float));
+      if (m == NULL)
+	return NULL;
       memcpy (m, (float *) SCM_VELTS (obj), n * sizeof (float));
       break;
-#endif
+
     case scm_tc7_dvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_UVECTOR_LENGTH (obj);
       if (m == 0)
 	m = (float*) malloc (n * sizeof (float));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	m[i] = ((double *) SCM_VELTS (obj))[i];
       break;
-#endif
 #endif
     default:
       scm_wrong_type_arg (0, 0, obj);
@@ -452,19 +460,20 @@ gh_scm2floats (SCM obj, float *m)
 }
 
 /* Convert a vector, weak vector or uniform vector into an array of
-   doubles.  If result array in arg 2 is NULL, malloc a new one. */
+   doubles.  If result array in arg 2 is NULL, malloc a new one.  If
+   out of memory, return NULL.  */
 double *
 gh_scm2doubles (SCM obj, double *m)
 {
-  int i, n;
+  long i, n;
   SCM val;
-  if (!SCM_NIMP (obj))
+  if (SCM_IMP (obj))
     scm_wrong_type_arg (0, 0, obj);
   switch (SCM_TYP7 (obj))
     {
     case scm_tc7_vector:
     case scm_tc7_wvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_VECTOR_LENGTH (obj);
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
@@ -474,35 +483,38 @@ gh_scm2doubles (SCM obj, double *m)
 	}
       if (m == 0)
 	m = (double *) malloc (n * sizeof (double));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	{
 	  val = SCM_VELTS (obj)[i];
 	  if (SCM_INUMP (val))
 	    m[i] = SCM_INUM (val);
 	  else if (SCM_BIGP (val))
-	    m[i] = scm_num2long (val, 0, 0);
+	    m[i] = scm_num2long (val, 0, NULL);
 	  else
-	    m[i] = SCM_REALPART (val);
+	    m[i] = SCM_REAL_VALUE (val);
 	}
       break;
 #ifdef HAVE_ARRAYS
-#ifdef SCM_FLOATS
-#ifdef SCM_SINGLES
     case scm_tc7_fvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_UVECTOR_LENGTH (obj);
       if (m == 0)
 	m = (double *) malloc (n * sizeof (double));
+      if (m == NULL)
+	return NULL;
       for (i = 0; i < n; ++i)
 	m[i] = ((float *) SCM_VELTS (obj))[i];
       break;
-#endif
+
     case scm_tc7_dvect:
-      n = SCM_LENGTH (obj);
+      n = SCM_UVECTOR_LENGTH (obj);
       if (m == 0)
 	m = (double*) malloc (n * sizeof (double));
+      if (m == NULL)
+	return NULL;
       memcpy (m, SCM_VELTS (obj), n * sizeof (double));
       break;
-#endif
 #endif
     default:
       scm_wrong_type_arg (0, 0, obj);
@@ -517,7 +529,8 @@ gh_scm2doubles (SCM obj, double *m)
    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.
+   caller is responsible for freeing it.  If out of memory, NULL is
+   returned.
 
    Note that Scheme strings may contain arbitrary data, including null
    characters.  This means that null termination is not a reliable way
@@ -525,28 +538,24 @@ gh_scm2doubles (SCM obj, double *m)
    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)
+gh_scm2newstr (SCM str, size_t *lenp)
 {
   char *ret_str;
-  int len;
-
-  SCM_ASSERT (SCM_ROSTRINGP (str), str, SCM_ARG3,
-	      "gh_scm2newstr");
+  size_t len;
 
-  /* protect str from GC while we copy off its data */
-  scm_protect_object (str);
+  SCM_ASSERT (SCM_STRINGP (str), str, SCM_ARG3, "gh_scm2newstr");
 
-  len = SCM_LENGTH (str);
+  len = SCM_STRING_LENGTH (str);
 
-  ret_str = (char *) scm_must_malloc ((len + 1) * sizeof (char),
-				      "gh_scm2newstr");
+  ret_str = (char *) malloc ((len + 1) * sizeof (char));
+  if (ret_str == NULL)
+    return NULL;
   /* so we copy tmp_str to ret_str, which is what we will allocate */
-  memcpy (ret_str, SCM_ROCHARS (str), len);	/* test ROCHARS here -twp */
+  memcpy (ret_str, SCM_STRING_CHARS (str), len);
+  scm_remember_upto_here_1 (str);
   /* now make sure we null-terminate it */
   ret_str[len] = '\0';
 
-  scm_unprotect_object (str);
-
   if (lenp != NULL)
     {
       *lenp = len;
@@ -564,18 +573,16 @@ gh_scm2newstr (SCM str, int *lenp)
    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)
+gh_get_substr (SCM src, char *dst, long start, size_t len)
 {
-  int src_len, effective_length;
-  SCM_ASSERT (SCM_ROSTRINGP (src), src, SCM_ARG3,
-	      "gh_get_substr");
+  size_t src_len, effective_length;
+  SCM_ASSERT (SCM_STRINGP (src), src, SCM_ARG3, "gh_get_substr");
 
-  scm_protect_object (src);
-  src_len = SCM_LENGTH (src);
+  src_len = SCM_STRING_LENGTH (src);
   effective_length = (len < src_len) ? len : src_len;
-  memcpy (dst + start, SCM_ROCHARS (src), effective_length * sizeof (char));
+  memcpy (dst + start, SCM_STRING_CHARS (src), effective_length * sizeof (char));
   /* FIXME: must signal an error if len > src_len */
-  scm_unprotect_object (src);
+  scm_remember_upto_here_1 (src);
 }
 
 
@@ -585,30 +592,27 @@ gh_get_substr (SCM src, char *dst, int start, int len)
    string's length.
 
    This function uses malloc to obtain storage for the copy; the
-   caller is responsible for freeing it. */
+   caller is responsible for freeing it.  If out of memory, NULL is
+   returned.*/
 char *
-gh_symbol2newstr (SCM sym, int *lenp)
+gh_symbol2newstr (SCM sym, size_t *lenp)
 {
   char *ret_str;
-  int len;
+  size_t len;
 
-  SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3,
-	      "gh_scm2newsymbol");
+  SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3, "gh_scm2newsymbol");
 
-  /* protect str from GC while we copy off its data */
-  scm_protect_object (sym);
+  len = SCM_SYMBOL_LENGTH (sym);
 
-  len = SCM_LENGTH (sym);
-
-  ret_str = (char *) scm_must_malloc ((len + 1) * sizeof (char),
-				      "gh_symbol2newstr");
-  /* so we copy tmp_str to ret_str, which is what we will allocate */
-  memcpy (ret_str, SCM_CHARS (sym), len);
+  ret_str = (char *) malloc ((len + 1) * sizeof (char));
+  if (ret_str == NULL)
+    return NULL;
+  /* so we copy sym to ret_str, which is what we will allocate */
+  memcpy (ret_str, SCM_SYMBOL_CHARS (sym), len);
+  scm_remember_upto_here_1 (sym);
   /* now make sure we null-terminate it */
   ret_str[len] = '\0';
 
-  scm_unprotect_object (sym);
-
   if (lenp != NULL)
     {
       *lenp = len;
@@ -644,7 +648,7 @@ gh_vector_ref (SCM vec, SCM pos)
 unsigned long 
 gh_vector_length (SCM v)
 {
-  return gh_scm2ulong (scm_vector_length (v));
+  return (unsigned long) SCM_VECTOR_LENGTH (v);
 }
 
 #ifdef HAVE_ARRAYS
@@ -654,7 +658,7 @@ gh_vector_length (SCM v)
 unsigned long
 gh_uniform_vector_length (SCM v)
 {
-  return gh_scm2ulong (scm_uniform_vector_length (v));
+  return (unsigned long) SCM_UVECTOR_LENGTH (v);
 }
 
 /* gets the given element from a uniform vector; ilist is a list (or
@@ -679,23 +683,35 @@ gh_uniform_vector_ref (SCM v, SCM ilist)
    `vec' argument.
 
    The return value is the Scheme object to which SNAME is bound, or
-   SCM_UNDEFINED if SNAME is not bound in the given context. [FIXME:
-   should this be SCM_UNSPECIFIED?  Can a symbol ever legitimately be
-   bound to SCM_UNDEFINED or SCM_UNSPECIFIED?  What is the difference?
-   -twp] */
+   SCM_UNDEFINED if SNAME is not bound in the given context.
+ */
 
 SCM
-gh_lookup (char *sname)
+gh_lookup (const char *sname)
 {
-  return gh_module_lookup (SCM_BOOL_F, sname);
+  return gh_module_lookup (scm_current_module (), sname);
 }
 
+
 SCM
-gh_module_lookup (SCM vec, char *sname)
+gh_module_lookup (SCM module, const char *sname)
+#define FUNC_NAME "gh_module_lookup"
 {
-  SCM sym = gh_symbol2scm (sname);
-  if ((scm_symbol_bound_p (vec, sym)) == SCM_BOOL_T)
-    return scm_symbol_binding (vec, sym);
+  SCM sym, var;
+
+  SCM_VALIDATE_MODULE (SCM_ARG1, module);
+
+  sym = scm_str2symbol (sname);
+  var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+  if (var != SCM_BOOL_F)
+    return SCM_VARIABLE_REF (var);
   else
     return SCM_UNDEFINED;
 }
+#undef FUNC_NAME
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/