Re: Apparent CMU CL compiler bug

Gareth McCaughan <gmccaughan@xxxxxxxxxxxxxxxx> writes:

> OK, I'll try again with 18e and let you know if I get another
> of these failures. 

You'll need to load the patch below to make the error go away in 18e
(the slightly different declaration of the hash arguments.)

(in-package :c)

(defun volatile-info-lookup (env name hash)
  (declare (type volatile-info-env env)
           (type (integer 0 #.most-positive-fixnum) hash))
  (let ((table (volatile-info-env-table env)))
    (macrolet ((lookup (test)
                 `(dolist (entry (svref table (mod hash (length table))) ())
                    (when (,test (car entry) name)
                      (return (cdr entry))))))
      (setf (volatile-info-env-cache-types env)
            (if (symbolp name)
                (lookup eq)
                (lookup equal)))
      (setf (volatile-info-env-cache-name env) name)))

  (undefined-value))

(defun compact-info-lookup (env name hash)
  (declare (type compact-info-env env)
           (type (integer 0 #.most-positive-fixnum) hash))
  (let* ((table (compact-info-env-table env))
         (len (length table))
         (len-2 (- len 2))
         (hash2 (- len-2 (rem hash len-2))))
    (declare (type index len-2 hash2))
    (macrolet ((lookup (test)
                 `(do ((probe (rem hash len)
                              (let ((new (+ probe hash2)))
                                (declare (type index new))
                                ;;
                                ;; same as (mod new len), but faster.
                                (if (>= new len)
                                    (the index (- new len))
                                    new))))
                      (nil)
                    (let ((entry (svref table probe)))
                      (when (eql entry 0)
                        (return nil))
                      (when (,test entry name)
                        (return (aref (compact-info-env-index env)
                                      probe)))))))
      (setf (compact-info-env-cache-index env)
            (if (symbolp name)
                (lookup eq)
                (lookup equal)))
      (setf (compact-info-env-cache-name env) name)))

  (undefined-value))