[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Gcl-devel] Re: GCL compiler bug: load-time-value and macroexpansion
|
From: |
Camm Maguire |
|
Subject: |
[Gcl-devel] Re: GCL compiler bug: load-time-value and macroexpansion |
|
Date: |
03 May 2007 16:12:35 -0400 |
|
User-agent: |
Gnus/5.09 (Gnus v5.9.0) Emacs/21.2 |
Greetings!
Matt Kaufmann <address@hidden> writes:
> Hi, Camm --
>
> I tried the fix, and it worked, though as you suggested, it may need
> tuning for speed. Result is the third line of numbers below:
>
> ; Original run:
> 12990.367u 274.629s 3:46:08.34 97.7% 0+0k 0+0io 5pf+0w
>
> ; One-line fix:
> 12987.607u 275.321s 3:45:30.28 98.0% 0+0k 0+0io 0pf+0w
>
> ; The latest:
> 13587.777u 296.454s 4:03:23.40 95.0% 0+0k 0+0io 17pf+0w
>
> As for ACL2, I plan just to use the following (aforementioned)
> "One-line fix" (let me know if you object), since it's simplest
> (perhaps safest, certainly easiest for me to distribute).
>
> #+(and gcl (not ansi-cl))
> (defun compiler::wrap-literals (x) x)
>
> If you want to experiment with tuning your latest fix, you could
> presumably built ACL2 3.2 with (load
> "/projects/acl2/devel/compiler-patch.o") in the current directory.
> (By the way, I compiled compiler-patch.lsp in a fresh GCL 2.6.7 with
> default optimization; I wonder if optimizing could be part of the
> "tuning for speed".)
>
OK, thanks to your prompting, I've figured out a way to avoid
wrap-literals entirely (and all that new code), and to avoid the
prin1/read in pass1 when invoked from within compile, which might
speed things up a bit from the fastest you have above. It could be
argued that this belongs in 2.6 as the current wrap-literals is
buggy. Your solution above is of course fine, but in case you'd like
to try this last idea, please let me know -- it could save me a bit of
time.
Take care,
> -- Matt
> Sender: address@hidden
> Cc: address@hidden
> From: Camm Maguire <address@hidden>
> Date: 02 May 2007 17:17:25 -0400
> X-SpamAssassin-Status: No, hits=-1.3 required=5.0
> X-UTCS-Spam-Status: No, hits=-281 required=200
>
> Greetings, and thanks so much! Obviously a bone-headed first attempt
> -- my apologies.
>
> This should work or be close, but might need tuning for speed. If you
> could test, I'd be most grateful. Just compile and load the
> following:
>
>
> =============================================================================
> (in-package 'compiler)
>
> (defvar *mlts* nil)
>
> (defmacro ndbctxt (&rest body)
> `(let ((*compiler-check-args* *compiler-check-args*)
> (*safe-compile* *safe-compile*)
> (*compiler-push-events* *compiler-push-events*)
> (*notinline* *notinline*)
> (*space* *space*))
> ,@body))
>
> (defun portable-source (form &optional cdr)
> (cond ((atom form) form)
> (cdr (cons (portable-source (car form)) (portable-source (cdr form)
> t)))
> ((case (car form)
> ((let let* lambda)
> `(,(car form)
> ,(mapcar (lambda (x) (if (atom x) x `(,(car x)
> ,@(portable-source (cdr x) t)))) (cadr form))
> ,@(let ((r (remove-if-not 'si::specialp (mapcar (lambda
> (x) (if (atom x) x (car x))) (cadr form)))))
> (when r `((declare (special ,@r)))))
> ,@(ndbctxt (portable-source (cddr form) t))))
> ((quote function) form)
> (declare
> (let ((opts (mapcan (lambda (x) (if (eq (car x) 'optimize)
> (cdr x) (list x)))
> (remove-if-not
> (lambda (x) (and (consp x) (member (car
> x) '(optimize notinline))))
> (cdr form)))))
> (when opts (local-compile-decls opts)))
> form)
> (the `(,(car form) ,(cadr form) ,@(portable-source (cddr
> form) t)))
> ((and or) `(,(car form) ,@(portable-source (cdr form) t)))
> (check-type form)
> ((flet labels macrolet)
> `(,(car form)
> ,(mapcar (lambda (x) `(,(car x) ,@(cdr (portable-source
> `(lambda ,@(cdr x)))))) (cadr form))
> ,@(let ((*mlts* *mlts*))
> (when (eq (car form) 'macrolet)
> (dolist (l (cadr form)) (push (car l) *mlts*)))
> (ndbctxt (portable-source (cddr form) t)))))
> (multiple-value-setq (portable-source
> (multiple-value-setq-expander (cdr form))))
> (multiple-value-bind `(,(car form) ,(cadr form)
> ,(portable-source (caddr form))
> ,@(let ((r (remove-if-not
> 'si::specialp (cadr form))))
> (when r `((declare (special
> ,@r)))))
> ,@(ndbctxt (portable-source (cdddr
> form) t))))
> ((case ccase ecase) `(,(car form) ,(portable-source (cadr
> form))
> ,@(mapcar (lambda (x) `(,(car x)
> ,@(portable-source (cdr x) t))) (cddr form))))))
> ((let* ((fd (and (symbolp (car form)) (not (member (car form)
> *mlts*))
> (or (unless (member (car form) *notinline*) (get
> (car form) 'si::compiler-macro-prop))
> (macro-function (car form)))))
> (nf (if fd (cmp-expand-macro fd (car form) (cdr form))
> form)))
> (portable-source nf (equal form nf))))))
>
> (defun this-safety-level nil
> (cond (*compiler-push-events* 3)
> (*safe-compile* 2)
> (*compiler-check-args* 1)
> (0)))
>
> (defun local-compile-decls (decls)
> (dolist**
> (decl decls)
> (unless (consp decl) (setq decl (list decl 3)))
> (case (car decl)
> (safety
> (let ((level (cadr decl)))
> (declare (fixnum level))
> (setq *compiler-check-args* (>= level 1)
> *safe-compile* (>= level 2)
> *compiler-push-events* (>= level 3))))
> (space (setq *space* (cadr decl)))
> (notinline (push (cadr decl) *notinline*))
> (speed) ;;FIXME
> (compilation-speed) ;;FIXME
> (inline
> (setq *notinline* (remove (cadr decl) *notinline*)))
> (otherwise (baboon)))))
>
> (defun pd (fname ll args)
> (let (decls ctps doc)
> (when (and (consp args) (stringp (car args)) (cdr args) (not doc))
> (push (pop args) doc))
> (do nil ((or (not args) (not (consp (car args))) (not (eq (caar args)
> 'declare))))
> (push (pop args) decls))
> (do nil ((or (not args) (not (consp (car args))) (not (eq (caar args)
> 'check-type))))
> (push (pop args) ctps))
> (let* ((nal (do (r (y ll)) ((or (not y) (eq (car y) '&aux)) (nreverse
> r)) (push (pop y) r)))
> (al (cdr (member '&aux ll)))
> (ax (mapcar (lambda (x) (if (atom x) x (car x))) al))
> (dd (aux-decls ax decls))
> (cc (aux-ctps ax ctps))
> (sd `(declare (optimize (safety ,(this-safety-level))))))
> (portable-source `(lambda ,nal
> ,@doc
> ,@(let ((r (nreverse (cadr dd))))
> (unless (and (consp r) (consp (car r)) (eq
> (caar r) 'declare)
> (consp (cadar r)) (eq (caadar r)
> 'optimize)
> (consp (cadr (cadar r))) (eq
> (caadr (cadar r)) 'safety))
> (push sd r))
> (nconc r (cadr cc)))
> ,@(let* ((r args)
> (r (if (or al (car dd)) `((let* ,al
> ,@(append (car dd) (car cc)) ,@r)) r))
> (r (if (and (consp (car r)) (eq (caar r)
> 'block) (eq (cadar r) fname))
> r `((block ,fname ,@r)))))
> r))))))
>
> (defun aux-decls (auxs decls)
> (let (ad dd)
> (dolist (l decls)
> (let* ((b (cadr l))
> (b (if (eq (car b) 'type) (cdr b) b)))
> (cond ((eq (car b) 'optimize) (push l dd))
> ((eq (car b) 'class)
> (unless (<= (length b) 3)
> (cmperr "Unknown class declaration: ~s" b))
> (if (member (cadr b) auxs) (push l ad) (push l dd)))
> ((let ((tt (intersection (cdr b) auxs)))
> (cond ((not tt) (push l dd))
> ((let ((z (if (eq b (cadr l)) (list (caadr l)) (list
> (caadr l) (cadadr l)))))
> (push `(declare (,@z ,@tt)) ad)
> (let ((q (set-difference (cdr b) auxs)))
> (when q
> (push `(declare (,@z ,@q)) dd)))))))))))
> (list (nreverse ad) (nreverse dd))))
>
> (defun aux-ctps (auxs ctps)
> (let (ad dd)
> (dolist (l ctps) (if (member (cadr l) auxs) (push l ad) (push l dd)))
> (list (nreverse ad) (nreverse dd))))
>
> (defun ppd (form)
> (ecase (car form)
> (lambda (pd 'cmp-anon (cadr form) (cddr form)))
> (lambda-block (pd (cadr form) (caddr form) (cdddr form)))
> (lambda-closure (pd 'cmp-anon (caddr (cddr form)) (cdddr (cddr
> form))))
> (lambda-block-closure (pd (cadr (cdddr form)) (caddr (cdddr form))
> (cdddr (cdddr form))))))
>
>
> (defun wrap-literals (form &optional n)
> (if (not n)
> (wrap-literals (ppd form) t)
> (cond ((and (consp form) (eq (car form) 'quote))
> (let ((x (cadr form)))
> (if (and (symbolp x)
> (eq :external (cadr (multiple-value-list (find-symbol
> (symbol-name x) 'lisp)))))
> form
> `(load-time-value (si::nani ,(si::address x))))))
> ((consp form)
> (cons (wrap-literals (car form) t) (wrap-literals (cdr form) t)))
> ((or (symbolp form) (numberp form) (characterp form))
> form)
> (`(load-time-value (si::nani ,(si::address form)))))))
>
> =============================================================================
>
> Take care,
>
> Matt Kaufmann <address@hidden> writes:
>
> > Hi, Camm --
> >
> > I needed to add this:
> >
> > compiler::(defvar *tmp-pack* nil)
> >
> > Actually I got through much of the regression suite before hitting an
> > error when I had instead just declared *tmp-pack* special in the
> > definition of wrap-literals. I think that I only hit an error when
> > the compiler was called using compile rather than compile-file.
> >
> > But then the regression failed. I distilled the following small
> > example to illustrate the problem. I haven't investigated in depth
> > but I suspect you'll figure it out quickly by tracing
> > compiler::wrap-literals. It appears that a variable binding is being
> > treated as a macro call.
> >
> > sundance:~> gcl-2.6.7
> > GCL (GNU Common Lisp) 2.6.7 CLtL1 Sep 15 2005 12:36:56
> > Source License: LGPL(gcl,gmp), GPL(unexec,bfd)
> > Binary License: GPL due to GPL'ed components: (BFD UNEXEC)
> > Modifications of this banner must retain notice of a compatible license
> > Dedicated to the memory of W. Schelter
> >
> > Use (help) to get some basic information on how to use GCL.
> >
> > >compiler::(defvar *tmp-pack* nil)
> >
> > COMPILER::*TMP-PACK*
> >
> > >compiler::(defun wrap-literals (form &aux fd)
> > (cond ((and (consp form) (eq (car form) 'quote))
> > (let ((x (cadr form)))
> > (if (and (symbolp x)
> > (eq :external (cadr (multiple-value-list (find-symbol
> (symbol-name x) 'lisp)))))
> > form
> > `(load-time-value (si::nani ,(si::address x))))))
> > ((and (consp form) (symbolp (car form)) (not (eq 'lambda (car form)))
> (setq fd (macro-function (car form))))
> > (wrap-literals (cmp-expand-macro fd (car form) (cdr form))))
> > ((consp form)
> > (cons (wrap-literals (car form)) (wrap-literals (cdr form))))
> > ((symbolp form)
> > (unless (symbol-package form)
> > (unless *tmp-pack*
> > (setq *tmp-pack* (make-package (symbol-name (gensym)))))
> > (import form *tmp-pack*))
> > form)
> > ((or (rationalp form) (characterp form))
> > form)
> > (`(load-time-value (si::nani ,(si::address form))))))
> >
> > COMPILER::WRAP-LITERALS
> >
> > >(defmacro my-cons2 (name)
> > (list 'cons name name))
> >
> > MY-CONS2
> >
> > >(defun foo (x)
> > (let ((my-cons2 (cdr x)))
> > (equal my-cons2 nil)))
> >
> > FOO
> >
> > >(compile 'foo)
> >
> > Compiling gazonk8.lsp.
> > ; (DEFUN FOO ...) is being compiled.
> > ;;; The variable binding (CONS (CDR X) (CDR X)) is illegal.;; Warning:
> The variable X is not used.
> > No FASL generated.
> >
> > Error: Cannot open the file NIL..
> > Fast links are on: do (si::use-fast-links nil) for debugging
> > Error signalled by LET.
> > Broken at LOAD. Type :H for Help.
> > >>
> >
> > -- Matt
> > Sender: address@hidden
> > Cc: address@hidden
> > From: Camm Maguire <address@hidden>
> > Date: 01 May 2007 14:07:41 -0400
> > X-SpamAssassin-Status: No, hits=-2.5 required=5.0
> > X-UTCS-Spam-Status: No, hits=-310 required=200
> >
> > Greetings! I'm not very happy about the (not (eq 'lambda (car
> > form))), but it might be worth testing this:
> >
> > (defun wrap-literals (form &aux fd)
> > (cond ((and (consp form) (eq (car form) 'quote))
> > (let ((x (cadr form)))
> > (if (and (symbolp x)
> > (eq :external (cadr (multiple-value-list (find-symbol
> (symbol-name x) 'lisp)))))
> > form
> > `(load-time-value (si::nani ,(si::address x))))))
> > ((and (consp form) (symbolp (car form)) (not (eq 'lambda (car
> form))) (setq fd (macro-function (car form))))
> > (wrap-literals (cmp-expand-macro fd (car form) (cdr form))))
> > ((consp form)
> > (cons (wrap-literals (car form)) (wrap-literals (cdr form))))
> > ((symbolp form)
> > (unless (symbol-package form)
> > (unless *tmp-pack*
> > (setq *tmp-pack* (make-package (symbol-name (gensym)))))
> > (import form *tmp-pack*))
> > form)
> > ((or (rationalp form) (characterp form))
> > form)
> > (`(load-time-value (si::nani ,(si::address form))))))
> >
> > Take care,
> >
> >
> > Matt Kaufmann <address@hidden> writes:
> >
> > > By the way, the times for the ACL2 regression suite are virtually
> > > identical before and after the following change (added to a compiled
> > > ACL2 source file):
> > >
> > > #+(and gcl (not ansi-cl)) (defun compiler::wrap-literals (x) x)
> > >
> > > ; Before above addition:
> > > 12990.367u 274.629s 3:46:08.34 97.7% 0+0k 0+0io 5pf+0w
> > > ; After above addition:
> > > 12987.607u 275.321s 3:45:30.28 98.0% 0+0k 0+0io 0pf+0w
> > >
> > > I've saved a copy of the development sources that I used, so that I
> > > can test an alternate wrap-literals that you send me.
> > >
> > > -- Matt
> > > Sender: address@hidden
> > > Cc: address@hidden
> > > From: Camm Maguire <address@hidden>
> > > Date: 30 Apr 2007 13:35:32 -0400
> > > X-SpamAssassin-Status: No, hits=-2.5 required=5.0
> > > X-UTCS-Spam-Status: No, hits=-310 required=200
> > >
> > > Greetings! This should work. Would you be willing to test an
> > > alternate wrap-literals if I get one together in the near-future?
> > >
> > > Take care,
> > >
> > > Matt Kaufmann <address@hidden> writes:
> > >
> > > > Thank you, Camm. Unfortunately, after (setq
> compiler::*keep-gaz* t),
> > > > then all the gazonk*.lsp files are left around. So I'm
> wondering if
> > > > it would safe to do the following instead:
> > > >
> > > > #+(and gcl (not ansi-cl)) (defun compiler::wrap-literals (x) x)
> > > > #+(and gcl (not ansi-cl)) (compile 'compiler::wrap-literals)
> > > >
> > > > A small test suggests that this may work, though I have no
> idea really
> > > > what I'm doing. Should I expect the above solution to be OK?
> > > >
> > > > Thanks --
> > > > -- Matt
> > > > Sender: address@hidden
> > > > Cc: address@hidden
> > > > From: Camm Maguire <address@hidden>
> > > > Date: 30 Apr 2007 12:16:06 -0400
> > > > X-SpamAssassin-Status: No, hits=-2.5 required=5.0
> > > > X-UTCS-Spam-Status: No, hits=-310 required=200
> > > >
> > > > Greetings, and thanks so much for this report!
> > > >
> > > > The issue in brief stems from ansification -- compile'ed
> forms must
> > > > refer to the exact object literally referred to in the
> form, not a
> > > > copy, so the traditional GCL print and compile-file won't
> work. The
> > > > function is compiler::wrap-literals, which you can trace if
> > > > interested. There is obviously a bug here -- most likely
> > > > wrap-literals should do some selective macro-expansion,
> perhaps along
> > > > the lines of compiler::portable-source in 2.7.0. I will
> see if I can
> > > > come up with a solution which also retains our current
> (2.7.0)
> > > > compatibility with the ansi tests for compile. If you have
> any
> > > > suggestions, they are of course most appreciated. The
> tests in
> > > > question as run thus:
> > > >
> > > > cd ansi-tests
> > > > ../unixport/saved_ansi_gcl
> > > > >(load "gclload1")
> > > > >(load "compile")
> > > > >(load "compile-file")
> > > > >(rt:do-tests)
> > > >
> > > > There is an immediate work-around. Set the variable
> > > > compiler::*keep-gaz* to t -- this avoids wrap-literals and
> behaves as
> > > > the traditional compile via print/compile-file did. The
> idea is that
> > > > there are certain packages in the ansi build, notably pcl,
> which
> > > > compile functions which need to be linked later in gazonk
> files at the
> > > > raw build stage. Even though pcl uses compile here,
> literal object
> > > > reference is impossible as the running image at compile
> time is gone.
> > > > So qualitatively if one needs to keep the gazonk files
> around, they
> > > > better not refer to objects only available in the compiling
> image.
> > > >
> > > > This exception in all likelihood should not be there
> eventually, but I
> > > > can't at the moment envision a bridge between ansi compile
> and
> > > > traditional gcl compile without one.
> > > >
> > > > Comments/suggestions as always most welcome.
> > > >
> > > > Take care,
> > > >
> > > > Matt Kaufmann <address@hidden> writes:
> > > >
> > > > > Hello --
> > > > >
> > > > > It appears that the GCL compiler (at least: version 2.6.7
> CLtL1, and
> > > > > also version 2.7.0 ANSI as of about 11/27/06) is laying
> down calls of
> > > > > lisp::load-time-value that are interfering with macro
> expansion.
> > > > > Below is an example exhibiting the problem.
> > > > >
> > > > > Is there any simple workaround, such as (setq
> *some-compiler-switch*
> > > > > nil)? By the way, the actual (much bigger) failure I
> had, from which
> > > > > the example below is extracted, was only an explicit
> error when
> > > > > calling COMPILE as shown below. When I put the function
> into a file,
> > > > > I didn't see any problem with COMPILE-FILE, but I found
> bizarre and
> > > > > somewhat nondeterministic behavior that went away when I
> avoided
> > > > > compiling that function by loading the .lisp file instead.
> > > > >
> > > > > .....
> > > > >
> > > > > >(defmacro my-mac (b)
> > > > > (list 'list
> > > > > (if (and (consp b)
> > > > > (stringp (car b)))
> > > > > (list 'quote b)
> > > > > b)))
> > > > >
> > > > > MY-MAC
> > > > >
> > > > > >(defun foo ()
> > > > > (my-mac ("Guards")))
> > > > >
> > > > > FOO
> > > > >
> > > > > >(foo)
> > > > >
> > > > > (("Guards"))
> > > > >
> > > > > >(compile 'foo)
> > > > >
> > > > > Compiling gazonk4.lsp.
> > > > > ; (DEFUN FOO ...) is being compiled.
> > > > > ;;; The function (LOAD-TIME-VALUE (SYSTEM:NANI
> 139732192)) is illegal.
> > > > > No FASL generated.
> > > > >
> > > > > Error: Cannot open the file NIL..
> > > > > Fast links are on: do (si::use-fast-links nil) for
> debugging
> > > > > Error signalled by LET.
> > > > > Broken at LOAD. Type :H for Help.
> > > > > >>(quit)
> > > > > sundance:~> cat gazonk4.lsp
> > > > >
> > > > > (lisp::defun user::foo lisp::nil (user::my-mac
> ((lisp::load-time-value (system::nani 139732192)))))sundance:~>
> > > > >
> > > > > Thanks --
> > > > > -- Matt
> > > > >
> > > > >
> > > > >
> > > >
> > > > --
> > > > Camm Maguire
> address@hidden
> > > >
> ==========================================================================
> > > > "The earth is but one country, and mankind its citizens."
> -- Baha'u'llah
> > > >
> > > >
> > > >
> > >
> > > --
> > > Camm Maguire
> address@hidden
> > >
> ==========================================================================
> > > "The earth is but one country, and mankind its citizens." --
> Baha'u'llah
> > >
> > >
> > >
> >
> > --
> > Camm Maguire address@hidden
> >
> ==========================================================================
> > "The earth is but one country, and mankind its citizens." --
> Baha'u'llah
> >
> >
> >
>
> --
> Camm Maguire address@hidden
> ==========================================================================
> "The earth is but one country, and mankind its citizens." -- Baha'u'llah
>
>
>
--
Camm Maguire address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens." -- Baha'u'llah