libguile/gh_data.c

   1 /* Copyright (C) 1995,1996,1997,1998, 1999, 2000 Free Software Foundation, Inc.
   2  * This program is free software; you can redistribute it and/or modify
   3  * it under the terms of the GNU General Public License as published by
   4  * the Free Software Foundation; either version 2, or (at your option)
   5  * any later version.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this software; see the file COPYING.  If not, write to
  14  * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  15  * Boston, MA 02111-1307 USA
  16  *
  17  * As a special exception, the Free Software Foundation gives permission
  18  * for additional uses of the text contained in its release of GUILE.
  19  *
  20  * The exception is that, if you link the GUILE library with other files
  21  * to produce an executable, this does not by itself cause the
  22  * resulting executable to be covered by the GNU General Public License.
  23  * Your use of that executable is in no way restricted on account of
  24  * linking the GUILE library code into it.
  25  *
  26  * This exception does not however invalidate any other reasons why
  27  * the executable file might be covered by the GNU General Public License.
  28  *
  29  * This exception applies only to the code released by the
  30  * Free Software Foundation under the name GUILE.  If you copy
  31  * code from other Free Software Foundation releases into a copy of
  32  * GUILE, as the General Public License permits, the exception does
  33  * not apply to the code that you add in this way.  To avoid misleading
  34  * anyone as to the status of such modified files, you must delete
  35  * this exception notice from them.
  36  *
  37  * If you write modifications of your own for GUILE, it is your choice
  38  * whether to permit this exception to apply to your modifications.
  39  * If you do not wish that, delete this exception notice.  */
  40 \f
  41
  42 /* data initialization and C<->Scheme data conversion */
  43
  44 #include <stdio.h>
  45
  46 #include "libguile/gh.h"
  47 #ifdef HAVE_STRING_H
  48 #include <string.h>
  49 #endif
  50
  51 /* data conversion C->scheme */
  52 SCM
  53 gh_int2scmb (int x)             /* this is being phased out */
  54 {
  55   return SCM_BOOL(x);
  56 }
  57 SCM
  58 gh_bool2scm (int x)
  59 {
  60   return SCM_BOOL(x);
  61 }
  62 SCM
  63 gh_int2scm (int x)
  64 {
  65   return scm_long2num ((long) x);
  66 }
  67 SCM
  68 gh_ulong2scm (unsigned long x)
  69 {
  70   return scm_ulong2num (x);
  71 }
  72 SCM
  73 gh_long2scm (long x)
  74 {
  75   return scm_long2num (x);
  76 }
  77 SCM
  78 gh_double2scm (double x)
  79 {
  80   return scm_makdbl (x, 0.0);
  81 }
  82 SCM
  83 gh_char2scm (char c)
  84 {
  85  return SCM_MAKE_CHAR (c);
  86 }
  87 SCM
  88 gh_str2scm (const char *s, int len)
  89 {
  90   return scm_makfromstr (s, len, 0);
  91 }
  92 SCM
  93 gh_str02scm (const char *s)
  94 {
  95   return scm_makfrom0str (s);
  96 }
  97 /* Copy LEN characters at SRC into the *existing* Scheme string DST,
  98    starting at START.  START is an index into DST; zero means the
  99    beginning of the string.
 100
 101    If START + LEN is off the end of DST, signal an out-of-range
 102    error.  */
 103 void
 104 gh_set_substr (char *src, SCM dst, int start, int len)
 105 {
 106   char *dst_ptr;
 107   unsigned long dst_len;
 108   unsigned long effective_length;
 109
 110   SCM_ASSERT (SCM_STRINGP (dst), dst, SCM_ARG3,
 111               "gh_set_substr");
 112
 113   dst_ptr = SCM_CHARS (dst);
 114   dst_len = SCM_LENGTH (dst);
 115   SCM_ASSERT (len >= 0 && (unsigned) len <= dst_len,
 116               dst, SCM_ARG4, "gh_set_substr");
 117
 118   scm_protect_object (dst);
 119   effective_length = ((unsigned) len < dst_len) ? len : dst_len;
 120   memmove (dst_ptr + start, src, effective_length);
 121   scm_unprotect_object (dst);
 122 }
 123
 124 /* Return the symbol named SYMBOL_STR.  */
 125 SCM
 126 gh_symbol2scm (const char *symbol_str)
 127 {
 128   return SCM_CAR (scm_intern (symbol_str, strlen (symbol_str)));
 129 }
 130
 131 SCM
 132 gh_ints2scm (int *d, int n)
 133 {
 134   int i;
 135   SCM v = scm_make_vector(SCM_MAKINUM(n), SCM_UNSPECIFIED);
 136   SCM *velts = SCM_VELTS(v);
 137
 138   for (i = 0; i < n; ++i)
 139     velts[i] = (d[i] >= SCM_MOST_NEGATIVE_FIXNUM
 140                 && d[i] <= SCM_MOST_POSITIVE_FIXNUM
 141                 ? SCM_MAKINUM (d[i])
 142                 : scm_long2big (d[i]));
 143   return v;
 144 }
 145
 146 SCM
 147 gh_doubles2scm (double *d, int n)
 148 {
 149   int i;
 150   SCM v = scm_make_vector(SCM_MAKINUM(n), SCM_UNSPECIFIED);
 151   SCM *velts = SCM_VELTS(v);
 152
 153   for(i = 0; i < n; i++)
 154     velts[i] = scm_makdbl(d[i], 0.0);
 155   return v;
 156 }
 157
 158 #ifdef HAVE_ARRAYS
 159 /* Do not use this function for building normal Scheme vectors, unless
 160    you arrange for the elements to be protected from GC while you
 161    initialize the vector.  */
 162 static SCM
 163 makvect (char* m, int len, int type)
 164 {
 165   SCM ans;
 166   SCM_NEWCELL (ans);
 167   SCM_DEFER_INTS;
 168   SCM_SETCHARS (ans, m);
 169   SCM_SETLENGTH (ans, len, type);
 170   SCM_ALLOW_INTS;
 171   return ans;
 172 }
 173
 174 SCM
 175 gh_chars2byvect (char *d, int n)
 176 {
 177   char *m = scm_must_malloc (n * sizeof (char), "vector");
 178   memcpy (m, d, n * sizeof (char));
 179   return makvect (m, n, scm_tc7_byvect);
 180 }
 181
 182 SCM
 183 gh_shorts2svect (short *d, int n)
 184 {
 185   char *m = scm_must_malloc (n * sizeof (short), "vector");
 186   memcpy (m, d, n * sizeof (short));
 187   return makvect (m, n, scm_tc7_svect);
 188 }
 189
 190 SCM
 191 gh_longs2ivect (long *d, int n)
 192 {
 193   char *m = scm_must_malloc (n * sizeof (long), "vector");
 194   memcpy (m, d, n * sizeof (long));
 195   return makvect (m, n, scm_tc7_ivect);
 196 }
 197
 198 SCM
 199 gh_ulongs2uvect (unsigned long *d, int n)
 200 {
 201   char *m = scm_must_malloc (n * sizeof (unsigned long), "vector");
 202   memcpy (m, d, n * sizeof (unsigned long));
 203   return makvect (m, n, scm_tc7_uvect);
 204 }
 205
 206 SCM
 207 gh_floats2fvect (float *d, int n)
 208 {
 209   char *m = scm_must_malloc (n * sizeof (float), "vector");
 210   memcpy (m, d, n * sizeof (float));
 211   return makvect (m, n, scm_tc7_fvect);
 212 }
 213
 214 SCM
 215 gh_doubles2dvect (double *d, int n)
 216 {
 217   char *m = scm_must_malloc (n * sizeof (double), "vector");
 218   memcpy (m, d, n * sizeof (double));
 219   return makvect (m, n, scm_tc7_dvect);
 220 }
 221 #endif
 222
 223 /* data conversion scheme->C */
 224 int
 225 gh_scm2bool (SCM obj)
 226 {
 227   return (SCM_FALSEP (obj)) ? 0 : 1;
 228 }
 229 unsigned long
 230 gh_scm2ulong (SCM obj)
 231 {
 232   return scm_num2ulong (obj, (char *) SCM_ARG1, "gh_scm2ulong");
 233 }
 234 long
 235 gh_scm2long (SCM obj)
 236 {
 237   return scm_num2long (obj, (char *) SCM_ARG1, "gh_scm2long");
 238 }
 239 int
 240 gh_scm2int (SCM obj)
 241 {
 242   /* NOTE: possible loss of precision here */
 243   return (int) scm_num2long (obj, (char *) SCM_ARG1, "gh_scm2int");
 244 }
 245 double
 246 gh_scm2double (SCM obj)
 247 {
 248   return scm_num2dbl (obj, "gh_scm2double");
 249 }
 250 char
 251 gh_scm2char (SCM obj)
 252 {
 253   return SCM_CHAR (obj);
 254 }
 255
 256 /* Convert a vector, weak vector, string, substring or uniform vector
 257    into an array of chars.  If result array in arg 2 is NULL, malloc a
 258    new one. */
 259 char *
 260 gh_scm2chars (SCM obj, char *m)
 261 {
 262   int i, n;
 263   long v;
 264   SCM val;
 265   if (!SCM_NIMP (obj))
 266     scm_wrong_type_arg (0, 0, obj);
 267   switch (SCM_TYP7 (obj))
 268     {
 269     case scm_tc7_vector:
 270     case scm_tc7_wvect:
 271       n = SCM_LENGTH (obj);
 272       for (i = 0; i < n; ++i)
 273         {
 274           val = SCM_VELTS (obj)[i];
 275           if (SCM_INUMP (val))
 276             {
 277               v = SCM_INUM (val);
 278               if (v < -128 || v > 255)
 279                 scm_out_of_range (0, obj);
 280             }
 281           else
 282             scm_wrong_type_arg (0, 0, obj);
 283         }
 284       if (m == 0)
 285         m = (char *) malloc (n * sizeof (char));
 286       for (i = 0; i < n; ++i)
 287         m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
 288       break;
 289 #ifdef HAVE_ARRAYS
 290     case scm_tc7_byvect:
 291 #endif
 292     case scm_tc7_string:
 293     case scm_tc7_substring:
 294       n = SCM_LENGTH (obj);
 295       if (m == 0)
 296         m = (char *) malloc (n * sizeof (char));
 297       memcpy (m, SCM_VELTS (obj), n * sizeof (char));
 298       break;
 299     default:
 300       scm_wrong_type_arg (0, 0, obj);
 301     }
 302   return m;
 303 }
 304
 305 /* Convert a vector, weak vector or uniform vector into an array of
 306    shorts.  If result array in arg 2 is NULL, malloc a new one. */
 307 short *
 308 gh_scm2shorts (SCM obj, short *m)
 309 {
 310   int i, n;
 311   long v;
 312   SCM val;
 313   if (!SCM_NIMP (obj))
 314     scm_wrong_type_arg (0, 0, obj);
 315   switch (SCM_TYP7 (obj))
 316     {
 317     case scm_tc7_vector:
 318     case scm_tc7_wvect:
 319       n = SCM_LENGTH (obj);
 320       for (i = 0; i < n; ++i)
 321         {
 322           val = SCM_VELTS (obj)[i];
 323           if (SCM_INUMP (val))
 324             {
 325               v = SCM_INUM (val);
 326               if (v < -32768 || v > 65535)
 327                 scm_out_of_range (0, obj);
 328             }
 329           else
 330             scm_wrong_type_arg (0, 0, obj);
 331         }
 332       if (m == 0)
 333         m = (short *) malloc (n * sizeof (short));
 334       for (i = 0; i < n; ++i)
 335         m[i] = SCM_INUM (SCM_VELTS (obj)[i]);
 336       break;
 337 #ifdef HAVE_ARRAYS
 338     case scm_tc7_svect:
 339       n = SCM_LENGTH (obj);
 340       if (m == 0)
 341         m = (short *) malloc (n * sizeof (short));
 342       memcpy (m, SCM_VELTS (obj), n * sizeof (short));
 343       break;
 344 #endif
 345     default:
 346       scm_wrong_type_arg (0, 0, obj);
 347     }
 348   return m;
 349 }
 350
 351 /* Convert a vector, weak vector or uniform vector into an array of
 352    longs.  If result array in arg 2 is NULL, malloc a new one. */
 353 long *
 354 gh_scm2longs (SCM obj, long *m)
 355 {
 356   int i, n;
 357   SCM val;
 358   if (!SCM_NIMP (obj))
 359     scm_wrong_type_arg (0, 0, obj);
 360   switch (SCM_TYP7 (obj))
 361     {
 362     case scm_tc7_vector:
 363     case scm_tc7_wvect:
 364       n = SCM_LENGTH (obj);
 365       for (i = 0; i < n; ++i)
 366         {
 367           val = SCM_VELTS (obj)[i];
 368           if (!SCM_INUMP (val) && !SCM_BIGP (val))
 369             scm_wrong_type_arg (0, 0, obj);
 370         }
 371       if (m == 0)
 372         m = (long *) malloc (n * sizeof (long));
 373       for (i = 0; i < n; ++i)
 374         {
 375           val = SCM_VELTS (obj)[i];
 376           m[i] = SCM_INUMP (val) ? SCM_INUM (val) : scm_num2long (val, 0, 0);
 377         }
 378       break;
 379 #ifdef HAVE_ARRAYS
 380     case scm_tc7_ivect:
 381     case scm_tc7_uvect:
 382       n = SCM_LENGTH (obj);
 383       if (m == 0)
 384         m = (long *) malloc (n * sizeof (long));
 385       memcpy (m, SCM_VELTS (obj), n * sizeof (long));
 386       break;
 387 #endif
 388     default:
 389       scm_wrong_type_arg (0, 0, obj);
 390     }
 391   return m;
 392 }
 393
 394 /* Convert a vector, weak vector or uniform vector into an array of
 395    floats.  If result array in arg 2 is NULL, malloc a new one. */
 396 float *
 397 gh_scm2floats (SCM obj, float *m)
 398 {
 399   int i, n;
 400   SCM val;
 401   if (!SCM_NIMP (obj))
 402     scm_wrong_type_arg (0, 0, obj);
 403   switch (SCM_TYP7 (obj))
 404     {
 405     case scm_tc7_vector:
 406     case scm_tc7_wvect:
 407       n = SCM_LENGTH (obj);
 408       for (i = 0; i < n; ++i)
 409         {
 410           val = SCM_VELTS (obj)[i];
 411           if (!SCM_INUMP (val)
 412               && !(SCM_BIGP (val) || SCM_REALP (val)))
 413             scm_wrong_type_arg (0, 0, val);
 414         }
 415       if (m == 0)
 416         m = (float *) malloc (n * sizeof (float));
 417       for (i = 0; i < n; ++i)
 418         {
 419           val = SCM_VELTS (obj)[i];
 420           if (SCM_INUMP (val))
 421             m[i] = SCM_INUM (val);
 422           else if (SCM_BIGP (val))
 423             m[i] = scm_num2long (val, 0, 0);
 424           else
 425             m[i] = SCM_REALPART (val);
 426         }
 427       break;
 428 #ifdef HAVE_ARRAYS
 429     case scm_tc7_fvect:
 430       n = SCM_LENGTH (obj);
 431       if (m == 0)
 432         m = (float *) malloc (n * sizeof (float));
 433       memcpy (m, (float *) SCM_VELTS (obj), n * sizeof (float));
 434       break;
 435
 436     case scm_tc7_dvect:
 437       n = SCM_LENGTH (obj);
 438       if (m == 0)
 439         m = (float*) malloc (n * sizeof (float));
 440       for (i = 0; i < n; ++i)
 441         m[i] = ((double *) SCM_VELTS (obj))[i];
 442       break;
 443 #endif
 444     default:
 445       scm_wrong_type_arg (0, 0, obj);
 446     }
 447   return m;
 448 }
 449
 450 /* Convert a vector, weak vector or uniform vector into an array of
 451    doubles.  If result array in arg 2 is NULL, malloc a new one. */
 452 double *
 453 gh_scm2doubles (SCM obj, double *m)
 454 {
 455   int i, n;
 456   SCM val;
 457   if (!SCM_NIMP (obj))
 458     scm_wrong_type_arg (0, 0, obj);
 459   switch (SCM_TYP7 (obj))
 460     {
 461     case scm_tc7_vector:
 462     case scm_tc7_wvect:
 463       n = SCM_LENGTH (obj);
 464       for (i = 0; i < n; ++i)
 465         {
 466           val = SCM_VELTS (obj)[i];
 467           if (!SCM_INUMP (val)
 468               && !(SCM_BIGP (val) || SCM_REALP (val)))
 469             scm_wrong_type_arg (0, 0, val);
 470         }
 471       if (m == 0)
 472         m = (double *) malloc (n * sizeof (double));
 473       for (i = 0; i < n; ++i)
 474         {
 475           val = SCM_VELTS (obj)[i];
 476           if (SCM_INUMP (val))
 477             m[i] = SCM_INUM (val);
 478           else if (SCM_BIGP (val))
 479             m[i] = scm_num2long (val, 0, 0);
 480           else
 481             m[i] = SCM_REALPART (val);
 482         }
 483       break;
 484 #ifdef HAVE_ARRAYS
 485     case scm_tc7_fvect:
 486       n = SCM_LENGTH (obj);
 487       if (m == 0)
 488         m = (double *) malloc (n * sizeof (double));
 489       for (i = 0; i < n; ++i)
 490         m[i] = ((float *) SCM_VELTS (obj))[i];
 491       break;
 492
 493     case scm_tc7_dvect:
 494       n = SCM_LENGTH (obj);
 495       if (m == 0)
 496         m = (double*) malloc (n * sizeof (double));
 497       memcpy (m, SCM_VELTS (obj), n * sizeof (double));
 498       break;
 499 #endif
 500     default:
 501       scm_wrong_type_arg (0, 0, obj);
 502     }
 503   return m;
 504 }
 505
 506 /* string conversions between C and Scheme */
 507
 508 /* gh_scm2newstr() -- Given a Scheme string STR, return a pointer to a
 509    new copy of its contents, followed by a null byte.  If lenp is
 510    non-null, set *lenp to the string's length.
 511
 512    This function uses malloc to obtain storage for the copy; the
 513    caller is responsible for freeing it.
 514
 515    Note that Scheme strings may contain arbitrary data, including null
 516    characters.  This means that null termination is not a reliable way
 517    to determine the length of the returned value.  However, the
 518    function always copies the complete contents of STR, and sets
 519    *LEN_P to the true length of the string (when LEN_P is non-null).  */
 520 char *
 521 gh_scm2newstr (SCM str, int *lenp)
 522 {
 523   char *ret_str;
 524   int len;
 525
 526   SCM_ASSERT (SCM_ROSTRINGP (str), str, SCM_ARG3,
 527               "gh_scm2newstr");
 528
 529   /* protect str from GC while we copy off its data */
 530   scm_protect_object (str);
 531
 532   len = SCM_LENGTH (str);
 533
 534   ret_str = (char *) scm_must_malloc ((len + 1) * sizeof (char),
 535                                       "gh_scm2newstr");
 536   /* so we copy tmp_str to ret_str, which is what we will allocate */
 537   memcpy (ret_str, SCM_ROCHARS (str), len);     /* test ROCHARS here -twp */
 538   /* now make sure we null-terminate it */
 539   ret_str[len] = '\0';
 540
 541   scm_unprotect_object (str);
 542
 543   if (lenp != NULL)
 544     {
 545       *lenp = len;
 546     }
 547
 548   return ret_str;
 549 }
 550
 551
 552 /* Copy LEN characters at START from the Scheme string SRC to memory
 553    at DST.  START is an index into SRC; zero means the beginning of
 554    the string.  DST has already been allocated by the caller.
 555
 556    If START + LEN is off the end of SRC, silently truncate the source
 557    region to fit the string.  If truncation occurs, the corresponding
 558    area of DST is left unchanged.  */
 559 void
 560 gh_get_substr (SCM src, char *dst, int start, int len)
 561 {
 562   int src_len, effective_length;
 563   SCM_ASSERT (SCM_ROSTRINGP (src), src, SCM_ARG3,
 564               "gh_get_substr");
 565
 566   scm_protect_object (src);
 567   src_len = SCM_LENGTH (src);
 568   effective_length = (len < src_len) ? len : src_len;
 569   memcpy (dst + start, SCM_ROCHARS (src), effective_length * sizeof (char));
 570   /* FIXME: must signal an error if len > src_len */
 571   scm_unprotect_object (src);
 572 }
 573
 574
 575 /* gh_scm2newsymbol() -- Given a Scheme symbol 'identifier, return a
 576    pointer to a string with the symbol characters "identifier",
 577    followed by a null byte.  If lenp is non-null, set *lenp to the
 578    string's length.
 579
 580    This function uses malloc to obtain storage for the copy; the
 581    caller is responsible for freeing it. */
 582 char *
 583 gh_symbol2newstr (SCM sym, int *lenp)
 584 {
 585   char *ret_str;
 586   int len;
 587
 588   SCM_ASSERT (SCM_SYMBOLP (sym), sym, SCM_ARG3,
 589               "gh_scm2newsymbol");
 590
 591   /* protect str from GC while we copy off its data */
 592   scm_protect_object (sym);
 593
 594   len = SCM_LENGTH (sym);
 595
 596   ret_str = (char *) scm_must_malloc ((len + 1) * sizeof (char),
 597                                       "gh_symbol2newstr");
 598   /* so we copy tmp_str to ret_str, which is what we will allocate */
 599   memcpy (ret_str, SCM_CHARS (sym), len);
 600   /* now make sure we null-terminate it */
 601   ret_str[len] = '\0';
 602
 603   scm_unprotect_object (sym);
 604
 605   if (lenp != NULL)
 606     {
 607       *lenp = len;
 608     }
 609
 610   return ret_str;
 611 }
 612
 613
 614 /* create a new vector of the given length, all initialized to the
 615    given value */
 616 SCM
 617 gh_make_vector (SCM len, SCM fill)
 618 {
 619   return scm_make_vector (len, fill);
 620 }
 621
 622 /* set the given element of the given vector to the given value */
 623 SCM
 624 gh_vector_set_x (SCM vec, SCM pos, SCM val)
 625 {
 626   return scm_vector_set_x (vec, pos, val);
 627 }
 628
 629 /* retrieve the given element of the given vector */
 630 SCM
 631 gh_vector_ref (SCM vec, SCM pos)
 632 {
 633   return scm_vector_ref (vec, pos);
 634 }
 635
 636 /* returns the length of the given vector */
 637 unsigned long
 638 gh_vector_length (SCM v)
 639 {
 640   return gh_scm2ulong (scm_vector_length (v));
 641 }
 642
 643 #ifdef HAVE_ARRAYS
 644 /* uniform vector support */
 645
 646 /* returns the length as a C unsigned long integer */
 647 unsigned long
 648 gh_uniform_vector_length (SCM v)
 649 {
 650   return gh_scm2ulong (scm_uniform_vector_length (v));
 651 }
 652
 653 /* gets the given element from a uniform vector; ilist is a list (or
 654    possibly a single integer) of indices, and its length is the
 655    dimension of the uniform vector */
 656 SCM
 657 gh_uniform_vector_ref (SCM v, SCM ilist)
 658 {
 659   return scm_uniform_vector_ref (v, ilist);
 660 }
 661
 662 /* sets an individual element in a uniform vector */
 663 /* SCM */
 664 /* gh_list_to_uniform_array ( */
 665 #endif
 666
 667 /* Data lookups between C and Scheme
 668
 669    Look up a symbol with a given name, and return the object to which
 670    it is bound.  gh_lookup examines the Guile top level, and
 671    gh_module_lookup checks the module namespace specified by the
 672    `vec' argument.
 673
 674    The return value is the Scheme object to which SNAME is bound, or
 675    SCM_UNDEFINED if SNAME is not bound in the given context. [FIXME:
 676    should this be SCM_UNSPECIFIED?  Can a symbol ever legitimately be
 677    bound to SCM_UNDEFINED or SCM_UNSPECIFIED?  What is the difference?
 678    -twp] */
 679
 680 SCM
 681 gh_lookup (char *sname)
 682 {
 683   return gh_module_lookup (SCM_BOOL_F, sname);
 684 }
 685
 686 SCM
 687 gh_module_lookup (SCM vec, char *sname)
 688 {
 689   SCM sym = gh_symbol2scm (sname);
 690   if (SCM_TRUE_P (scm_symbol_bound_p (vec, sym)))
 691     return scm_symbol_binding (vec, sym);
 692   else
 693     return SCM_UNDEFINED;
 694 }
 695
 696 /*
 697   Local Variables:
 698   c-file-style: "gnu"
 699   End:
 700 */