Bugs in 2/4 Version with Lucid2.1

[simmons%algol.tcpip@ge-crd.arpa]

Received: by algol.steinmetz (3.2/1.1x Steinmetz)
	id AA28953; Mon, 8 Feb 88 12:34:18 EST
Date: Mon, 8 Feb 88 12:34:18 EST
From: simmons <simmons%algol.tcpip@csbvax>
Posted-Date: Mon, 8 Feb 88 12:34:18 EST
Message-Id: <8802081734.AA28953@algol.steinmetz>
To: CommonLoops.pa@Xerox.com
Subject: Bugs in 2/4 Version with Lucid2.1


I have found two problems in trying to compile the Feb 4 version of
PCL under Lucid 2.1.  I have fixes, I think , but I am uncertain of
just what happened here. Did others encounter these problems?

First, in lucid-low.lisp at line 108 we had

	(defmacro cache-no (pointer mask)
	  `(lucid::logand& ,mask ,pointer))

but it seems that the point of the subsequent code was to create
a function %logand&, which was like logand&, but accepted any types
of arguments.  If I compile PCL with the above code, I get many
messages about finding symbols where it expects fixnums.  The
following seems to be what was intended, and seems to work.

	(defmacro cache-no (pointer mask)
	  `(lucid::%logand& ,mask ,pointer))

Second, with-slots* was broken -- it failed to change setq to
setf when required.  As an example of the problem,
	> (defclass foo () (x y))
	NIL
	> (setq foo1 (make-instance 'foo))
	#<Standard-Instance 53246023>
	> (macroexpand '(with-slots* (x y) foo1 (setq x 0)))
	((LAMBDA (#:G719) (SETQ # 0)) FOO1)
	T

The problem seemed to arise in with-slots-internal.
With the changes noted below (the lines with #+Lucid) it returned

	((LAMBDA (#:G660) (SET-SLOT-VALUE #:G660 # 0)) FOO1)
	T

The original code would work interpreted, but not compiled.
Is this due to overly zealous optimization in the Lucid compiler?

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;Change made to std-class.lisp, starting at line 738

;;;This nonsense is to avoid a bug(?) in the Lucid 2.1 compiler -- MKS
#+Lucid (defvar *lucid-junk* nil)

(defun with-slots-internal (specs form context translate-fn &aux entry)
  (cond ((not (eq context :eval)) form)
	((symbolp form)
	 (if (setq entry (assoc form specs))
	     (funcall translate-fn (cadr entry))
	     form))
	((not (listp form)) form)
	((member (car form) '(setq setf))
	 ;; Have to be careful.  We must only convert the form to a SETF
	 ;; form when we convert one of the 'logical' variables to a form
	 ;; Otherwise we will get looping in implementations where setf
	 ;; is a macro which expands into setq.
	 (let ((kind (car form)))
	   (labels ((scan-setf (tail)
		      (if (null tail)
			  nil
			  (walker::relist*
			    tail
			    (if (setq entry (assoc (car tail) specs))
				(progn (setq kind 'setf)
				       (funcall translate-fn (cadr entry)))
				(car tail))
			    (cadr tail)
			    (scan-setf (cddr tail))))))
	   (let ((new-tail (scan-setf (cdr form))))
#+Lucid	     (setq *lucid-junk* new-tail)
	     (walker::recons form kind new-tail)))))
	(t form)))