From 3278b75942bdbe706f7a0fba87729bb1e935b68b Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Mon, 20 Feb 2017 00:05:25 -0800
Subject: Import Upstream version 5d2

---
 rope.c | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 60 insertions(+), 9 deletions(-)

(limited to 'rope.c')

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
-- 
cgit v1.2.3