toma@tekgvs.LABS.TEK.COM (Tom Almy) (11/22/90)
ARGG! After sending out many copies of XLISP recently, I have found
yet another XLISP bug. In the past I fixed many problems handling the
ASCII NUL character in strings caused mainly by indescriminate use of
the C string library. Well last night I found another one when I
attempted to use READ-LINE to read a text file with embedded NULLs.
And if that wasn't bad enough, I discovered errors in my own new and
modified functions. Coerce wouldn't coerce NIL into an array or
string (should coerce into #() and "" respectively). The remove
functions on lists failed if :start and :end were other than the
complete list. The delete functions on lists were totally messed up.
(Sorry for all of this, the last two errors were generated when I was
fixing things for proper operation with 16 bit integer compilers).
A lousy way to start the holiday season :-(
=======================
To fix xcoerce (in xlsys.c) change
oldtype = ntype(arg);
to
oldtype = (arg==NIL? CONS: ntype(arg));
======================
To fix remif() in xlseq.c, change the case CONS: to
case CONS:{
long s=start, l=end-start;
for (; consp(seq); seq = cdr(seq)) {
/* check to see if this element should be deleted */
/* force copy if count, as specified by end, is exhausted */
if (s-- > 0 || l-- <= 0 ||
(expr?dotest2(x,car(seq),fcn)
:dotest1(car(seq),fcn)) != tresult) {
next = consa(car(seq));
if (val) rplacd(last,next);
else val = next;
last = next;
}
}
}
break;
(I declared and initialized s and l inside the for loop. A bad mistake!)
=======================
Replacement code for the case CONS: in delif() in file xlseq.c:
case CONS:
end -= start; /* gives length */
/* delete leading matches, only if start is 0 */
if (start == 0)
while (consp(seq) && end > 0) {
end--;
if ((expr?dotest2(x,car(seq),fcn)
:dotest1(car(seq),fcn)) != tresult)
break;
seq = cdr(seq);
}
val = last = seq;
/* delete embedded matches */
if (consp(seq) && end > 0) {
/* skip the first non-matching element, start == 0 */
if (start == 0) seq = cdr(seq);
/* skip first elements if start > 0, correct "last" */
for (;consp(seq) && start-- > 0;last=seq, seq=cdr(seq));
/* look for embedded matches */
while (consp(seq) && end-- > 0) {
/* check to see if this element should be deleted */
if ((expr?dotest2(x,car(seq),fcn)
:dotest1(car(seq),fcn)) == tresult)
rplacd(last,cdr(seq));
else
last = seq;
/* move to the next element */
seq = cdr(seq);
}
}
break;
=======================
Here, in its entirety, is the fixed and tested version of xreadline().
/* xreadline - read a line from a file */
LVAL xreadline()
{
char buf[STRMAX+1],*p,*sptr;
LVAL fptr,str,newstr;
int len,blen,ch;
/* protect some pointers */
xlsave1(str);
/* get file pointer */
fptr = (moreargs() ? xlgetfile() : getvalue(s_stdin));
xllastarg();
/* get character and check for eof */
len = blen = 0; p = buf;
while ((ch = xlgetc(fptr)) != EOF && ch != '\n') {
/* check for buffer overflow TAA MOD to use memcpy instead of strcat*/
if (blen >= STRMAX) {
newstr = newstring(len + STRMAX + 1);
sptr = getstring(newstr);
if (str) memcpy((char *)sptr, (char *)getstring(str), len);
memcpy((char *)sptr+len, (char *)buf, blen);
p = buf; blen = 0;
len += STRMAX;
str = newstr;
}
/* store the character */
*p++ = ch; ++blen;
}
/* check for end of file */
if (len == 0 && p == buf && ch == EOF) {
xlpop();
return (NIL);
}
/* append the last substring */
/* conditional removed because always true! TAA MOD*/
/* changed to use memcpy instead of strcat TAA MOD */
newstr = newstring(len + blen + 1);
sptr = getstring(newstr);
if (str) memcpy((char *)sptr, (char *)getstring(str), len);
memcpy((char *)sptr+len, (char *)buf, blen);
sptr[len+blen] = '\0';
str = newstr;
/* restore the stack */
xlpop();
/* return the string */
return (str);
}
Enjoy!
Tom Almy
toma@tekgvs.labs.tek.com
Standard Disclaimers Apply