summaryrefslogtreecommitdiffstats
path: root/rope.c
diff options
context:
space:
mode:
authorJames LewisMoss <dres@debian.org>2000-03-12 09:04:17 -0500
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:26 -0800
commit8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693 (patch)
tree17427e4f777ca85990a449fe939fbae29770b346 /rope.c
parenta47af30d2f0e96afcd1f14b1984575c359faa3d6 (diff)
parent3278b75942bdbe706f7a0fba87729bb1e935b68b (diff)
downloadscm-8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693.tar.gz
scm-8cfce36c6a4fc2e0a0ab6ef2db66a23cbe462693.zip
Import Debian changes 5d2-3debian/5d2-3
scm (5d2-3) unstable frozen; urgency=low * Fix libncurses4-dev -> libncurses5-dev build depend (Closes: #58435) * Fix libreadline2-dev -> libreadline4-dev build depend. * Fix license location in copyright file (lintian warning) * Add tetex-bin as a build depend (needs makeinfo) (Closes: #53197) * Add -isp option to dpkg-gencontrol (lintian error) * Move scm to section interpreters. scm (5d2-2) unstable; urgency=low * Apply patch from upstream for bug in eval.c. (Picked up from comp.lang.scheme) * Add Build-Depends on slib, librx1g-dev, libncurses4-dev, libreadlineg2-dev. * Up standards version. * Correct description: this is an R5RS implementation now * Make sure no optimizations are done on m68k. (Closes: #52434) scm (5d2-1) unstable; urgency=low * New upstream. scm (5d1-2) unstable; urgency=low * Remove TAGS on clean (cut the diff back down to reasonable size). scm (5d1-1) unstable; urgency=low * New upstream. * move stuff to /usr/share. scm (5d0-3) unstable; urgency=low * Change scmlit call to ./scmlit call (missed one) (Fixes bugs #37455 and #35545) * Change man file permissions to 644 (fixes lintian warning) scm (5d0-2) unstable; urgency=low * Removed call to add_final in init_crs. lendwin doesn't do anything and scm was crashing when quit everytime in final_scm. * Changed copyright to reflect new source. scm (5d0-1) unstable; urgency=low * New upstream. * Changed (terms) to access "/usr/doc/copyright/GPL". * Changed regex to use -lrx scm (5c3-6) unstable; urgency=low * New maintainer.
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