[Gcl-devel] Re: easy to produce segmentation violation

[Camm Maguire]

Greetings, and thanks!

Should be fixed now.

=============================================================================
(setq rt::*compile-tests* t)
=============================================================================
First I've seen this -- must start running this way at least on
occasion.

The default check-type is a real monster, BTW.  Two closures compiled
per invocation -- there has to be a better way.

=============================================================================
>(macroexpand '(check-type a symbol))

(BLOCK #:G1917
  (TAGBODY
    #:G1918
    (IF (TYPEP A 'SYMBOL) (RETURN-FROM #:G1917 NIL))
    (RESTART-CASE
        (SPECIFIC-ERROR :WRONG-TYPE-ARGUMENT
            "The value ~:@(~S~) is not ~A. (bound to variable ~:@(~S~))"
            A 'SYMBOL 'A)
      (STORE-VALUE (CONDITIONS::VALUE) :REPORT
          (LAMBDA (STREAM)
            (FORMAT STREAM "Supply a new value of ~S." 'A))
          :INTERACTIVE CONDITIONS::READ-EVALUATED-FORM
          (SETF A CONDITIONS::VALUE) (GO #:G1918)))))
T

>(macroexpand '(RESTART-CASE
        (SPECIFIC-ERROR :WRONG-TYPE-ARGUMENT
            "The value ~:@(~S~) is not ~A. (bound to variable ~:@(~S~))"
            A 'SYMBOL 'A)
      (STORE-VALUE (CONDITIONS::VALUE) :REPORT
          (LAMBDA (STREAM)
            (FORMAT STREAM "Supply a new value of ~S." 'A))
          :INTERACTIVE CONDITIONS::READ-EVALUATED-FORM
          (SETF A CONDITIONS::VALUE) (GO #:G1918))))

(BLOCK #:G1919
  (LET ((#:G1920 NIL))
    (TAGBODY
      (RESTART-BIND
          ((STORE-VALUE
               #'(LAMBDA (&REST CONDITIONS::TEMP)
                   (SETQ #:G1920 CONDITIONS::TEMP)
                   (GO #:G1921))
               :REPORT-FUNCTION
               #'(LAMBDA (STREAM)
                   (FORMAT STREAM "Supply a new value of ~S." 'A))
               :INTERACTIVE-FUNCTION #'CONDITIONS::READ-EVALUATED-FORM))
        (RETURN-FROM #:G1919
          (SPECIFIC-ERROR :WRONG-TYPE-ARGUMENT
              "The value ~:@(~S~) is not ~A. (bound to variable ~:@(~S~))"
              A 'SYMBOL 'A)))
      #:G1921
      (RETURN-FROM #:G1919
        (APPLY #'(LAMBDA (CONDITIONS::VALUE)
                   (SETF A CONDITIONS::VALUE)
                   (GO #:G1918))
               #:G1920)))))
T

>(macroexpand '(RESTART-BIND
          ((STORE-VALUE
               #'(LAMBDA (&REST CONDITIONS::TEMP)
                   (SETQ #:G1920 CONDITIONS::TEMP)
                   (GO #:G1921))
               :REPORT-FUNCTION
               #'(LAMBDA (STREAM)
                   (FORMAT STREAM "Supply a new value of ~S." 'A))
               :INTERACTIVE-FUNCTION #'CONDITIONS::READ-EVALUATED-FORM))
        (RETURN-FROM #:G1919
          (SPECIFIC-ERROR :WRONG-TYPE-ARGUMENT
              "The value ~:@(~S~) is not ~A. (bound to variable ~:@(~S~))"
              A 'SYMBOL 'A))))

(LET ((CONDITIONS::*RESTART-CLUSTERS*
          (CONS (LIST (CONDITIONS::MAKE-RESTART :NAME 'STORE-VALUE
                          :FUNCTION
                          #'(LAMBDA (&REST CONDITIONS::TEMP)
                              (SETQ #:G1920 CONDITIONS::TEMP)
                              (GO #:G1921))
                          :REPORT-FUNCTION
                          #'(LAMBDA (STREAM)
                              (FORMAT STREAM
                                      "Supply a new value of ~S." 'A))
                          :INTERACTIVE-FUNCTION
                          #'CONDITIONS::READ-EVALUATED-FORM))
                CONDITIONS::*RESTART-CLUSTERS*)))
  (RETURN-FROM #:G1919
    (SPECIFIC-ERROR :WRONG-TYPE-ARGUMENT
        "The value ~:@(~S~) is not ~A. (bound to variable ~:@(~S~))" A
        'SYMBOL 'A)))
T
=============================================================================

Take care,

Robert Boyer <address@hidden> writes:

> Here's a very easy to produce segmentation violation, caused by the compiler. 
>  Again, could
> be "static".
> 
> Bob
> 
> % xg
> GCL (GNU Common Lisp)  2.7.0 ANSI    Mar  7 2006 12:09:53
> Source License: LGPL(gcl,gmp,pargcl), 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.
> Temporary directory for compiler files set to /tmp/
> 
> >(proclaim '(optimize (safety 3)))
> 
> NIL
> 
> >(defun foo () (locally (endp 1)))
> 
> FOO
> 
> >(compile 'foo)
> 
> ;; Compiling /tmp/gazonk_8732_0.lsp.
> Segmentation violation: c stack ok:signalling errorError in FUNCALL [or a 
> callee]: Caught fatal error [memory may be damaged]: Segmentation violation.
> 
> Fast links are on: do (si::use-fast-links nil) for debugging
> Broken at CONDITIONS::CLCS-UNIVERSAL-ERROR-HANDLER.  Type :H for Help.
>  1 (Continue) (SYSTEM:ERROR-SET
>                   '(MACROEXPAND '(SETF 1 CONDITIONS::VALUE) 'NIL))
>  2 Retry compiling file #P"/tmp/gazonk_8732_0.lsp".
>  3 Retry compiling FOO.
>  4 Return to top level.
> dbl:>>
> 
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah