From jaffer@zurich.ai.mit.edu Tue Jul 21 22:22:06 1992
From: jaffer@zurich.ai.mit.edu (Aubrey Jaffer)
Newsgroups: comp.lang.scheme
Subject: scm4a9.patch
Date: 20 Jul 92 22:33:00 GMT
Organization: M.I.T. Artificial Intelligence Lab.

There is a serious bug in scm4a7 and scm4a8.  Thanks to
campbell@redsox.bsw.com (Larry Campbell) for finding it.  Patches
follow:

diff -c scm4a8/ChangeLog scm/ChangeLog
*** scm4a8/ChangeLog	Sat Jul 18 01:12:14 1992
--- scm/ChangeLog	Mon Jul 20 16:49:35 1992
***************
*** 1,3
  Sat Jul 18 01:07:33 1992  Aubrey Jaffer  (jaffer at Ivan)
  
  	* subr.c sys.c (make_vector init_storage resizuve): mallocs and

--- 1,12 -----
+ Mon Jul 20 16:44:30 1992  Aubrey Jaffer  (jaffer at Ivan)
+ 
+ 	From: Stephen Adams <S.R.Adams@ecs.southampton.ac.uk>
+ 	* eval.c scm.h subr.c (BOOL_NOT) macro added to fix ^ bug in
+ 	BorlandC.  This was fixed previously as well.
+ 
+ 	From: campbell@redsox.bsw.com (Larry Campbell)
+ 	* unif.c (vector-set-length!): was always typing to tc7_vector.
+ 
  Sat Jul 18 01:07:33 1992  Aubrey Jaffer  (jaffer at Ivan)
  
  	* subr.c sys.c (make_vector init_storage resizuve): mallocs and
diff -c scm4a8/eval.c scm/eval.c
*** scm4a8/eval.c	Mon Jul 13 22:21:16 1992
--- scm/eval.c	Mon Jul 20 15:57:33 1992
***************
*** 562,568
      case tc7_lsubr_2:
        return SUBRF(proc)(t.arg1, arg2, EOL);
      case tc7_lsubr_2n:
!       return (BOOL_F ^ BOOL_T) ^ SUBRF(proc)(t.arg1, arg2, EOL);
      case tc7_asubr:
        return t.arg1 = SUBRF(proc)(t.arg1,arg2);
      case tc7_subr_0:

--- 562,568 -----
      case tc7_lsubr_2:
        return SUBRF(proc)(t.arg1, arg2, EOL);
      case tc7_lsubr_2n:
!       return BOOL_NOT(SUBRF(proc)(t.arg1, arg2, EOL));
      case tc7_asubr:
        return t.arg1 = SUBRF(proc)(t.arg1,arg2);
      case tc7_subr_0:
***************
*** 593,599
      case tc7_lsubr_2:
        return SUBRF(proc)(t.arg1, arg2, eval_args(x,env));
      case tc7_lsubr_2n:
!       return (BOOL_F ^ BOOL_T) ^ SUBRF(proc)(t.arg1, arg2, eval_args(x,env));
      case tc7_lsubr:
        return SUBRF(proc)(cons2(t.arg1,arg2,eval_args(x,env)));
      case tcs_closures:

--- 593,599 -----
      case tc7_lsubr_2:
        return SUBRF(proc)(t.arg1, arg2, eval_args(x,env));
      case tc7_lsubr_2n:
!       return BOOL_NOT(SUBRF(proc)(t.arg1, arg2, eval_args(x,env)));
      case tc7_lsubr:
        return SUBRF(proc)(cons2(t.arg1,arg2,eval_args(x,env)));
      case tcs_closures:
***************
*** 698,704
      return SUBRF(proc)(arg1,CAR(args),CDR(args));
    case tc7_lsubr_2n:
      ASRTGO(NIMP(args) && CONSP(args),wrongnumargs);
