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

[Mike Thomas]

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)