summaryrefslogtreecommitdiffstats
path: root/rope.c
diff options
context:
space:
mode:
Diffstat (limited to 'rope.c')
-rw-r--r--rope.c69
1 files changed, 60 insertions, 9 deletions
diff --git a/rope.c b/rope.c
index 25e90bb..671279a 100644
--- a/rope.c
+++ b/rope.c
@@ -1,18 +1,18 @@
/* Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1997 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.
+ * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
@@ -36,7 +36,7 @@
*
* 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.
+ * If you do not wish that, delete this exception notice.
*/
/* "rope.c" interface between C and SCM.
@@ -159,6 +159,15 @@ long num2long(num, pos, s_caller)
# endif
errout: wta(num, pos, s_caller);
}
+short num2short(num, pos, s_caller)
+ SCM num;
+ char *pos, *s_caller;
+{
+ long lres = INUM((long)num);
+ short res = lres;
+ if (INUMP(num) && lres==res) return res;
+ wta(num, pos, s_caller);
+}
#ifdef FLOATS
double num2dbl(num, pos, s_caller)
SCM num;
@@ -174,7 +183,6 @@ double num2dbl(num, pos, s_caller)
}
#endif
-
/* Convert (arrays of) strings to SCM */
SCM makfromstr(src, len)
char *src;
@@ -230,9 +238,11 @@ char **makargvfrmstrs(args, s_name)
void must_free_argv(argv)
char **argv;
{
- char **av = argv;
- while(!(*av)) free(*(av++));
- free(argv);
+ sizet i;
+ for(i = 0; argv[i]; i++) {
+ must_free(argv[i], 1+strlen(argv[i]));
+ }
+ must_free((char *)argv, i*sizeof(char *));
}
/* Hooks to call SCM from C */
@@ -321,6 +331,8 @@ unsigned long scm_addr(args, s_name)
case tc7_ivect:
case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]);
break;
+ case tc7_svect: ptr = (unsigned long)&(((short *)CDR(v))[pos]);
+ break;
outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name);
default:
badarg: wta(v, (char *)ARG1, s_name);
@@ -328,6 +340,45 @@ unsigned long scm_addr(args, s_name)
}
return ptr;
}
+unsigned long scm_base_addr(v, s_name)
+ SCM v;
+ char *s_name;
+{
+ long pos = 0;
+ unsigned long ptr = 0; /* gratuitous assignment squelches cc warn. */
+ if IMP(v) {goto badarg;}
+ else if ARRAYP(v) {
+ pos = ARRAY_BASE(v);
+ v = ARRAY_V(v);
+ }
+ switch TYP7(v) {
+ case tc7_string:
+ ptr = (unsigned long)&(CHARS(v)[pos]);
+ break;
+# ifdef FLOATS
+# ifdef SINGLES
+ case tc7_fvect:
+ ptr = (unsigned long)&(((float *)CDR(v))[pos]);
+ break;
+# endif
+ case tc7_cvect: pos = 2 * pos;
+ case tc7_dvect: ptr = (unsigned long)&(((double *)CDR(v))[pos]);
+ break;
+# endif
+ case tc7_bvect: ASRTGO(0==(pos%LONG_BIT), outrng);
+ pos = pos/LONG_BIT;
+ case tc7_uvect:
+ case tc7_ivect:
+ case tc7_vector: ptr = (unsigned long)&(VELTS(v)[pos]);
+ break;
+ case tc7_svect: ptr = (unsigned long)&(((short *)CDR(v))[pos]);
+ break;
+ outrng: wta(MAKINUM(pos), (char *)OUTOFRANGE, s_name);
+ default:
+ badarg: wta(v, (char *)ARG1, s_name);
+ }
+ return ptr;
+}
#endif /* ARRAYS */
/* scm_cell_p() returns !0 if the SCM argument `x' is cell-aligned and