!     return (BOOL_F ^ BOOL_T) ^ SUBRF(proc)(arg1,CAR(args),CDR(args));
    case tc7_asubr:
      if NULLP(args) return SUBRF(proc)(arg1,UNDEFINED);
      while NIMP(args) {

--- 698,704 -----
      return SUBRF(proc)(arg1,CAR(args),CDR(args));
    case tc7_lsubr_2n:
      ASRTGO(NIMP(args) && CONSP(args),wrongnumargs);
!     return BOOL_NOT(SUBRF(proc)(arg1,CAR(args),CDR(args)));
    case tc7_asubr:
      if NULLP(args) return SUBRF(proc)(arg1,UNDEFINED);
      while NIMP(args) {
diff -c scm4a8/scm.h scm/scm.h
*** scm4a8/scm.h	Fri Jul 17 22:10:48 1992
--- scm/scm.h	Mon Jul 20 15:57:15 1992
***************
*** 108,113
  
  #define FALSEP(x) ((x) == BOOL_F)
  #define NFALSEP(x) ((x) != BOOL_F)
  #define NULLP(x) ((x) == EOL)
  #define NNULLP(x) ((x) != EOL)
  #define UNBNDP(x) ((x) == UNDEFINED)

--- 108,116 -----
  
  #define FALSEP(x) ((x) == BOOL_F)
  #define NFALSEP(x) ((x) != BOOL_F)
+ /* BOOL_NOT returns the other boolean.  The order of ^s here is
+    important for Borland C++. */
+ #define BOOL_NOT(x)  ((x) ^ (BOOL_T ^ BOOL_F))
  #define NULLP(x) ((x) == EOL)
  #define NNULLP(x) ((x) != EOL)
  #define UNBNDP(x) ((x) == UNDEFINED)
diff -c scm4a8/subr.c scm/subr.c
*** scm4a8/subr.c	Sat Jul 18 01:12:22 1992
--- scm/subr.c	Mon Jul 20 15:57:23 1992
***************
*** 657,663
  SCM st_leqp(s1, s2)
  SCM s1, s2;
  {
!   return st_lessp(s2, s1) ^ (BOOL_F ^ BOOL_T);
  }
  SCM stci_lessp(s1, s2)
  SCM s1, s2;

--- 657,663 -----
  SCM st_leqp(s1, s2)
  SCM s1, s2;
  {
!   return BOOL_NOT(st_lessp(s2, s1));
  }
  SCM stci_lessp(s1, s2)
  SCM s1, s2;
***************
*** 682,688
  SCM stci_leqp(s1, s2)
  SCM s1, s2;
  {
!   return stci_lessp(s2, s1) ^ (BOOL_F ^ BOOL_T);
  }
  SCM substring(str,start,end)
  SCM str,start,end;

--- 682,688 -----
  SCM stci_leqp(s1, s2)
  SCM s1, s2;
  {
!   return BOOL_NOT(stci_lessp(s2, s1));
  }
  SCM substring(str,start,end)
  SCM str,start,end;
diff -c scm4a8/unif.c scm/unif.c
*** scm4a8/unif.c	Sat Jul 18 00:59:43 1992
--- scm/unif.c	Mon Jul 20 15:57:20 1992
***************
*** 468,474
      SETCHARS(vect,tmp);
      if VECTORP(vect) while(l > INUM(len)) VELTS(vect)[--l]=UNSPECIFIED;
      else if STRINGP(vect) CHARS(vect)[l-1]=0;
!     SETLENGTH(vect,INUM(len),tc7_vector);
    }
    ALLOW_INTS;
    if (!tmp) wta(len,(char *)NALLOC,s_resizuve);

--- 468,474 -----
      SETCHARS(vect,tmp);
      if VECTORP(vect) while(l > INUM(len)) VELTS(vect)[--l]=UNSPECIFIED;
      else if STRINGP(vect) CHARS(vect)[l-1]=0;
!     SETLENGTH(vect,INUM(len),TYP7(vect));
    }
    ALLOW_INTS;
    if (!tmp) wta(len,(char *)NALLOC,s_resizuve);