bug fix

[yuasa@katura.tutics.tut.ac.jp (Taiichi Yuasa)]

******************** 04 OCT 90

>	Posted-Date: Tue, 2 Oct 90 23:31:11 CDT
>	Date: Tue, 2 Oct 90 23:31:11 CDT
>	From: mccain@rascal.ics.utexas.edu (Norm McCain)
>	To: boyer@cs.utexas.edu
>	Subject: ASSOC in akcl

>	There is an odd remark in Steele's COMMON LISP: THE LANGUAGE (1984
>	edition) on page 281 about ASSOC.  He says that in a case like the
>	following ASSOC should return (NIL . A) not NIL.

>	  (assoc nil '(nil (nil . a)))

>	Both Symbolics Common Lisp and HPCL II return (NIL . A), but akcl
>	returns NIL, which seems the natural thing to me (even though it
>	may be wrong.)

>	...

>	Regards, Norm


There were bugs in files c/list.d and cmpnew/cmpfun.lsp.

To fix the bugs, first replace the definitions of assoc_or_rassoc and
assoc_or_rassoc_redicate in file c/list.d as follows.

	
	@(defun assoc_or_rassoc (item a_list &key test test_not key)
		saveTEST;
	@
		protectTEST;
		setupTEST(item, test, test_not, key);
		while (!endp(a_list)) {
			if (a_list->c.c_car != Cnil &&
			    TEST((*car_or_cdr)(a_list->c.c_car))) {
				a_list = a_list->c.c_car;
				goto L;
			}
			a_list = a_list->c.c_cdr;
		}
		restoreTEST;
		@(return a_list)
	@)
	
	@(defun assoc_or_rassoc_predicate (predicate a_list)
	@
		while (!endp(a_list)) {
			if (a_list->c.c_car != Cnil &&
			    (ifuncall1(predicate,
				       (*car_or_cdr)(a_list->c.c_car)) != Cnil)
			    == true_or_false) {
				@(return `a_list->c.c_car`)
			}
			a_list = a_list->c.c_cdr;
		}
		@(return a_list)
	@)

Then replace the definition of c2assoc in cmpnew/cmpfun.lsp as follows.

	(defun c2assoc!2 (fun args
	                      &aux (*vs* *vs*) (*inline-blocks* 0) (al (next-cvar)))
	  (setq args (inline-args args '(t t)))
	  (wt-nl "{object x= " (car args) ",V" al "= " (cadr args) ";")
	  (if *safe-compile*
	      (wt-nl "while(!endp(V" al "))")
	      (wt-nl "while(V" al "!=Cnil)"))
	  (wt-nl "if(V" al "->c.c_car != Cnil && ")
	  (if *safe-compile*
	      (if (eq fun 'eq)
	          (wt "x==car(V" al "->c.c_car)")
	          (wt "eql(x,car(V" al "->c.c_car))"))
	      (if (eq fun 'eq)
	          (wt "x==(V" al "->c.c_car->c.c_car)")
	          (wt "eql(x,V" al "->c.c_car->c.c_car)")))
	  (wt "){")
	  (if (and (consp *value-to-go*)
	           (or (eq (car *value-to-go*) 'jump-true)
	               (eq (car *value-to-go*) 'jump-false)))
	      (unwind-exit t 'jump)
	      (unwind-exit (list 'CAR al) 'jump))
	  (wt-nl "}else V" al "=V" al "->c.c_cdr;")
	  (unwind-exit nil)
	  (wt "}")
	  (close-inline-blocks)
	  )

************************ 06 OCT 90
There was a bug in COPY-LIST.  The old version accepts only pairs as
the top-level elements of the argument.  To fix the bug, replace the
definition of copy_alist in file c/list.d with the following code.

	object
	copy_alist(x)
	object x;
	{
		object y;
	
		if (endp(x))
			return(Cnil);
		y = make_cons(Cnil, Cnil);
		vs_push(y);
		for (;;) {
>			if (type_of(x->c.c_car) == t_cons)
			    y->c.c_car = make_cons(car(x->c.c_car), cdr(x->c.c_car));
>			else y->c.c_car = x->c.c_car;
			x = x->c.c_cdr;
			if (endp(x))
				break;
			y->c.c_cdr = make_cons(Cnil, Cnil);
			y = y->c.c_cdr;
		}
		return(vs_pop);
	}