segvs on memoized macro backtraces

segvs on memoized macro backtraces

[Kevin Ryde]

[-- Attachment #1: Type: text/plain, Size: 1321 bytes --]

In guile 1.6.3 built on a recent i386 debian, I struck a couple of
cases where memoized macros seem to induce segmentation violations
during a backtrace print.

The files foo.scm and bar.scm are two examples, each independent, to
be run as

	guile --debug -s foo.scm
	guile --debug -s bar.scm

Each results in a partial backtrace printout then a segmentation
violation, whereas naturally I hoped for a full printout.


foo.scm has an obviously incorrect "let", as revealled by running
without --debug.  Still, it'd be nice to get a backtrace to locate the
problem.

For what it's worth, gdb suggests perhaps unmemocopy has gone into an
infinite or very long recursion (the call under the "loop" label),
apparently overflowing the stack (the faulting insn being a pushl).


bar.scm produces a correct macro expansion, I believe.  (Uncommenting
the pretty-print in the file shows what's being executed, or is
supposed to be executed.)  But the record-accessor call is requesting
an incorrect field.  Running without --debug shows that error.

For what it's worth, gdb suggests scm_unmemocar has been reached with
an "env" list of just one element, whereas SCM_IFRAME is 1, for which
an env of two or more elements is apparently expected.  (But all this
is a mystery to me, so I wouldn't necessarily trust that analysis).



[-- Attachment #2: foo.scm --]
[-- Type: application/octet-stream, Size: 112 bytes --]

(define my-macro
  (procedure->memoizing-macro
   (lambda (expr env)
     (list 'let expr))))

(my-macro 1 2 3)

[-- Attachment #3: bar.scm --]
[-- Type: application/octet-stream, Size: 2002 bytes --]

(define let-toplevel*
  (procedure->memoizing-macro
   (lambda (expr env)
     (let-toplevel-transform expr 'let*))))

(define (let-toplevel-transform expr let-symbol)
  
  ;; EXPR is (define-toplevel ...), return a list (define foo #f)
  (define (top-def type expr)
    (list type
          (if (pair? (cadr expr))
              (caadr expr)
              (cadr expr))
          '#f))
  
  ;; EXPR is (define-toplevel ...), return a list (set! foo ...) or
  ;; (set! foo (lambda ...))
  (define (top-set expr)
    (if (pair? (cadr expr))
        (list 'set!
              (caadr expr)
              (cons* 'lambda
                     (cdadr expr)
                     (cddr expr)))
        (cons 'set! (cdr expr))))
  
  (let ((defs '()))
    (define (transform body)
      (map (lambda (expr)
             (cond ((eq? (car expr) 'define-toplevel)
                    (set! defs (cons (top-def 'define expr) defs))
                    (top-set expr))
                   ((eq? (car expr) 'define-public)
                    (set! defs (cons (top-def 'define-public expr) defs))
                    (top-set expr))
                   ((memq (car expr) '(let let*))
                    (cons* (car expr) (cadr expr) (transform (cddr expr))))
                   (else
                    expr)))
           body))
    (let ((trans (transform (cddr expr))))
      (cons 'begin
            (append! defs
                     (list (cons* let-symbol (cadr expr) trans)))))))



;; (use-modules (ice-9 pretty-print))
;; (pretty-print
;;  (let-toplevel-transform
;;   '(let-toplevel*
;;        ((rec-type (make-record-type "my-record" '(abc)))
;;         (rec-new  (record-constructor rec-type '(abc)))
;;         (rec-abc  (record-accessor rec-type 'xyz)))
;;      (display "hello world\n"))
;;   'let*))



(let-toplevel*
    ((rec-type (make-record-type "my-record" '(abc)))
     (rec-new  (record-constructor rec-type '(abc)))
     (rec-abc  (record-accessor rec-type 'xyz)))
  (display "hello world\n"))

[-- Attachment #4: Type: text/plain, Size: 136 bytes --]

_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-guile