[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Here you are
Received: from cs.cmu.edu by B.GP.CS.CMU.EDU id aa22716; 5 Nov 91 6:40:41 EST
Received: from lanai.cs.ucla.edu by CS.CMU.EDU id aa22859; 5 Nov 91 6:39:43 EST
Received: by lanai.cs.ucla.edu
(Sendmail 5.61a+YP/3.13) id AA10436;
Tue, 5 Nov 91 03:39:31 -0800
Date: Tue, 5 Nov 91 03:39:30 PST
From: Trent Lange <lange@CS.UCLA.EDU>
Message-Id: <911105.113930z.10429.lange@lanai.cs.ucla.edu>
To: cmucl-bugs@cs.cmu.edu
Cc: lange@CS.UCLA.EDU
Subject: A whole bunch of bug reports and patches
Hi --
I've been working on a new revision of PCL for general release to fill
in some of its CLOS gaps. In the process of making sure it would
work with CMU lisp, you'll be happy, I'm sure, to hear I've come up
with a number of bug reports, places needing optimizations, and even
a source code patch or two. I'm running CMU Common Lisp 15a on a
Sun 4 under SunOS 4.1.1.
- Trent Lange (lange@cs.ucla.edu)
=======================================================================
First, a number of patches to allow numeric optimizations that are
missing from the LOOP macro in loop.lisp. Included are the following
function redefinitions:
- Added single-float, double-float, long-float, and short-float to
the list of types that ONLY-SIMPLE-TYPES recognizes, to allow
loop variables to use them as type specs.
- Modified PARSE-REPEAT to declare the temporary variable used in
the REPEAT iteration construct as type fixnum (where before it
was undeclared). Because the user's count form might not be a fixnum,
PARSE-REPEAT also sets up the form to check that, using the FLOOR of
its value if it is not.
- Optimized the forms produced by PARSE-ACCUMULATION in a number of ways:
- Modified the COUNT, COUNTING, SUM, and SUMMING forms to pick
the initial value using PICK-DEFAULT-VALUE rather than 0
(eliminating a compiler warning when their types were non-fixnum.
- The MAXIMIZE and MAXIMIZING forms were very slow because their
accumulation variables used NIL to represent their value when
the forms had not yet been evaluated. This stopped the compiler
from allocating fixnum or single-float registers for them, and
required that it be checked for NIL every time the MAXIMIZE form
was evaluated. I modified this to use the most negative possible
value for the type-spec (from new function PICK-MOST-NEGATIVE-VALUE)
as the initial value of the accumulation variable, when possible.
The MAXIMIZE form check then just checks to see if the evaluated
form is > than the accumulation variable, which it will definitely
be than the initial most-negative value, rather than having to
also check for NIL. When PICK-MOST-NEGATIVE-VALUE cannot find
the most-negative possible value of the type (e.g. for 'number),
the old method of using NIL as the initial value is used.
The new definition also defines the type of the temporary variable
,Temp.
- Also modified the MINIMIZE and MINIMIZING forms in the same way,
only using the new PICK-MOST-POSITIVE-VALUE.
All of the above patches should be complete transparent, with the
exception of the new method of sometimes using the most negative/positive
values for the initial value of MAXIMIZE etc. forms rather than NIL. The
only difference with these forms is that LOOP will return that most negative
value, rather than NIL, if the MAXIMIZE body is never evaluated. This
shouldn't be a problem, however, since XJ313 states that the value
returned in that case is undefined, and the optimization of this method
is quite substantial.
(defun only-simple-types (type-spec)
(if (atom type-spec)
(member type-spec
'(fixnum float single-float double-float long-float
short-float t nil)
:test #'eq)
(and (only-simple-types (car type-spec))
(only-simple-types (cdr type-spec)))))
(defun pick-most-negative-value (type-spec)
"Picks the most negative number of type Type-Spec for simple
built-in types. NIL is returned if this function doesn't know
the value for Type-Spec."
(case type-spec
(fixnum most-negative-fixnum)
(single-float most-negative-single-float)
(double-float most-negative-double-float)
(short-float most-negative-short-float)
(long-float most-negative-long-float)
(float most-negative-double-float) ;in place of most-negative-float
(T NIL)))
(defun pick-most-positive-value (type-spec)
"Picks the most positive number of type Type-Spec for simple
built-in types. NIL is returned if this function doesn't know
the value for Type-Spec."
(case type-spec
(fixnum most-positive-fixnum)
(single-float most-positive-single-float)
(double-float most-positive-double-float)
(short-float most-positive-short-float)
(long-float most-positive-long-float)
(float most-positive-double-float) ;in place of most-positive-float
(T NIL)))
(defun parse-repeat ()
(let ((temp (gensym "REPEAT-"))
(count-form (pop *remaining-stuff*)))
(setf *outside-bindings*
(splice-in-subform
*outside-bindings*
(cond ((or (typep count-form 'fixnum)
(and (listp count-form)
(eq (car count-form) 'the)
(subtypep (cadr count-form) 'fixnum)))
;; Know for certain the count form is a fixnum.
`(let ((,temp ,count-form))
(declare (type fixnum ,temp))
,*magic-cookie*))
((symbolp count-form)
;; Count form is a variable or constant name, so set
;; temp to its value if it is a fixnum, the floor
;; of its value otherwise.
`(let ((,temp (if (typep ,count-form 'fixnum)
,count-form
(floor ,count-form))))
(declare (type fixnum ,temp))
,*magic-cookie*))
(T
;; Count form is something that may perform computation,
;; so compute it before checking whether it's a fixnum.
(let ((gensym (gensym)))
`(let* ((,gensym ,count-form)
(,temp (if (typep ,gensym 'fixnum)
,gensym
(floor ,gensym))))
(declare (type fixnum ,temp))
,*magic-cookie*))))))
(setf *inside-bindings*
(splice-in-subform *inside-bindings*
`(if (minusp (decf ,temp))
(loop-finish)
,*magic-cookie*)))))
(defun parse-accumulation ()
(let* ((clause (pop *remaining-stuff*))
(expr (pop *remaining-stuff*))
(var (if (preposition-p "INTO")
(pop *remaining-stuff*)
(or *result-var*
(setf *result-var*
(gensym (concatenate 'simple-string
(string clause)
"-"))))))
(info (assoc var *accumulation-variables*))
(type nil)
(initial nil))
(cond ((loop-keyword-p clause "COLLECT" "COLLECTING" "APPEND" "APPENDING"
"NCONC" "NCONCING")
(setf initial nil)
(setf type 'list)
(let ((aux-var
(or (caddr info)
(let ((aux-var (gensym "LAST-")))
(setf *outside-bindings*
(splice-in-subform *outside-bindings*
`(let ((,var nil)
(,aux-var nil))
(declare (type list
,var
,aux-var))
,*magic-cookie*)))
(if (null info)
(push (setf info (list var 'list aux-var))
*accumulation-variables*)
(setf (cddr info) (list aux-var)))
aux-var)))
(value
(cond ((loop-keyword-p clause "COLLECT" "COLLECTING")
`(list ,expr))
((loop-keyword-p clause "APPEND" "APPENDING")
`(copy-list ,expr))
((loop-keyword-p clause "NCONC" "NCONCING")
expr)
(t
(error "Bug in loop?")))))
(setf *body-forms*
(nconc *body-forms*
`((cond ((null ,var)
(setf ,var ,value)
(setf ,aux-var (last ,var)))
(t
(nconc ,aux-var ,value)
(setf ,aux-var (last ,aux-var)))))))))
((loop-keyword-p clause "COUNT" "COUNTING")
(setf type (parse-type-spec 'unsigned-byte))
(setf initial (pick-default-value var type))
(setf *body-forms*
(nconc *body-forms*
`((when ,expr (incf ,var))))))
((loop-keyword-p clause "SUM" "SUMMING")
(setf type (parse-type-spec 'number))
(setf initial (pick-default-value var type))
(setf *body-forms*
(nconc *body-forms*
`((setf ,var (the ,type (+ ,var (the ,type ,expr))))))))
((loop-keyword-p clause "MAXIMIZE" "MAXIMIZING")
(let ((parsed-type (parse-type-spec 'number)))
;; If type-spec has a known most negative number, then
;; use it as the initial value. Otherwise, must use NIL
;; as the initial value, and check the accumulation VAR
;; for it each time.
(setf initial (pick-most-negative-value parsed-type))
(setf type (if initial parsed-type `(or null ,parsed-type)))
(setf *body-forms*
(nconc *body-forms*
(let ((temp (gensym "MAX-TEMP-")))
`((let ((,temp ,expr))
(declare (type ,parsed-type ,temp))
(when ,(if initial
`(> ,temp ,var)
`(or (null ,var)
(> ,temp
(the ,parsed-type ,var))))
(setf ,var ,temp)))))))))
((loop-keyword-p clause "MINIMIZE" "MINIMIZING")
(let ((parsed-type (parse-type-spec 'number)))
;; If type-spec has a known most negative number, then
;; use it as the initial value. Otherwise, must use NIL
;; as the initial value, and check the accumulation VAR
;; for it each time.
(setf initial (pick-most-positive-value parsed-type))
(setf type (if initial parsed-type `(or null ,parsed-type)))
(setf *body-forms*
(nconc *body-forms*
(let ((temp (gensym "MIN-TEMP-")))
`((let ((,temp ,expr))
(declare (type ,parsed-type ,temp))
(when ,(if initial
`(< ,temp ,var)
`(or (null ,var)
(< ,temp
(the ,parsed-type ,var))))
(setf ,var ,temp)))))))))
(t
(error "Invalid accumulation clause: ~S" clause)))
(cond (info
(unless (equal type (cadr info))
(error "Attempt to use ~S for both types ~S and ~S."
var type (cadr info))))
(t
(push (list var type) *accumulation-variables*)
(setf *outside-bindings*
(splice-in-subform *outside-bindings*
`(let ((,var ,initial))
(declare (type ,type ,var))
,*magic-cookie*)))))))
========================================================================
While on the subject of the LOOP macro, there were also a couple of
bugs which I didn't try to come up with patches for:
--------
WHILE clauses cause loop parser to go haywire when placed before
other LOOP constructs (FOR and WITH), though it works fine when
placed afterwards.
From Steele 2, p. 727
* (let ((stack '(a b c d e f)))
(loop while stack
for item = (length stack) then (pop stack)
collect item))
In: LET ((STACK '(A B C D E ...)))
(LOOP WHILE STACK FOR ITEM = (LENGTH STACK) THEN (POP STACK)...)
Error: (during macroexpansion)
Error in function LOOP::PARSE-LOOP.
Unknown clause, FOR
(LET ((STACK '#)) (LOOP WHILE STACK FOR ITEM = # THEN #...))
Warning: Variable STACK defined but never used.
* (loop while l with x do (print (cons x (car l))))
Error in function LOOP::PARSE-LOOP.
Unknown clause, WITH
---------
Very strange type checking error for LOOP macro:
* (proclaim '(optimize (speed 0)(safety 3)))
EXTENSIONS::%UNDEFINED%
* (defun test9 () (loop for j fixnum in '(1 2 3) collect j))
TEST9
* (compile *)
Compiling FUNCTION LAMBDA:
Compiling Top-Level Form:
TEST9
NIL
NIL
* (test9)
Type-error in TEST9:
NIL is not of type FIXNUM
Restarts:
0: Return to Top-Level.
Debug (type H for help)
(DEBUG::DEBUG-LOOP)
0] q
- I've only seen it happen when compiled with SAFETY 3. When running
uncompiled or with safety 0, it works fine. The problem seems to
be specific to the IN ... COLLECT combination, and happens with or
without my above LOOP patches.
========================================================================
NTH-VALUE conses too much when n is not specified as an integer.
The following patch stops it from consing for the most common cases,
i.e. when n evaluates to 0, 1, or 2:
(defmacro nth-value (n form)
"Evaluates FORM and returns the Nth value (zero based). This involves no
consing when N is a trivial constant integer."
(if (integerp n)
(let ((dummy-list nil)
(wendy (gensym)))
;; We build DUMMY-LIST, a list of variables to bind to useless
;; values, then we explicitly IGNORE those bindings and return
;; WENDY, the only thing we're really interested in right now.
(dotimes (i n)
(push (gensym) dummy-list))
`(multiple-value-bind (,@dummy-list ,wendy)
,form
(declare (ignore ,@dummy-list))
,wendy))
`(once-only (,n)
(case (the fixnum ,n)
(0 (nth-value 0 ,form))
(1 (nth-value 1 ,form))
(2 (nth-value 2 ,form))
(T (nth (the fixnum ,n) (multiple-value-list ,form)))))))
========================================================================
The type of the indices internally in NTHCDR, BUTLAST, and NBUTLAST were
not declared, leaving them unoptimized. Also, the type of the optional
N parameter in BUTLAST and NBUTLAST were declared as integer, with
code checking to see if its supplied value was less than 0. However,
their argument types declared N to be of type INDEX (unsigned-byte 29).
The following are patches that optimize them by declaring the type of
all appropriate variables to be of type INDEX, as is consistent with
their declared types and the current declarations of such indices in other
CMU list functions (such as LAST).
(defun nthcdr (n list)
(declare (type index n))
"Performs the cdr function n times on a list."
(do ((i n (1- i))
(result list (cdr result)))
((not (plusp i)) result)
(declare (type index i))))
(defun butlast (list &optional (n 1))
"Returns a new list the same as List without the N last elements."
(declare (list list) (type index n))
(let ((length (1- (length list))))
(declare (type index length))
(if (< length n)
()
(do* ((top (cdr list) (cdr top))
(result (list (car list)))
(splice result)
(count length (1- count)))
((= count n) result)
(declare (type index count))
(setq splice (cdr (rplacd splice (list (car top)))))))))
(defun nbutlast (list &optional (n 1))
"Modifies List to remove the last N elements."
(declare (list list) (type index n))
(let ((length (1- (length list))))
(declare (type index length))
(if (< length n) ()
(do ((1st (cdr list) (cdr 1st))
(2nd list 1st)
(count length (1- count)))
((= count n)
(rplacd 2nd ())
list)
(declare (type index count))))))
========================================================================
And now for bugs/questions I have no patches for:
---------
Functions defined with &key &allow-other-keys without any actual keyword
parameters don't work:
* (defun test (x &key &allow-other-keys) x)
TEST
* (test 3 :ignore-me T)
Error in function C::%ARGUMENT-COUNT-ERROR.
Wrong number of arguments passed -- 3.
---------
FUNCTIONP, (TYPEP ... 'FUNCTION), etc. do not return T for normal lambda
lists or for symbols that name functions, e.g.
* (functionp '(lambda (x) x))
NIL
* (functionp 'cons)
NIL
Nor can lambda-lists be funcalled or applied. I know the fact that what
CMU lisp considers functions are guaranteed to be "actual" functions
allows funcalling optimizations when items have been declared as
being of type function, but shouldn't these optimizations be done
only through COMPILED-FUNCTION declarations, or perhaps, better yet,
through addition of a new subtype of FUNCTION, such as REAL-FUNCTION?
-----------
Strange bogus deletion message for following (whittled down from one
of my own functions that got it):
* (proclaim '(optimize (speed 3)(safety 0)(compilation-speed 0)(space 0)))
EXTENSIONS::%UNDEFINED%
* (defun strange-deletion (list)
(declare (list list))
(if (car list)
(car list)
(copy-list list)))
STRANGE-DELETION
* (compile *)
Compiling FUNCTION LAMBDA:
In: FUNCTION LAMBDA
(COPY-LIST LIST)
--> BLOCK IF IF ERROR
==>
LIST
Note: Deleting unreachable code.
Compiling Top-Level Form:
Compilation unit finished.
1 note
But it works fine when variable is named anything but "list":
* (defun strange-deletion (good-list)
(declare (list good-list))
(if (car good-list)
(car good-list)
(copy-list good-list)))
STRANGE-DELETION
* (compile *)
Compiling FUNCTION LAMBDA:
Compiling Top-Level Form:
STRANGE-DELETION
NIL
---------
There sometimes seems to be a failure to optimize some inline functions
properly when two or more inlineable functions are used in the same function:
* (proclaim '(optimize (speed 3)(safety 0)(space 0)(compilation-speed 0)))
EXTENSIONS::%UNDEFINED%
* (defun fast-union (list1 list2 &optional list2-shortest)
(declare (inline union))
(if list2-shortest
(union list2 list1 :test #'eq)
(union list1 list2 :test #'eq)))
FAST-UNION
* (compile *)
Compiling FUNCTION LAMBDA:
In: FUNCTION LAMBDA
(UNION LIST2 LIST1 :TEST #'EQ)
--> BLOCK LET DOLIST DO BLOCK LET TAGBODY LET UNLESS COND IF NOT IF
--> LISP::WITH-SET-KEYS COND IF COND IF PROGN MEMBER BLOCK DO BLOCK LET
TAGBODY
--> LET IF LISP::SATISFIES-THE-TEST COND IF COND IF PROGN NOT IF FUNCALL
==>
(C::%FUNCALL LISP::TEST-NOT LISP::ITEM (FUNCALL LISP::KEY CAR))
Note: Called function might be a symbol, so must coerce at run-time.
Compiling Top-Level Form:
Compilation unit finished.
1 note
- The call union is also unoptimized if one of the calls is instead
to (intersection ... :test #'eq), and probably others. The call to
union is optimized, however, when only one such call is in the function.
And, as a further note, neither seems to be optimized, even though the
note only complains about one.
---------
Get note on failure to use assertion from function type declaration
because of assignment to one of the arguments, even though it should
be easily provable to the compiler that it wouldn't cause any problem:
(declaim (ftype (function (T list) list) slow-cons))
(defun slow-cons (x l)
(declare (list l))
(setf l (cons x l)))
On compilation:
In: DEFUN SLOW-CONS
(DEFUN SLOW-CONS (X L) (DECLARE (LIST L)) (SETF L (CONS X L)))
Note: Assignment to argument: L
prevents use of assertion from function type declaration:
LIST
Converted SLOW-CONS.
Compiling DEFUN SLOW-CONS:
Compiling Top-Level Form:
Compilation unit finished.
1 note
Obviously setting L to the result of a CONS wouldn't cause any problems,
nor should it (I wouldn't think) with setting it to the result of any
other operation that can be proved to match its type. I'm not exactly
sure why the compiler is complaining here, but using one of the
function variables is a good trick to speed up small functions, and
it would be a shame if it's counterproductive.
---------
KERNEL::FUNCALLABLE-INSTANCE-P, which is heavily used by PCL, gives the
following optimization note. Is there anything that can be done about it
to optimize it?
* (defun test (x) (kernel::funcallable-instance-p x))
TEST
* (compile *)
Compiling FUNCTION LAMBDA:
In: FUNCTION LAMBDA
(KERNEL:FUNCALLABLE-INSTANCE-P X)
--> EQL IF EQL
==>
(KERNEL:GET-TYPE X)
Note: Doing MOVE-FROM-SIGNED/UNSIGNED (cost 20), for:
The first result of GET-TYPE.
Compiling Top-Level Form:
Compilation unit finished.
1 note
---------
CONCATENATE, when called with OUTPUT-TYPE-SPEC simple-string and all
of its sequences declared as type simple-string, always gives the
following optimization note for ASH, which it doesn't for lists or
simple-vectors. Is it optimizable, by somehow declaring this C::X variable
to be of type FIXNUM or INDEX, or no?
* (defun test (x y)
(concatenate 'simple-string (the simple-string x) (the simple-string y)))
TEST
* (compile *)
Compiling FUNCTION LAMBDA:
In: FUNCTION LAMBDA
(CONCATENATE 'SIMPLE-STRING
(THE SIMPLE-STRING X)
(THE SIMPLE-STRING Y))
--> LET* *
==>
(ASH C::X 3)
Note: Doing MOVE-FROM-SIGNED/UNSIGNED (cost 20), for:
The first result of inline ASH.
[Last message occurs 2 times]
--> LET* MAKE-STRING MAKE-ARRAY TRUNCATE IF VALUES
==>
(ASH C::X -3)
Note: Doing MOVE-FROM-SIGNED/UNSIGNED (cost 20), for:
The first result of inline ASH.
--> LET* MAKE-STRING MAKE-ARRAY TRULY-THE KERNEL:ALLOCATE-VECTOR TRUNCATE
IF
--> VALUES
==>
(ASH C::X -2)
Note: Doing MOVE-FROM-SIGNED/UNSIGNED (cost 20), for:
The first result of inline ASH.
Compiling Top-Level Form:
Compilation unit finished.
4 notes
---------
And the most insidious error of them all:
nice +15 cmu-lisp
CMU Common Lisp 15a, running on castor
Hemlock 3.5 (15a), Python 1.0(15a), target SPARCstation/Sun 4
Send bug reports and questions to cmucl-bugs@cs.cmu.edu.
* (proclaim '(optimize (speed 1)(safety 3)(space 0)(compilation-speed 3)))
EXTENSIONS::%UNDEFINED%
* (defun foo (self)
self)
FOO
* (compile *)
Compiling FUNCTION LAMBDA:
Compiling Top-Level Form:
FOO
NIL
NIL
* (defun test (self &rest keys-passed)
(let ((name-mincol
(loop for x in (append keys-passed (list self))
sum x fixnum
)))
(apply #'list
(append self keys-passed)
:header (format NIL "SA-Update ~A" (foo self))
:name-mincol name-mincol
:descriptor "Test"
:display-filter #'identity
:current-column (+ name-mincol 3)
keys-passed)
3))
TEST
* (compile *)
Compiling FUNCTION LAMBDA:
The assertion (EQ (C::IR2-BLOCK-BLOCK BLOCK)
(C::IR2-BLOCK-BLOCK (C::VOP-BLOCK C::VOP))) failed.
Restarts:
0: Retry assertion.
1: Return to Top-Level.
Debug (type H for help)
(DEBUG::DEBUG-LOOP)
0] q
- This error drove me crazy trying to figure it out. I finally figured
out that it *only* happens with the above optimization declarations.
Changing either one of speed, safety, compilation-speed, or space
makes it disappear. It also disappears if basically anything in function
TEST changes. I.e. the following things magically made the error
go away: getting rid of the FIXNUM type declaration of sum x fixnum
in the loop; getting rid of any of the keywords in the apply; changing
the NIL stream in the format statement to T; changing the call (foo self)
to an inlineable function like INDENTITY; changing either one of
the appends to another function (like list); changing name-mincol
in the (+ name-mincol 3) to anything else (even self); getting rid
of the final statement to return (the 3). I think breathing on it
also get rid of the error once.
In other words, please fix this kind of error before it drives
any other programmers crazy. :-)
=======================================================================
And finally, a couple of mostly cosmetic requests:
---------
It would be nice if the note could be suppressed (if not some
optimization performed) when items of funcalls have explicitly
been declared to be of type symbol:
* (defun test (fn-symbol) (funcall (the symbol fn-symbol)))
TEST
* (compile *)
Compiling FUNCTION LAMBDA:
In: FUNCTION LAMBDA
(FUNCALL (THE SYMBOL FN-SYMBOL))
==>
(C::%FUNCALL (THE SYMBOL FN-SYMBOL))
Note: Called function might be a symbol, so must coerce at run-time.
Compiling Top-Level Form:
Compilation unit finished.
1 note
--------
The value returned from PROCLAIM and DECLAIM is confusing:
* (declaim (ftype (function (symbol) T) test))
EXTENSIONS::%UNDEFINED%
---------
The return value from TRACE and UNTRACE, when applicable to multiple
functions, is only the name of the first function; it would be more
helpful if it returned the entire list of traced function names so that
the user is sure that it successfully tracedi or untraced them all,
as done in Lucid and others:
* (trace some every)
SOME
* (untrace)
SOME
---------
Things printed to the screen do not appear until a newline is printed.
I suppose this is a matter of taste, but it's very helpful to
have them printed right away -- I often use short PRINCed messages
to keep myself informed of the status of long-running simulations.
=======================================================================
Whew. That's it, for now. I really like the CMU Lisp package;
especially things like how it found many potentially problems in the
type declarations of my simulator that have passed unnoticed through
many a commerical compiler. Keep up the good work.
- Trent