gcl-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Gcl-devel] Windows - Instability in universe.lsp


From: Camm Maguire
Subject: Re: [Gcl-devel] Windows - Instability in universe.lsp
Date: 25 Mar 2004 12:34:43 -0500
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2

Greetings!

"Mike Thomas" <address@hidden> writes:

> Hi Camm.
> 
> Thanks.
> 
> | p pp(p->p.p_name)
> | frame 2
> | p pp(form)
> | frame 3
> | p pp(form)
> | frame 5
> | p pp(form
> | frame 7
> | p pp(form)
> 
> | Can't yet reproduce your place in the stack.
> 
> To reproduce assuming you can on Linux (I do admit it is probably just
> Windows, but live in hope):
> 
> 
>   1. cd to ansi-tests
> 
>   2. gdb ../unixport/saved_ansi_gcl.exe
> 
>   3. At gdb prompt: r
> 
>   4. Open universe.lsp in emacs and copy and paste everything starting from:
> 
>    "(defparameter *condition-types*"
> 
>  down to the line just before:
> 
>    "(defparameter *hash-tables*"
> 
>    5. When that has all been loaded it should give an error prompt with none
> of the usual stuff about "press 1 for this press 2 for that".
> 
>    6. Type 1 and hit enter
> 
>    7. Type 1 and hit enter.
> 
>    8. You should now be in the debugger.

When I do this, I get back a normal lisp prompt.

The problem is that intern is being passed Cnil (&Cnil_body in gdb) as
its package argument.

>From your first post:

=============================================================================
0x00452c1a in intern (st=0x103fca80, p=0x651a90) at package.d:401
401             for (l = *ip;  type_of(l) == t_cons;  l = l->c.c_cdr)
(gdb) p ip
$1 = (object *) 0x651a90
(gdb) p *ip
$2 = 0x8
(gdb) p l
$3 = 0x8
(gdb) p l->id
There is no member named id.
(gdb) p l->d
Cannot access memory at address 0x8
(gdb) p l->c
Cannot access memory at address 0x8
(gdb) p st->st
$4 = {t = 13 '\r', flag = 0 '\0', s = 0 '\0', m = 0 '\0',
  st_displaced = 0x651a90, st_hasfillp = 0, st_adjustable = 0,
  st_self = 0x13847f34 "a", st_fillp = 1, st_dim = 1}
(gdb) p p->p
$5 = {t = 8 '\b', flag = 0 '\0', s = 0 '\0', m = 0 '\0', p_name = 0x651a90,
  p_nicknames = 0x651a90, p_shadowings = 0x6253c8, p_uselist = 0x3,
  p_usedbylist = 0x0, p_internal = 0x651a90, p_external = 0x10103fa4,
  p_internal_size = 1, p_external_size = 0, p_internal_fp = 0,
  p_external_fp = 0, p_link = 0x101062ac}
(gdb) bt
#0  0x00452c1a in intern (st=0x103fca80, p=0x651a90) at package.d:401
#1  0x00454608 in Lintern () at package.d:870
#2  0x0041f487 in eval (form=0x651a90) at eval.c:1090
#3  0x0041f40a in eval (form=0x102e26a8) at eval.c:1077
#4  0x0041ed84 in Ieval (form=0x102e269c) at eval.c:928
=============================================================================

Lintern should be checking for a valid package designator in
coerce_to_package.  This should never return nil:


static object
coerce_to_package(p)
object p;
{
        object pp;

        if (type_of(p) == t_package)
                return(p);
        pp = find_package(p);
        if (pp == Cnil)
                no_package(p);
        return(pp);
}



@(defun intern (strng &optional (p `current_package()`) &aux sym)
@
        check_type_string(&strng);
        check_package_designator(p);
        p = coerce_to_package(p);
        sym = intern(strng, p);
        if (intern_flag == INTERNAL)
                @(return sym sKinternal)
        if (intern_flag == EXTERNAL)
                @(return sym sKexternal)
        if (intern_flag == INHERITED)
                @(return sym sKinherited)
        @(return sym Cnil)
@)


You should be blasting out into the error handler in no_package, which
in turn should call intern one more time before giving the error
printout, with a string:

(gdb) p st->st
$35 = {t = 13 '\r', flag = 0 '\0', s = 0 '\0', m = 0 '\0', st_displaced = 
0x851cc60, 
  st_hasfillp = 1, st_adjustable = 1, 
  st_self = 0xbf8e1dc "MAKE-INSTANCE CONDITIONS::INTERNAL-TYPE-ERROR 
(:FUNCTION-NAME :DATUM :EXPECTED-TYPE) NIL", st_fillp = 88, st_dim = 144}

in the PCL package.  But I don't see the error handler in your
stack.  A good test case might be (intern "a" "foo").  Break at no
package, and step through to see if you can figure out how you got
back to intern with a nil package argument.  This appears to be the
same longjmp issue, i.e. you are missing the setjmp set by the error
handler and somehow longjmping back to intern, I'm guessing.  You
might not be able to trigger this with the simple intern test case if
longjmp is basically working up to a certain point in the C stack, in
which case try this example again, single stepping from no_package. 

longjmp is only called in format.c and frame.c, the latter in the
function unwind.  I'd suggest breaking at this function, making sure
the loop therein finds the right frame in the frs stack, and single
stepping from the longjmp.  When I type '1' after the (intern "a"
"foo") package error, the longjmp takes me out into gcl_top, i.e. back
at the top level.  I think you are jumping to a different place.

Take care,


> 
> Here is the result of your request for more gdb output.  Frame 7 had no form
> argument so I did 6 an 8:
> 
> =============================================================
> 
> (gdb) p pp(p->p.p_name)
> NIL$6 = void
> (gdb)
> NIL$7 = void
> (gdb) p p->p.p_name
> $8 = 0x651a90
> (gdb) frame 2
> #2  0x0041f487 in eval (form=0x651a90) at eval.c:1090
> 1090              (*(x)->cf.cf_self)();
> (gdb) p pp(form)
> NIL$9 = void
> (gdb) frame 3
> #3  0x0041f40a in eval (form=0x102e26a8) at eval.c:1077
> 1077                    eval(MMcar(form));
> (gdb) p pp(form)
> ((INTERN a CL-TEST) (INTERN  CL-TEST)
>                 (APPEND (AND (CODE-CHAR 0)
>                              (LIST (INTERN
>                                     (MAKE-STRING 1 INITIAL-ELEMENT
>                                      (CODE-CHAR 0))
>                                     CL-TEST)))
>                         (AND (CODE-CHAR 0)
>                              (LET* ((S
>                                      (MAKE-STRING 10 INITIAL-ELEMENT
>                                       (CODE-CHAR 0)))
>                                     (S2 (COPY-SEQ S))
>                                     (S3 (COPY-SEQ S)))
>                                (SETF (SUBSEQ S 3 4) a)
>                                (SETF (SUBSEQ S2 4 5) a)
>                                (SETF (SUBSEQ S3 4 5) a)
>                                (SETF (SUBSEQ S3 7 8) b)
>                                (LIST (INTERN S CL-TEST)
>                                      (INTERN S2 CL-TEST)
>                                      (INTERN S3 CL-TEST))))))$10 = void
> (gdb) frame 5
> #5  0x0040d506 in Fsetq (form=0x102e2570) at assignment.c:100
> 100                             setq(MMcar(form),ans=Ieval(MMcadr(form)));
> (gdb) p pp(form)
> (*CL-TEST-SYMBOLS*
>                                                               (LIST*
>                                                                (INTERN
>                                                                 a
>                                                                 CL-TEST)
>                                                                (INTERN
>                                                                 CL-TEST)
>                                                                (APPEND
>                                                                 (AND
>                                                                  (CODE-CHAR
>                                                                   0)
>                                                                  (LIST
>                                                                   (INTERN
> 
> (MAKE-STRING
>                                                                     1
> 
> INITIAL-ELEM
> ENT
> 
> (CODE-CHAR
>                                                                      0))
> 
> CL-TEST)))
>                                                                 (AND
>                                                                  (CODE-CHAR
>                                                                   0)
>                                                                  (LET*
>                                                                   ((S
> 
> (MAKE-STRING
> 
>                                                                      10
> 
> INITIAL-ELE
> MENT
> 
> (CODE-CHAR
>                                                                       0)))
>                                                                    (S2
> 
> (COPY-SEQ
>                                                                      S))
>                                                                    (S3
> 
> (COPY-SEQ
>                                                                      S)))
>                                                                    (SETF
>                                                                     (SUBSEQ
>                                                                      S
>                                                                      3
>                                                                      4)
>                                                                     a)
>                                                                    (SETF
>                                                                     (SUBSEQ
>                                                                      S2
>                                                                      4
>                                                                      5)
>                                                                     a)
>                                                                    (SETF
>                                                                     (SUBSEQ
>                                                                      S3
>                                                                      4
>                                                                      5)
>                                                                     a)
>                                                                    (SETF
>                                                                     (SUBSEQ
>                                                                      S3
>                                                                      7
>                                                                      8)
>                                                                     b)
>                                                                    (LIST
>                                                                     (INTERN
>                                                                      S
> 
> CL-TEST)
>                                                                     (INTERN
>                                                                      S2
> 
> CL-TEST)
>                                                                     (INTERN
>                                                                      S3
> 
> CL-TEST))))
> )))$11 = void
> (gdb) frame 7
> #7  0x0046175a in Fprogn (body=0x102e251c) at prog.c:248
> 248                             eval(MMcar(body));
> (gdb) p pp(form)
> No symbol "form" in current context.
> (gdb) frame 6
> #6  0x0041f217 in eval (form=0x102e257c) at eval.c:1037
> 1037                    (*fun->s.s_sfdef)(MMcdr(form));
> (gdb) p pp(form)
> (SETQ
> 
>     *CL-TEST-SYMBOLS*
> 
>     (LIST*
> 
>      (INTERN
> 
>       a
> 
>       CL-TEST)
> 
>      (INTERN
> 
> 
> 
>       CL-TEST)
> 
>      (APPEND
> 
>       (AND
> 
>        (CODE-CHAR
> 
>         0)
> 
>        (LIST
> 
>         (INTERN
> 
>          (MAKE-STRING
> 
>           1
> 
>           INITIAL-ELEMENT
> 
>           (CODE-CHAR
> 
>            0))
> 
>          CL-TEST)))
> 
>       (AND
> 
>        (CODE-CHAR
> 
>         0)
> 
>        (LET*
> 
>         ((S
> 
>           (MAKE-STRING
> 
>            10
> 
>            INITIAL-ELEMENT
> 
>            (CODE-CHAR
> 
>             0)))
> 
>          (S2
> 
>           (COPY-SEQ
> 
>            S))
> 
>          (S3
> 
>           (COPY-SEQ
> 
>            S)))
> 
>          (SETF
> 
>           (SUBSEQ
> 
>            S
> 
>            3
> 
>            4)
> 
>           a)
> 
>          (SETF
> 
>           (SUBSEQ
> 
>            S2
> 
>            4
> 
>            5)
> 
>           a)
> 
>          (SETF
> 
>           (SUBSEQ
> 
>            S3
> 
>            4
> 
>            5)
> 
>           a)
> 
>          (SETF
> 
>           (SUBSEQ
> 
>            S3
> 
>            7
> 
>            8)
> 
>           b)
> 
>          (LIST
> 
>           (INTERN
> 
>            S
> 
>            CL-TEST)
> 
>           (INTERN
> 
>            S2
> 
>            CL-TEST)
> 
>           (INTERN
> 
>            S3
> 
>            CL-TEST)))))))$12 = void
> (gdb) frame 8
> #8  0x0041f217 in eval (form=0x102e2534) at eval.c:1037
> 1037                    (*fun->s.s_sfdef)(MMcdr(form));
> (gdb) p pp(form)
> (PROGN
> 
>                            (*MAKE-SPECIAL
> 
>                             '*CL-TEST-SYMBOLS*)
> 
>                            (SETQ
> 
>                             *CL-TEST-SYMBOLS*
> 
>                             (LIST*
> 
>                              (INTERN
> 
>                               a
> 
>                               CL-TEST)
> 
>                              (INTERN
> 
> 
> 
>                               CL-TEST)
> 
>                              (APPEND
> 
>                               (AND
> 
>                                (CODE-CHAR
> 
>                                 0)
> 
>                                (LIST
> 
>                                 (INTERN
> 
>                                  (MAKE-STRING
> 
>                                   1
> 
>                                   INITIAL-ELEMENT
> 
>                                   (CODE-CHAR
> 
>                                    0))
> 
>                                  CL-TEST)))
> 
>                               (AND
> 
>                                (CODE-CHAR
> 
>                                 0)
> 
>                                (LET*
> 
>                                 ((S
> 
>                                   (MAKE-STRING
> 
>                                    10
> 
>                                    INITIAL-ELEMENT
> 
>                                    (CODE-CHAR
> 
>                                     0)))
> 
>                                  (S2
> 
>                                   (COPY-SEQ
> 
>                                    S))
> 
>                                  (S3
> 
>                                   (COPY-SEQ
> 
>                                    S)))
> 
>                                  (SETF
> 
>                                   (SUBSEQ
> 
>                                    S
> 
>                                    3
> 
>                                    4)
> 
>                                   a)
> 
>                                  (SETF
> 
>                                   (SUBSEQ
> 
>                                    S2
> 
>                                    4
> 
>                                    5)
> 
>                                   a)
> 
>                                  (SETF
> 
>                                   (SUBSEQ
> 
>                                    S3
> 
>                                    4
> 
>                                    5)
> 
>                                   a)
> 
>                                  (SETF
> 
>                                   (SUBSEQ
> 
>                                    S3
> 
>                                    7
> 
>                                    8)
> 
>                                   b)
> 
>                                  (LIST
> 
>                                   (INTERN
> 
>                                    S
> 
>                                    CL-TEST)
> 
>                                   (INTERN
> 
>                                    S2
> 
>                                    CL-TEST)
> 
>                                   (INTERN
> 
>                                    S3
> 
>                                    CL-TEST)))))))
> 
>                            '*CL-TEST-SYMBOLS*)$13 = void
> (gdb)
> ================================================================
> 
> 
> 
> 
> 
> 

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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]