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

[Camm Maguire]

Greetings, and thanks!  Unfortunately, we've had a bit of confusion
again -- I thought we were debugging the stable branch.  What you show
below is an error I can completely reproduce on the unstable branch,
and so does not reveal any windows specific problem.  We changed
no_package so that it raised a package error instead of the old
generic error, the former of which is continuable, but without
providing any code for the continuation.  Simple fix is to change
no_package to return object and call and return make_package after the
package error call.  I'll try to fix this once we put stable to bed.  

Just for clarity, as there are so many moving parts, perhaps we ought
to specify in each thread the exact executable run, how it was
produced, and an input file inhaled via (load....) that shows the
error.  Copying and pasting in gdb can also be hard to reproduce at
times.  

My apologies for the confusion.

Take care,

"Mike Thomas" <address@hidden> writes:

> Hi again, thanks again.
> 
> I haven't been able to follow up on everything you sent last night but here
> is where I'm at.
> 
> The tracing below follows up on the simple (intern "a" "foo") example.
> 
> First I show the command line behaviour from following the alternatives
> thrown up at the Lisp break prompt.
> 
> One of those two alternatives gives a seg fault which comes about when a
> longjmp is excecuted.  That seg fault is chased up with a more detailed
> trace.
> 
> Unfortunately I haven't found how to trace a longjump yet so advice is
> appreciated on getting more details about what happens in longjmp.
> 
> Cheers
> 
> MIke Thomas.
> 
> 
> | 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").
> 
> 
> 
> All this seems to be working correctly with this test case except that I get
> a seg fault by choosing to continue.
> 
> That is, if I try (intern "a" "foo") in CVS HEAD GCL I get two choices
> thrown up.
> 
> If I choose "1 (continue)" I get a segfault.
> 
> If I choose "2 Return to top level" I get what seems to be a normal return
> to the top level prompt.  Both are shown below:
> 
> ================CHOICE 1======================================
> GCL (GNU Common Lisp)  2.7.0 ANSI   Mar 23 2004 16:34:15
> ....
> >(intern "a" "foo")
> 
> Error in INTERN [or a callee]: A package error occurred on "foo": "A package
> wit
> h this name does not exist".
> 
> Fast links are on: do (use-fast-links nil) for debugging
> Broken at INTERN.  Type :H for Help.
>  1 (Continue)
>  2 Return to top level.
> dbl:>>1
> 
> Program received signal SIGSEGV, Segmentation fault.
> 0x00452c1a in intern (st=0x10405fa8, p=0x651a90) at package.d:401
> 401             for (l = *ip;  type_of(l) == t_cons;  l = l->c.c_cdr)
> (gdb) q
> 
> =================CHOICE 2======================================
> 
> >(intern "a" "foo")
> 
> Error in INTERN [or a callee]: A package error occurred on "foo": "A package
> wit
> h this name does not exist".
> 
> Fast links are on: do (use-fast-links nil) for debugging
> Broken at INTERN.  Type :H for Help.
>  1 (Continue)
>  2 Return to top level.
> dbl:>>2
> 
> Top level.
> >
> ===============================================================
> 
> 
> Tracing the segfault alternative goes like this:
> 
> 
> 
> 
> ===============================================================
> 
> Starting program: c:\cvs\head\gcl/./unixport/saved_ansi_gcl.exe
>         0x0064E120 BSS start in memory.
>         0x00b80000 BSS offset in saved executable.
>         0x00116570 BSS size in bytes.
>         0x00116570 bytes read.
>         0x10100000 Heap start in memory.
>         0x00790000 Heap offset in executable.
>         0x003f0000 Heap size in bytes.
>         0x10100000 file base.
> GCL (GNU Common Lisp)  2.7.0 ANSI   Mar 23 2004 16:34:15
> Source License: LGPL(gcl,gmp), GPL(unexec,bfd)
> Binary License:  GPL due to GPL'ed components: (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.
> 
> >(intern "a" "foo")
> 
> Breakpoint 2, Lintern () at package.d:867
> 867             check_type_string(&strng);
> (gdb) c
> Continuing.
> 
> Breakpoint 3, coerce_to_package (p=0x10405f78) at package.d:322
> 322             if (type_of(p) == t_package)
> (gdb) c
> Continuing.
> 
> Breakpoint 1, no_package (n=0x10405f78) at package.d:1127
> 1127      FEpackage_error(n,"A package with this name does not exist");
> (gdb) c
> Continuing.
> 
> Breakpoint 2, Lintern () at package.d:867
> 867             check_type_string(&strng);
> (gdb) c
> Continuing.
> 
> Breakpoint 3, coerce_to_package (p=0x10103d34) at package.d:322
> 322             if (type_of(p) == t_package)
> (gdb) c
> Continuing.
> 
> Error in INTERN [or a callee]: A package error occurred on "foo": "A package
> wit
> h this name does not exist".
> 
> Fast links are on: do (use-fast-links nil) for debugging
> Broken at INTERN.  Type :H for Help.
>  1 (Continue)
>  2 Return to top level.
> dbl:>>1
> 
> Breakpoint 4, unwind (fr=0x6573bc, tag=0x10315da4) at frame.c:34
> 34              signals_allowed = 0;
> (gdb) s
> 35              nlj_fr = fr;
> (gdb) n
> 36              nlj_tag = tag;
> (gdb) n
> 37              nlj_active = TRUE;
> (gdb) p *fr
> $8 = {frs_jmpbuf = {2291432, 271670728, 544501349, 1953394531, 2291324,
>     4831191, 2293728, 0, 0, 0, 0, 0, 0, 0, 0, 0}, frs_lex = 0x6c148c,
>   frs_bds_top = 0x652a20, frs_class = 0 '\0', frs_in_signal_handler = 0
> '\0',
>   frs_val = 0x1035af70, frs_ihs = 0x6b8700}
> (gdb) p pp(tag)
> G2329$9 = void
> (gdb) n
> 38              while (frs_top != fr
> (gdb) p frs_top
> $10 = 0x657464
> (gdb) n
> 46                      --frs_top;
> (gdb) n
> 38              while (frs_top != fr
> (gdb) n
> 46                      --frs_top;
> (gdb) n
> 38              while (frs_top != fr
> (gdb) n
> 48              if (frs_top<frs_org) {
> (gdb) p frs_top
> $11 = 0x6573bc
> (gdb) p frs_org
> $12 = 0x6572c0
> (gdb) n
> 52              lex_env = frs_top->frs_lex;
> (gdb) n
> 53              ihs_top = frs_top->frs_ihs;
> (gdb) n
> 54              bds_unwind(frs_top->frs_bds_top);
> (gdb) p lex_env
> $13 = (object *) 0x6c148c
> (gdb) p ihs_top
> $14 = 0x6b8700
> (gdb) s
> bds_unwind (new_bds_top=0x652a20) at bds.c:33
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) p bds_top
> $15 = 0x652b20
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) p bds_top->bds_val
> $16 = 0x103d94ec
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) p bds_top
> $17 = 0x652b20
> (gdb) p new_bds_top
> $18 = 0x652a20
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) p bds_top->bds_val
> $19 = 0x103e9dbc
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) p new_bds_top
> $20 = 0x652a20
> (gdb) p bds_top
> $21 = 0x652b10
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) n
> 34                      (bds_top->bds_sym)->s.s_dbind = bds_top->bds_val;
> (gdb) n
> 33              for (;  bds_top > new_bds_top;  bds_top--)
> (gdb) p bds_top
> $22 = 0x652ac0
> (gdb) b 35
> Breakpoint 5 at 0x48ae1b: file bds.c, line 35.
> (gdb) c
> Continuing.
> 
> Breakpoint 5, bds_unwind (new_bds_top=0x652a20) at bds.c:35
> 35      }
> (gdb) n
> unwind (fr=0x6573bc, tag=0x10315da4) at frame.c:55
> 55              in_signal_handler = frs_top->frs_in_signal_handler;
> (gdb) p frs_top->frs_in_signal_handler
> $23 = 0 '\0'
> (gdb) n
> 56              signals_allowed=sig_normal;
> (gdb) n
> 57              longjmp(frs_top->frs_jmpbuf, 0);
> (gdb) p frs_top->frs_jmpbuf
> $24 = {2291432, 271670728, 544501349, 1953394531, 2291324, 4831191, 2293728,
>   0, 0, 0, 0, 0, 0, 0, 0, 0}
> (gdb) n
> 
> Program received signal SIGSEGV, Segmentation fault.
> 0x00452c1a in intern (st=0x10405fa8, p=0x651a90) at package.d:401
> 401             for (l = *ip;  type_of(l) == t_cons;  l = l->c.c_cdr)
> (gdb) info frame
> Stack level 0, frame at 0x22f880:
>  eip = 0x452c1a in intern (package.d:401); saved eip 0x454608
>  called by frame at 0x22f8b0
>  source language c.
>  Arglist at 0x22f878, args: st=0x10405fa8, p=0x651a90
>  Locals at 0x22f878, Previous frame's sp is 0x22f880
>  Saved registers:
>   ebx at 0x22f874, ebp at 0x22f878, eip at 0x22f87c
> (gdb) info registers
> eax            0x8      8
> ecx            0x651a90 6625936
> edx            0x0      0
> ebx            0x651a90 6625936
> esp            0x22f840 0x22f840
> ebp            0x22f878 0x22f878
> esi            0x746e6f63       1953394531
> edi            0x20746e65       544501349
> eip            0x452c1a 0x452c1a
> eflags         0x10206  66054
> cs             0x1b     27
> ss             0x23     35
> ds             0x23     35
> es             0x23     35
> fs             0x38     56
> gs             0x0      0
> (gdb) bt
> #0  0x00452c1a in intern (st=0x10405fa8, 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  0x0041f981 in fLeval (x0=0x103e9f18) at eval.c:1178
> #4  0x00431dc6 in c_apply_n (fn=0x41f925 <fLeval>, n=1, x=0x6c1488)
>     at funlink.c:363
> #5  0x0044aa7b in IapplyVector (fun=0x10107e24, nargs=1, base=0x6c1488)
>     at nfunlink.c:229
> #6  0x0041d5b7 in funcall (fun=0x10107e24) at eval.c:190
> #7  0x0041e57f in symlispcall (sym=0x10109ad4, base=0x6c1484, narg=1)
>     at eval.c:507
> #8  0x0060ef1a in LI1 () at gcl_top.c:140
> #9  0x0041ca1c in quick_call_sfun (fun=0x10131fdc) at eval.c:117
> #10 0x0041d533 in funcall (fun=0x10131fdc) at eval.c:178
> #11 0x0044abbc in IapplyVector (fun=0x10131fdc, nargs=0, base=0x6c145c)
>     at nfunlink.c:239
> #12 0x0041f703 in fLfuncall (fun=0x10131fdc) at eval.c:1140
> #13 0x00431dc6 in c_apply_n (fn=0x41f678 <fLfuncall>, n=1, x=0x6c1458)
>     at funlink.c:363
> #14 0x0044aa7b in IapplyVector (fun=0x10107e4c, nargs=1, base=0x6c1458)
>     at nfunlink.c:229
> #15 0x0041d5b7 in funcall (fun=0x10107e4c) at eval.c:190
> #16 0x0041df01 in funcall_no_event (fun=0x10107e4c) at eval.c:381
> ---Type <return> to continue, or q <return> to quit---
> #17 0x0041f494 in eval (form=0x651a90) at eval.c:1092
> #18 0x0041dc47 in funcall (fun=0x1035afe8) at eval.c:327
> #19 0x0041df01 in funcall_no_event (fun=0x103e9954) at eval.c:381
> #20 0x0041f494 in eval (form=0x651a90) at eval.c:1092
> #21 0x0041dc47 in funcall (fun=0x1035aff0) at eval.c:327
> #22 0x0041ec95 in super_funcall (fun=0x103e9fb4) at eval.c:743
> #23 0x00402c67 in main (argc=1, argv=0xca41e0, envp=0xca2ef0) at main.c:296
> (gdb)
> 
> 
> 
> 
> 

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