I've created a patch to STk-2.1.6/Src/str.c causing all functions
therein defined to use the storage_as.string.dim field to determine
length rather than relying on the null terminator. Note that
non-pathological strings should still work since all created strings
automatically have a null added one byte beyond their end when they
are created. With this patch in place, one should be able to deal
with strings such as
(string #\a #\null #\n #\u #\l #\l)
without worrying about truncation at the null. Note that this does
not effect string I/O or mapping of strings to other objects. The
only thing I see that might go wrong is if a string is created with
an initializer that's too short. I've not done that much playing with
this yet, but I'd appreciate any feedback on this method.
----------------------------------------------------------------
*** STk-2.1.6/Src/str.c.old Mon Jun 5 02:03:40 1995
--- STk-2.1.6/Src/str.c Mon Jun 5 02:03:40 1995
***************
*** 27,44 ****
static int stringcomp(SCM s1, SCM s2)
{
if (NSTRINGP(s1)) err("comparing string: bad string", s1);
if (NSTRINGP(s2)) err("comparing string: bad string", s2);
! return strcmp(CHARS(s1), CHARS(s2));
}
static int stringcompi(SCM s1, SCM s2)
{
if (NSTRINGP(s1)) err("comparing string: bad string", s1);
if (NSTRINGP(s2)) err("comparing string: bad string", s2);
! return STk_strcmpi(CHARS(s1), CHARS(s2));
}
SCM STk_makestrg(int len, char *init)
--- 27,71 ----
static int stringcomp(SCM s1, SCM s2)
{
+ int L1, L2, MinL, R;
+
if (NSTRINGP(s1)) err("comparing string: bad string", s1);
if (NSTRINGP(s2)) err("comparing string: bad string", s2);
! MinL = L1 = s1->storage_as.string.dim;
! if ((L2 = s2->storage_as.string.dim) < MinL)
! MinL = L2;
!
! if (L1 == 0 && L2 == 0)
! return 0;
!
! if (R = memcmp(CHARS(s1), CHARS(s2), MinL))
! return R;
!
! return L1 - L2;
}
static int stringcompi(SCM s1, SCM s2)
{
+ int L1, L2;
+ register MinL, R;
+ register char *S1, *S2;
+
if (NSTRINGP(s1)) err("comparing string: bad string", s1);
if (NSTRINGP(s2)) err("comparing string: bad string", s2);
! MinL = L1 = s1->storage_as.string.dim;
! if ((L2 = s2->storage_as.string.dim) < MinL)
! MinL = L2;
!
! S1 = CHARS(s1);
! S2 = CHARS(s2);
!
! while (MinL--)
! if (R = tolower(*S1++) - tolower(*S2++))
! return R;
!
! return L1 - L2;
}
SCM STk_makestrg(int len, char *init)
***************
*** 53,59 ****
z->storage_as.string.data = (char *) must_malloc(len+1);
z->storage_as.string.data[len] = 0;
! if (init) strncpy(z->storage_as.string.data, init, len);
No_interrupt(flag);
return z;
}
--- 80,86 ----
z->storage_as.string.data = (char *) must_malloc(len+1);
z->storage_as.string.data[len] = 0;
! if (init) memcpy(z->storage_as.string.data, init, len);
No_interrupt(flag);
return z;
}
***************
*** 186,192 ****
/* copy strings */
for (i=0; i < len; i++) {
! strcpy(p, CHARS(CAR(l)));
p += CAR(l)->storage_as.string.dim;
l = CDR(l);
}
--- 213,219 ----
/* copy strings */
for (i=0; i < len; i++) {
! memcpy(p, CHARS(CAR(l)), CAR(l)->storage_as.string.dim);
p += CAR(l)->storage_as.string.dim;
l = CDR(l);
}
***************
*** 227,233 ****
PRIMITIVE STk_string_copy(SCM str)
{
if (NSTRINGP(str)) err("string-copy: not a string", str);
! return STk_makestring(CHARS(str));
}
PRIMITIVE STk_string_fill(SCM str, SCM c)
--- 254,260 ----
PRIMITIVE STk_string_copy(SCM str)
{
if (NSTRINGP(str)) err("string-copy: not a string", str);
! return STk_makestrg(str->storage_as.string.dim, CHARS(str));
}
PRIMITIVE STk_string_fill(SCM str, SCM c)
***************
*** 253,258 ****
--- 280,299 ----
*
*/
+ static char *memmem(char *s1, int l1, char *s2, int l2)
+ {
+ if (l2 == 0)
+ return s1;
+
+ while (l1-- >= l2)
+ if (memcmp(s1, s2, l2))
+ s1++;
+ else
+ return s1;
+
+ return NULL;
+ }
+
PRIMITIVE STk_string_findp(SCM s1, SCM s2)
{
char msg[] = "string-find?: bad string";
***************
*** 260,266 ****
if (NSTRINGP(s1)) err(msg,s1);
if (NSTRINGP(s2)) err(msg,s2);
! return strstr(CHARS(s2), CHARS(s1)) ? Truth: Ntruth;
}
PRIMITIVE STk_string_index(SCM s1, SCM s2)
--- 301,308 ----
if (NSTRINGP(s1)) err(msg,s1);
if (NSTRINGP(s2)) err(msg,s2);
! return memmem(CHARS(s2), s2->storage_as.string.dim,
! CHARS(s1), s1->storage_as.string.dim) ? Truth: Ntruth;
}
PRIMITIVE STk_string_index(SCM s1, SCM s2)
***************
*** 270,276 ****
if (NSTRINGP(s1)) err(msg,s1);
if (NSTRINGP(s2)) err(msg,s2);
! p = strstr(CHARS(s2), CHARS(s1));
return p? STk_makeinteger(p - CHARS(s2)) : Ntruth;
}
--- 312,319 ----
if (NSTRINGP(s1)) err(msg,s1);
if (NSTRINGP(s2)) err(msg,s2);
! p = memmem(CHARS(s2), s2->storage_as.string.dim,
! CHARS(s1), s1->storage_as.string.dim);
return p? STk_makeinteger(p - CHARS(s2)) : Ntruth;
}
***************
*** 281,291 ****
{
SCM z;
register char *p, *q;
if (NSTRINGP(s)) err("string-lower: not a string", s);
! z = STk_makestrg(strlen(CHARS(s)), NULL);
! for (p=CHARS(s), q=CHARS(z); *p; p++, q++) *q = tolower(*p);
return z;
}
--- 324,335 ----
{
SCM z;
register char *p, *q;
+ register int BufS;
if (NSTRINGP(s)) err("string-lower: not a string", s);
! z = STk_makestrg(BufS=s->storage_as.string.dim, NULL);
! for (p=CHARS(s), q=CHARS(z); BufS--; p++, q++) *q = tolower(*p);
return z;
}
***************
*** 293,302 ****
{
SCM z;
register char *p, *q;
if (NSTRINGP(s)) err("string-upper: not a string", s);
! z = STk_makestrg(strlen(CHARS(s)), NULL);
! for (p=CHARS(s), q=CHARS(z); *p; p++, q++) *q = toupper(*p);
return z;
}
--- 337,347 ----
{
SCM z;
register char *p, *q;
+ register int BufS;
if (NSTRINGP(s)) err("string-upper: not a string", s);
! z = STk_makestrg(BufS=s->storage_as.string.dim, NULL);
! for (p=CHARS(s), q=CHARS(z); BufS--; p++, q++) *q = toupper(*p);
return z;
}
--
Christopher Oliver Traverse Communications
Systems Coordinator 223 Grandview Pkwy, Suite 108
oliver_at_traverse.com Traverse City, Michigan, 49684
Received on Mon Jun 05 1995 - 08:28:18 CEST