[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
RE: [Gcl-devel] memory damaged at (system:STRING-MATCH :anykey:verbose)
|
From: |
Mike Thomas |
|
Subject: |
RE: [Gcl-devel] memory damaged at (system:STRING-MATCH :anykey:verbose) |
|
Date: |
Wed, 7 Jul 2004 15:58:38 +1000 |
Hi Camm.
| I think I've just stumbled on a very useful tool for uses like this
| from reading the lush source.
Thanks - this has been very helpful as I can now see where the problem has
occurred in the C code itself (a fixnum object on the value stack treated as
a cons cell) - but still backtracking through the initialisation to see why
this happened as detailed below.
In the discussion below I'm running HEAD GCL.
| I'm assuming you can reproduce this crash with --enable-debug.
Yes.
| With
| such a GCL, do (setq compiler::*default-c-file* t) before compiling
| maxima, then build as usual up to this point.
|
| Rerun gdb, and break at fasload, conditionalized on the load of the
| file in question (specfn.o). finish the load, and then in gdb, type
|
| add-symbol-file src/specfn.o 0x.....
|
| where the address is that reported by the fasload just completed.
| Then you should be able to break and step through the specfn.c source
| like any other gcl C source file. In particular, you will see a real
| backtrace of this level.
|
| In your particular case, you might not be able to finish the whole
| load without triggering the error. Then just break at the
| read_fasl_vector or some such call toward the end of fasload. By this
| time, you will have loaded the code and know what the address is, and
| so can issue the add-symbol-file command before continuing through the
| fasl vector read.
Here what I've done is to use the short test sent by Michael, set a
breakpoint at call_init(), run gcl under gdb and at the lisp prompt:
==============================================================
>
(setq compiler::*default-c-file* t)(setq compiler::*default-h-file* t)(setq
comp
iler::*default-data-file* t)(compile-file "specfntest.lsp")(load
"specfntest.o")
T
>
T
>
T
>
Compiling specfntest.lsp.
; (IMPORT 'SLOOP:SLOOP) is being compiled.
;; Warning: The package operation (IMPORT 'SLOOP:SLOOP) was in a bad place.
End of Pass 1.
End of Pass 2.
`-mcpu=' is deprecated. Use `-mtune=' or '-march=' instead.
OPTIMIZE levels: Safety=0 (No runtime error checking), Space=0, Speed=3
Finished compiling specfntest.lsp.
#p"specfntest.o"
>
Loading specfntest.o
Breakpoint 1, fasload (faslfile=0x1a2943f0) at sfasl.c:182
182 int init_address=0;
(gdb) c
Continuing.
Breakpoint 2, call_init (init_address=0, memory=0x1a031d34,
fasl_vec=0x1a52294c, fptr=0) at cmpaux.c:315
315 check_type(fasl_vec,t_vector);
(gdb) n
316 form=(fasl_vec->v.v_self[fasl_vec->v.v_fillp -1]);
(gdb) n
318 if (fptr) at = fptr;
(gdb) n
320 at=(FUNC)(memory->cfd.cfd_start+ init_address );
(gdb) n
326 if (type_of(form)==t_cons &&
(gdb) n
328 {bds_bind(sSPinit,fasl_vec);
(gdb) p at
$1 = 0x1a6f6000 <init_code>
(gdb) add-symbol-file specfntest.o 0x1a6f6000
add symbol table from file "specfntest.o" at
.text_addr = 0x1a6f6000
Reading symbols from specfntest.o...done.
(gdb) b make_cclosure_new
Breakpoint 6 at 0x4152d3: file cfun.c, line 88.
(gdb) c
Continuing.
Breakpoint 6, make_cclosure_new (self=0x1a6f736c <LC6>, name=0x6d6ab0,
env=0x1a5a9300, data=0x1a031d34) at cfun.c:88
88 cc = alloc_object(t_cclosure);
(gdb) bt
#0 make_cclosure_new (self=0x1a6f736c <LC6>, name=0x6d6ab0, env=0x1a5a9300,
data=0x1a031d34) at cfun.c:88
#1 0x1a6f62f5 in L2 () at specfntest.c:5213
#2 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
#3 0x004130a5 in letA_bind (body=0x1a5aa0a8, start=0x7465bc, end=0x7465dc)
at bind.c:699
#4 0x0043cb68 in FletA (form=0x1a5aa21c) at let.c:106
#5 0x0041ebbb in eval (form=0x1a5aa4e0) at eval.c:1037
#6 0x00418efb in do_init (statVV=0x1a6f7690) at cmpaux.c:409
#7 0x1a6f6013 in init_code () at specfntest.c:5171
#8 0x00418d63 in call_init (init_address=0, memory=0x1a031d34,
fasl_vec=0x1a52294c, fptr=0) at cmpaux.c:333
#9 0x0046d550 in fasload (faslfile=0x1a288b1c) at sfasl.c:465
#10 0x00427f21 in Lload () at file.d:1842
#11 0x00495722 in L13 () at clcs_install.c:569
#12 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
#13 0x0041f317 in fLeval (x0=0x1a5aa8e8) at eval.c:1178
#14 0x00430a3f in c_apply_n (fn=0x41f2bb <fLeval>, n=1, x=0x746538)
at funlink.c:363
#15 0x00448e78 in IapplyVector (fun=0x1a007e24, nargs=1, base=0x746538)
at nfunlink.c:229
#16 0x0041cf96 in funcall (fun=0x1a007e24) at eval.c:190
#17 0x0041df30 in symlispcall (sym=0x1a009a8c, base=0x40361c, narg=1)
---Type <return> to continue, or q <return> to quit---q
at eval.c:Quit (expect signal SIGINT when the program is resumed)
(gdb) whatis base[2]
No symbol "base" in current context.
(gdb) up
#1 0x1a6f62f5 in L2 () at specfntest.c:5213
5213 base[3]=
(gdb) whatis base[2]
type = object
(gdb) p (enum type) base[2]->d.t
$2 = t_cons
(gdb) whatis Cdata
No symbol "Cdata" in current context.
(gdb) down
#0 make_cclosure_new (self=0x1a6f736c <LC6>, name=0x6d6ab0, env=0x1a5a9300,
data=0x1a031d34) at cfun.c:88
88 cc = alloc_object(t_cclosure);
(gdb) p (enum type) self->d.t
Attempt to extract a component of a value that is not a structure pointer.
(gdb) whatis self
type = void (*)()
(gdb) whatis 0x1a5a9300
type = int
(gdb) whatis name
type = object
(gdb) p (enum type) name->d.t
$3 = t_symbol
(gdb) p (enum type) env->d.t
$4 = t_cons
(gdb) p (enum type) data->d.t
$5 = t_cfdata
(gdb) n
89 cc->cc.cc_self = self;
(gdb) n
90 cc->cc.cc_name = name;
(gdb) n
91 cc->cc.cc_env = env;
(gdb) n
92 cc->cc.cc_data = data;
(gdb) n
93 cc->cc.cc_turbo = NULL;
(gdb) n
94 return(cc);
(gdb) n
95 }
(gdb) n
L2 () at specfntest.c:5215
5215 vs_top=(vs_base=base+3)+1;
(gdb) n
5217 }
(gdb) n
eval (form=0x6d6ab0) at eval.c:1094
1094 ihs_pop();
(gdb) n
1095 return;
(gdb) n
1107 }
(gdb) n
letA_bind (body=0x1a5aa0a8, start=0x7465bc, end=0x7465dc) at bind.c:700
700 bind_var(bt->bt_var, bt->bt_init, bt->bt_spp);
(gdb) bt
#0 letA_bind (body=0x1a5aa0a8, start=0x7465bc, end=0x7465dc) at bind.c:700
#1 0x0043cb68 in FletA (form=0x1a5aa21c) at let.c:106
#2 0x0041ebbb in eval (form=0x1a5aa4e0) at eval.c:1037
#3 0x00418efb in do_init (statVV=0x1a6f7690) at cmpaux.c:409
#4 0x1a6f6013 in init_code () at specfntest.c:5171
#5 0x00418d63 in call_init (init_address=0, memory=0x1a031d34,
fasl_vec=0x1a52294c, fptr=0) at cmpaux.c:333
#6 0x0046d550 in fasload (faslfile=0x1a288b1c) at sfasl.c:465
#7 0x00427f21 in Lload () at file.d:1842
#8 0x00495722 in L13 () at clcs_install.c:569
#9 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
#10 0x0041f317 in fLeval (x0=0x1a5aa8e8) at eval.c:1178
#11 0x00430a3f in c_apply_n (fn=0x41f2bb <fLeval>, n=1, x=0x746538)
at funlink.c:363
#12 0x00448e78 in IapplyVector (fun=0x1a007e24, nargs=1, base=0x746538)
at nfunlink.c:229
#13 0x0041cf96 in funcall (fun=0x1a007e24) at eval.c:190
#14 0x0041df30 in symlispcall (sym=0x1a009a8c, base=0x40361c, narg=1)
at eval.c:507
#15 0x006933ff in LI1 () at gcl_top.c:140
#16 0x0041c4c8 in quick_call_sfun (fun=0x1a007028) at eval.c:117
#17 0x0041cf12 in funcall (fun=0x1a007028) at eval.c:178
#18 0x00448fbb in IapplyVector (fun=0x1a007028, nargs=0, base=0x74650c)
---Type <return> to continue, or q <return> to quit---q
at nfunlQuit (expect signal SIGINT when the program is resumed)
(gdb) n
698 for (bt = start; bt < end; bt++) {
(gdb) n
702 return(vs_pop);
(gdb) n
703 }
(gdb) n
FletA (form=0x1a5aa21c) at let.c:107
107 vs_top = (object *)start;
(gdb) n
108 vs_push(body);
(gdb) n
110 Fprogn(body);
(gdb) n
112 lex_env = old_lex;
(gdb) n
113 bds_unwind(old_bds_top);
(gdb) n
114 }
(gdb) n
eval (form=0x1a5aa4e0) at eval.c:1039
1039 ihs_pop();
(gdb) n
1040 return;
(gdb) n
1107 }
(gdb) n
do_init (statVV=0x1a6f7690) at cmpaux.c:410
410 vs_top=top;
(gdb) s
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) bt
#0 do_init (statVV=0x1a6f7690) at cmpaux.c:407
#1 0x1a6f6013 in init_code () at specfntest.c:5171
#2 0x00418d63 in call_init (init_address=0, memory=0x1a031d34,
fasl_vec=0x1a52294c, fptr=0) at cmpaux.c:333
#3 0x0046d550 in fasload (faslfile=0x1a288b1c) at sfasl.c:465
#4 0x00427f21 in Lload () at file.d:1842
#5 0x00495722 in L13 () at clcs_install.c:569
#6 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
#7 0x0041f317 in fLeval (x0=0x1a5aa8e8) at eval.c:1178
#8 0x00430a3f in c_apply_n (fn=0x41f2bb <fLeval>, n=1, x=0x746538)
at funlink.c:363
#9 0x00448e78 in IapplyVector (fun=0x1a007e24, nargs=1, base=0x746538)
at nfunlink.c:229
#10 0x0041cf96 in funcall (fun=0x1a007e24) at eval.c:190
#11 0x0041df30 in symlispcall (sym=0x1a009a8c, base=0x40361c, narg=1)
at eval.c:507
#12 0x006933ff in LI1 () at gcl_top.c:140
#13 0x0041c4c8 in quick_call_sfun (fun=0x1a007028) at eval.c:117
#14 0x0041cf12 in funcall (fun=0x1a007028) at eval.c:178
#15 0x00448fbb in IapplyVector (fun=0x1a007028, nargs=0, base=0x74650c)
at nfunlink.c:239
#16 0x0041f09e in fLfuncall (fun=0x1a007028) at eval.c:1140
#17 0x00430a3f in c_apply_n (fn=0x41f015 <fLfuncall>, n=1, x=0x746508)
---Type <return> to continue, or q <return> to quit---
at funlink.c:363
#18 0x00448e78 in IapplyVector (fun=0x1a007e4c, nargs=1, base=0x746508)
at nfunlink.c:229
#19 0x0041cf96 in funcall (fun=0x1a007e4c) at eval.c:190
#20 0x0041d8bb in funcall_no_event (fun=0x1a007e4c) at eval.c:381
#21 0x0041ee33 in eval (form=0x6d6ab0) at eval.c:1092
#22 0x0041d620 in funcall (fun=0x1a49bfe8) at eval.c:327
#23 0x0041d8bb in funcall_no_event (fun=0x1a619b7c) at eval.c:381
#24 0x0041ee33 in eval (form=0x6d6ab0) at eval.c:1092
#25 0x0041d620 in funcall (fun=0x1a49bff0) at eval.c:327
#26 0x0041e63d in super_funcall (fun=0x1a619fb4) at eval.c:743
#27 0x004029ac in main (argc=1, argv=0x3d2cf8, envp=0x3d2fe0) at main.c:322
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
Breakpoint 6, make_cclosure_new (self=0x1a6f736c <LC6>, name=0x6d6ab0,
env=0x1a5a91ec, data=0x1a031d34) at cfun.c:88
88 cc = alloc_object(t_cclosure);
(gdb) n
89 cc->cc.cc_self = self;
(gdb) n
90 cc->cc.cc_name = name;
(gdb) n
91 cc->cc.cc_env = env;
(gdb) n
92 cc->cc.cc_data = data;
(gdb) n
93 cc->cc.cc_turbo = NULL;
(gdb) n
94 return(cc);
(gdb) n
95 }
(gdb) n
L2 () at specfntest.c:5215
5215 vs_top=(vs_base=base+3)+1;
(gdb) n
5217 }
(gdb) n
eval (form=0x6d6ab0) at eval.c:1094
1094 ihs_pop();
(gdb) n
1095 return;
(gdb) n
1107 }
(gdb) n
letA_bind (body=0x1a5a9d98, start=0x7465bc, end=0x7465dc) at bind.c:700
700 bind_var(bt->bt_var, bt->bt_init, bt->bt_spp);
(gdb) n
698 for (bt = start; bt < end; bt++) {
(gdb) n
702 return(vs_pop);
(gdb) n
703 }
(gdb) n
FletA (form=0x1a5a9ef4) at let.c:107
107 vs_top = (object *)start;
(gdb) n
108 vs_push(body);
(gdb) n
110 Fprogn(body);
(gdb) n
112 lex_env = old_lex;
(gdb) n
113 bds_unwind(old_bds_top);
(gdb) n
114 }
(gdb) n
eval (form=0x1a5aa09c) at eval.c:1039
1039 ihs_pop();
(gdb) n
1040 return;
(gdb) n
1107 }
(gdb) n
do_init (statVV=0x1a6f7690) at cmpaux.c:410
410 vs_top=top;
(gdb) n
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
410 vs_top=top;
(gdb) n
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
410 vs_top=top;
(gdb) n
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
410 vs_top=top;
(gdb) n
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
410 vs_top=top;
(gdb) n
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
410 vs_top=top;
(gdb) n
407 for(i=0 ; i< form->v.v_fillp; i++)
(gdb) n
409 eval(form->v.v_self[i]);
(gdb) n
Program received signal SIGSEGV, Segmentation fault.
0x1a6f73dd in LC6 (base0=0x7465c8) at specfntest.c:5642
5642 V49= CMPcar((V45));
(gdb) p (enum type) V45->d.t
(gdb) p V45
$6 = 0xf
(gdb) p V42
$7 = 0x73b0b8
(gdb) p (enum type) V42->d.t
$8 = t_fixnum
(gdb) p (enum type) V42->d
$9 = 16777217
(gdb) p V42->d
$10 = {t = 1 '\001', flag = 0 '\0', s = 0 '\0', m = 1 '\001'}
(gdb) p form->v
No symbol "form" in current context.
(gdb) bt
#0 0x1a6f73dd in LC6 (base0=0x7465c8) at specfntest.c:5642
#1 0x0041d18e in funcall (fun=0x1a5228dc) at eval.c:213
#2 0x004303d9 in call_or_link (sym=0x1a289a68, link=0x1a6f774c)
at funlink.c:90
#3 0x1a6f7629 in LnkT32 () at specfntest.c:5707
#4 0x1a6f64c2 in L3 () at specfntest.c:5262
#5 0x004303cc in call_or_link (sym=0x1a2899fc, link=0x1a6f7738)
at funlink.c:88
#6 0x1a6f7593 in LnkT38 () at specfntest.c:5702
#7 0x1a6f72b3 in L5 () at specfntest.c:5568
#8 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
#9 0x00418efb in do_init (statVV=0x1a6f7690) at cmpaux.c:409
#10 0x1a6f6013 in init_code () at specfntest.c:5171
#11 0x00418d63 in call_init (init_address=0, memory=0x1a031d34,
fasl_vec=0x1a52294c, fptr=0) at cmpaux.c:333
#12 0x0046d550 in fasload (faslfile=0x1a288b1c) at sfasl.c:465
#13 0x00427f21 in Lload () at file.d:1842
#14 0x00495722 in L13 () at clcs_install.c:569
#15 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
#16 0x0041f317 in fLeval (x0=0x1a5aa8e8) at eval.c:1178
#17 0x00430a3f in c_apply_n (fn=0x41f2bb <fLeval>, n=1, x=0x746538)
at funlink.c:363
#18 0x00448e78 in IapplyVector (fun=0x1a007e24, nargs=1, base=0x746538)
---Type <return> to continue, or q <return> to quit---q
at nfunlQuit (expect signal SIGINT when the program is resumed)
(gdb) up 9
#9 0x00418efb in do_init (statVV=0x1a6f7690) at cmpaux.c:409
409 eval(form->v.v_self[i]);
(gdb) p form->v
$11 = {t = 12 '\f', flag = 0 '\0', s = 0 '\0', m = 0 '\0',
v_displaced = 0x6d6ab0, v_hasfillp = 0, v_elttype = 0, v_self =
0x1da39ba8,
v_fillp = 16, v_dim = 16, v_adjustable = 0, v_offset = 0}
(gdb) p (enum type) form->v->d.t
There is no member named d.
(gdb) whatis form->v.v_self[i]
type = object
(gdb) p form->v.v_self[i]->d.t
$12 = 0 '\0'
(gdb) p (enum type) form->v.v_self[i]->d.t
$13 = t_cons
(gdb) down
#8 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
1090 (*(x)->cf.cf_self)();
(gdb) p (*(x)->cf.cf_self)
$14 = {void ()} 0x1a6f7035 <L5>
(gdb) down 6
#2 0x004303d9 in call_or_link (sym=0x1a289a68, link=0x1a6f774c)
at funlink.c:90
90 funcall(fun);
(gdb) whatis fun
type = object
(gdb) p (enum type) fun->d.t
$15 = t_cclosure
(gdb) p vs_base
$16 = (object *) 0x7465d4
(gdb) p vs_base[0]
$17 = 0x73b0b8
(gdb) p vs_base[1]
$18 = 0x73b048
(gdb) p vs_base[2]
$19 = 0x73b040
(gdb) whatis vs_base[0]
type = object
(gdb) down
#1 0x0041d18e in funcall (fun=0x1a5228dc) at eval.c:213
213 MMccall(fun, top);
(gdb) p vs_base[0]
$20 = 0x73b0b8
(gdb) p vs_base[1]
$21 = 0x73b048
(gdb) down
#0 0x1a6f73dd in LC6 (base0=0x7465c8) at specfntest.c:5642
5642 V49= CMPcar((V45));
(gdb) p vs_base[0]
$22 = 0x73b0b8
(gdb) whatis vs_base[0]
type = object
(gdb) p (enum type) vs_base[0]->d.t
$23 = t_fixnum
(gdb) up 3
#3 0x1a6f7629 in LnkT32 () at specfntest.c:5707
5707 static void LnkT32(){ call_or_link(VV[32],(void **)(void *)&Lnk32);}
/*
F- */
(gdb) p vs_base[0]
$24 = 0x73b0b8
(gdb) up
#4 0x1a6f64c2 in L3 () at specfntest.c:5262
5262 (void) (*Lnk32)();
(gdb) up
#5 0x004303cc in call_or_link (sym=0x1a2899fc, link=0x1a6f7738)
at funlink.c:88
88 ( *(void (*)()) (fun->cf.cf_self)) ();
(gdb) p vs_base[0]
$25 = 0x73b0b8
(gdb) up
#6 0x1a6f7593 in LnkT38 () at specfntest.c:5702
5702 static void LnkT38(){ call_or_link(VV[38],(void **)(void *)&Lnk38);}
/*
SET-UP-CURSOR */
(gdb) p vs_base[0]
$26 = 0x73b0b8
(gdb) up
#7 0x1a6f72b3 in L5 () at specfntest.c:5568
5568 (void) (*Lnk38)();
(gdb) p vs_base[0]
$27 = 0x73b0b8
(gdb) up
#8 0x0041ee26 in eval (form=0x6d6ab0) at eval.c:1090
1090 (*(x)->cf.cf_self)();
(gdb) p vs_base[0]
$28 = 0x73b0b8
(gdb) up
#9 0x00418efb in do_init (statVV=0x1a6f7690) at cmpaux.c:409
409 eval(form->v.v_self[i]);
(gdb) p vs_base[0]
$29 = 0x73b0b8
(gdb) up
#10 0x1a6f6013 in init_code () at specfntest.c:5171
5171 void init_code(){do_init(VV);}
(gdb) p vs_base[0]
$30 = 0x73b0b8
(gdb) up
#11 0x00418d63 in call_init (init_address=0, memory=0x1a031d34,
fasl_vec=0x1a52294c, fptr=0) at cmpaux.c:333
333 (*at)();
(gdb) p vs_base[0]
$31 = 0x73b0b8
(gdb) p (enum type) vs_base[0]->d.t
$32 = t_fixnum
(gdb)
==============================================================
The C and Lisp code is below. In L6 V45 is set to the value returned by an
erroneous attempt to treat V42 as a cons cell by taking its cdr, V42 has
been taken in turn off the value stack on entry to V46.
LC6 is a local function closure passed by L2 (C compiled make-operation) to
make_cclosure_new.
The return value of make_cclosure_new has in turn been left on the value
stack by L2.
At this point I gave up for the day.
Cheers
Mike Thomas.
==============================================================
#include "specfntest.h"
void init_code(){do_init(VV);}
/* macro definition for DEF-OP */
static void L1()
{register object *base=vs_base;
register object *sup=base+VM1; VC1
vs_check;
check_arg(2);
vs_top=sup;
{object V1=base[0]->c.c_cdr;
base[2]= (V1->c.c_car);
V1=V1->c.c_cdr;
base[3]= (V1->c.c_car);
V1=V1->c.c_cdr;
base[4]= (V1->c.c_car);
V1=V1->c.c_cdr;
if(endp(V1)){
base[5]= Cnil;
} else {
base[5]= (V1->c.c_car);}}
V2= list(2,VV[1],list(2,VV[2],base[2]));
V3= list(2,VV[2],base[3]);
V4= list(2,VV[2],base[4]);
base[6]= list(3,VV[0],/* INLINE-ARGS */V2,list(4,VV[3],/* INLINE-ARGS
*/V3,/* INLINE-ARGS */V4,list(2,VV[2],base[5])));
vs_top=(vs_base=base+6)+1;
return;
}
/* function definition for MAKE-OPERATION */
static void L2()
{register object *base=vs_base;
register object *sup=base+VM2; VC2
vs_check;
base[0]=MMcons(base[0],Cnil);
base[1]=MMcons(base[1],base[0]);
base[2]=MMcons(base[2],base[1]);
vs_top=sup;
if((base[2]->c.c_car)!=Cnil){
goto T2;}
(base[2]->c.c_car)= (base[0]->c.c_car);
goto T2;
T2:;
base[3]=
make_cclosure_new(LC6,Cnil,base[2],Cdata);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for SET-UP-CURSOR */
static void L3()
{register object *base=vs_base;
register object *sup=base+VM3; VC3
vs_check;
{object V5;
V5=(base[0]);
vs_top=sup;
goto TTL;
TTL:;
if((VV[5]->s.s_dbind)!=Cnil){
goto T4;}
(VV[5]->s.s_dbind)=
(VFUN_NARGS=5,(*(LnkLI30))(small_fixnum(11),VV[6],VV[7],VV[8],small_fixnum(0
)));
goto T4;
T4:;
{object V6;
V6= (*(LnkLI31))((V5));
V7 = CMPmake_fixnum((long)length((V6)));
(void)(aset1((VV[5]->s.s_dbind),fix(small_fixnum(0)),V7));
{register object V8;
register object V9;
V8= Cnil;
V9= (V6);
{register long V10;
V10= (long)6;
goto T11;
T11:;
if(((V9))==Cnil){
goto T14;}
goto T13;
goto T14;
T14:;
goto T12;
goto T13;
T13:;
{register object V11;
V11= CMPcar((V9));
V8= (V11);}{object V12;
V12= (VV[5]->s.s_dbind);
V13 = CMPmake_fixnum(V10);
base[1]= (V8);
base[2]= small_fixnum(1);
vs_top=(vs_base=base+1)+2;
(void) (*Lnk32)();
vs_top=sup;
V14= vs_base[0];
(void)(aset1(V12,fix(V13),V14));}
V9= CMPcdr((V9));
if(!((V10)<((long)2147483646))){
goto T26;}
goto T25;
goto T26;
T26:;
vs_base=vs_top;
(void) (*Lnk33)();
vs_top=sup;
goto T25;
T25:;
V10= (long)(V10)+((long)1);
goto T11;
goto T12;
T12:;
goto T8;
goto T8;}}
goto T8;
T8:;
{register long V15;
register long V16;
V15= (long)1;
{object V17;
V17= CMPmake_fixnum((long)length((V6)));{object V18;
V19= number_plus((V17),small_fixnum(1));
V18= (type_of(/* INLINE-ARGS */V19)==t_fixnum?Ct:Cnil);
if(V18==Cnil)goto T35;
goto T34;
goto T35;
T35:;}
vs_base=vs_top;
(void) (*Lnk33)();
vs_top=sup;
goto T34;
T34:;
V16= fix((V17));}
goto T38;
T38:;
if((V15)>(V16)){
goto T41;}
goto T40;
goto T41;
T41:;
goto T39;
goto T40;
T40:;
V20 = CMPmake_fixnum(V15);
(void)(aset1((VV[5]->s.s_dbind),fix(V20),small_fixnum(0)));
V15= (long)(V15)+((long)1);
goto T38;
goto T39;
T39:;
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;
base[1]= Cnil;
vs_top=(vs_base=base+1)+1;
return;}}
}
}
/* function definition for ASET-BY-CURSOR */
static void L4()
{register object *base=vs_base;
register object *sup=base+VM4; VC4
vs_check;
{register object V21;
register object V22;
V21=(base[0]);
V22=(base[1]);
vs_top=sup;
goto TTL;
TTL:;
{register object V23;
V23= (VV[5]->s.s_dbind);
{object V24;
V24= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)0]);
{object V25= (V24);
if(!eql(V25,VV[10]))goto T49;
V26 = CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)1]);
(void)(aset1((V21),fix(V26),(V22)));
goto T47;
goto T49;
T49:;
if(!eql(V25,VV[11]))goto T50;
V27 = CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)1]);
V28 = CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)2]);
(void)(aset((V21),fix(V27)*((V21))->a.a_dims[1]+fix(V28),(V22)));
goto T47;
goto T50;
T50:;
if(!eql(V25,VV[12]))goto T51;
base[2]= (V21);
base[3]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)1]);
base[4]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)2]);
base[5]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)3]);
base[6]= (V22);
vs_top=(vs_base=base+2)+5;
siLaset();
vs_top=sup;
goto T47;
goto T51;
T51:;
if(!eql(V25,VV[13]))goto T57;
base[2]= (V21);
base[3]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)1]);
base[4]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)2]);
base[5]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)3]);
base[6]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)4]);
base[7]= (V22);
vs_top=(vs_base=base+2)+6;
siLaset();
vs_top=sup;
goto T47;
goto T57;
T57:;
if(!eql(V25,VV[14]))goto T64;
base[2]= (V21);
base[3]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)1]);
base[4]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)2]);
base[5]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)3]);
base[6]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)4]);
base[7]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)5]);
base[8]= (V22);
vs_top=(vs_base=base+2)+7;
siLaset();
vs_top=sup;
goto T47;
goto T64;
T64:;
base[2]= VV[15];
base[3]= VV[16];
base[4]= VV[17];
base[5]= VV[18];
base[6]= (V24);
base[7]= VV[19];
base[8]= VV[20];
base[9]= VV[21];
base[10]= VV[22];
vs_top=(vs_base=base+2)+9;
(void) (*Lnk34)();
vs_top=sup;}}
goto T47;
T47:;
{register long V29;
{object V30;
V30= CMPmake_fixnum((long)((V23))->fixa.fixa_self[(long)0]);{object V31;
V31= (type_of((V30))==t_fixnum?Ct:Cnil);
if(V31==Cnil)goto T84;
goto T83;
goto T84;
T84:;}
vs_base=vs_top;
(void) (*Lnk33)();
vs_top=sup;
goto T83;
T83:;
V29= fix((V30));}
goto T87;
T87:;
{long V32= (long)((V23))->fixa.fixa_self[V29];
base[2]= small_fixnum(5);
base[3]= CMPmake_fixnum(V29);
vs_top=(vs_base=base+2)+2;
(void) (*Lnk35)();
vs_top=sup;
V33= vs_base[0];
{long V34= fix(aref1((V23),fix(V33)));
if(!((/* INLINE-ARGS */V32)<(/* INLINE-ARGS */V34))){
goto T90;}}}
base[2]= CMPmake_fixnum((long)((V23))->fixa.fixa_self[V29]);
base[3]= small_fixnum(1);
vs_top=(vs_base=base+2)+2;
(void) (*Lnk35)();
vs_top=sup;
V35= vs_base[0];
(void)(((V23))->fixa.fixa_self[V29]= (fix(V35)));
base[2]= Ct;
vs_top=(vs_base=base+2)+1;
return;
goto T90;
T90:;
(void)(((V23))->fixa.fixa_self[V29]= ((long)0));
if(!((V29)==((long)0))){
goto T99;}
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
goto T99;
T99:;
if(!((V29)>((long)-2147483647))){
goto T103;}
goto T102;
goto T103;
T103:;
vs_base=vs_top;
(void) (*Lnk33)();
vs_top=sup;
goto T102;
T102:;
V29= (long)(V29)-((long)1);
goto T87;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;}}
}
}
/* function definition for FILLARRAY */
static void L5()
{register object *base=vs_base;
register object *sup=base+VM5; VC5
vs_check;
{register object V36;
register object V37;
V36=(base[0]);
V37=(base[1]);
vs_top=sup;
goto TTL;
TTL:;
if(!(type_of((V36))==t_symbol)){
goto T109;}
{object V38 =((V36))->s.s_plist;
object ind= VV[24];
while(V38!=Cnil){
if(V38->c.c_car==ind){
V36= (V38->c.c_cdr->c.c_car);
goto T112;
}else V38=V38->c.c_cdr->c.c_cdr;}
V36= Cnil;}
goto T112;
T112:;
goto T109;
T109:;
if(((V37))!=Cnil){
goto T116;}
{object V39;
base[2]= (V36);
vs_top=(vs_base=base+2)+1;
Larray_element_type();
vs_top=sup;
V39= vs_base[0];
{object V40= (V39);
if((V40!= VV[7]))goto T120;
V37= VV[25];
goto T114;
goto T120;
T120:;
if((V40!= VV[36]))goto T121;
V37= VV[26];
goto T114;
goto T121;
T121:;
if((V40!= Ct))goto T122;
V37= VV[27];
goto T114;
goto T122;
T122:;
base[2]= VV[15];
base[3]= VV[16];
base[4]= VV[17];
base[5]= VV[18];
base[6]= (V39);
base[7]= VV[19];
base[8]= VV[28];
base[9]= VV[21];
base[10]= VV[29];
vs_top=(vs_base=base+2)+9;
(void) (*Lnk34)();
vs_top=sup;
V37= vs_base[0];
goto T114;}}
goto T116;
T116:;
if(!(type_of((V37))==t_array||
type_of((V37))==t_vector||
type_of((V37))==t_string||
type_of((V37))==t_bitvector)){
goto T133;}
base[2]= (V37);
vs_top=(vs_base=base+2)+1;
(void) (*Lnk37)();
vs_top=sup;
V37= vs_base[0];
goto T114;
goto T133;
T133:;
if(!(type_of((V37))!=t_cons)){
goto T137;}
V37= make_cons((V37),Cnil);
goto T114;
goto T137;
T137:;
goto T114;
T114:;
if(!(((long)length((V36)))>((long)0))){
goto T140;}
base[2]= (V36);
vs_top=(vs_base=base+2)+1;
(void) (*Lnk38)();
vs_top=sup;
goto T145;
T145:;{object V41;
base[2]= (V36);
base[3]= CMPcar((V37));
vs_top=(vs_base=base+2)+2;
(void) (*Lnk39)();
vs_top=sup;
V41= vs_base[0];
if(V41==Cnil)goto T148;
goto T147;
goto T148;
T148:;}
goto T146;
goto T147;
T147:;
if((CMPcdr((V37)))!=Cnil){
goto T153;}
goto T152;
goto T153;
T153:;
V37= CMPcdr((V37));
goto T152;
T152:;
goto T145;
goto T146;
T146:;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
goto T140;
T140:;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
}
}
/* local function CLOSURE */
static void LC6(base0)
register object *base0;
{ register object *base=vs_base;
register object *sup=base+VM6; VC6
vs_check;
{object V42;
object V43;
V42=(base[0]);
V43=(base[1]);
vs_top=sup;
{register object V44;
register object V45;
object V46;
register object V47;
object V48;
V45= CMPcdr((V42));
V44= Cnil;
V46= Cnil;
V47= Cnil;
V48= Cnil;
goto T160;
T160:;
if(((V45))==Cnil){
goto T163;}
goto T162;
goto T163;
T163:;
goto T161;
goto T162;
T162:;
{object V49;
V49= CMPcar((V45));
V44= (V49);}
if(!((Ct)==((base0[2]->c.c_car)))){
goto T170;}
if(((V47))==Cnil){
goto T173;}
{object V50;
object V51;
V50= (V47);
V47= make_cons((V44),Cnil);
V51= (V47);
((V50))->c.c_cdr = (V51);
goto T168;}
goto T173;
T173:;
V47= make_cons((V44),Cnil);
V46= (V47);
goto T168;
goto T170;
T170:;
V48= list(3,VV[4],(base0[2]->c.c_car),(V44));
if(((V47))==Cnil){
goto T184;}
{object V52;
object V53;
V52= (V47);
V47= make_cons((V48),Cnil);
V53= (V47);
((V52))->c.c_cdr = (V53);
goto T168;}
goto T184;
T184:;
V47= make_cons((V48),Cnil);
V46= (V47);
goto T168;
T168:;
V45= CMPcdr((V45));
goto T160;
goto T161;
T161:;
V46= make_cons((base0[1]->c.c_car),(V46));
if(!((Ct)==((base0[0]->c.c_car)))){
goto T198;}
base[2]= (V46);
vs_top=(vs_base=base+2)+1;
return;
goto T198;
T198:;
base[2]= list(3,VV[4],(base0[0]->c.c_car),(V46));
vs_top=(vs_base=base+2)+1;
return;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
return;}
}
}
static void LnkT39(){ call_or_link(VV[39],(void **)(void *)&Lnk39);} /*
ASET-BY-CURSOR */
static void LnkT38(){ call_or_link(VV[38],(void **)(void *)&Lnk38);} /*
SET-UP-CURSOR */
static void LnkT37(){ call_or_link(VV[37],(void **)(void *)&Lnk37);} /*
LISTARRAY */
static void LnkT35(){ call_or_link(VV[35],(void **)(void *)&Lnk35);} /* F+
*/
static void LnkT34(){ call_or_link(VV[34],(void **)(void *)&Lnk34);} /*
ERROR */
static void LnkT33(){ call_or_link(VV[33],(void **)(void *)&Lnk33);} /*
SLOOP-TYPE-ERROR */
static void LnkT32(){ call_or_link(VV[32],(void **)(void *)&Lnk32);} /* F-
*/
static object LnkTLI31(object first,...){object V1;va_list
ap;va_start(ap,first);V1=call_proc_new(VV[31],(void **)(void
*)&LnkLI31,1,first,ap);va_end(ap);return V1;} /* ARRAY-DIMENSIONS */
static object LnkTLI30(object first,...){object V1;va_list
ap;va_start(ap,first);V1=call_vproc_new(VV[30],(void **)(void
*)&LnkLI30,first,ap);va_end(ap);return V1;} /* MAKE-ARRAY */
==============================================================
(defvar *acursor* nil)
(import 'sloop:sloop)
(defmacro def-op (name type op &optional return-type)
`(setf (macro-function ',name) (make-operation ',type ',op
',return-type)))
;;make very sure .type .op and .return are not special!!
(defun make-operation (.type .op .return)
(or .return (setf .return .type))
#'(lambda (bod env) env
(sloop for v in (cdr bod)
when (eq t .type) collect v into body
else
collect `(the , .type ,v) into body
finally (setq body `(, .op ,@ body))
(return
(if (eq t .return) body
`(the , .return ,body))))))
(def-op f+ fixnum +)
(def-op f- fixnum -)
(defun set-up-cursor (ar)
(or *acursor* (setf *acursor* (make-array 11 :element-type 'fixnum
:initial-element 0)))
(let ((lis (array-dimensions ar)))
(setf (aref *acursor* 0) (length lis))
(sloop for v in lis for i from 6 do (setf (aref *acursor* i) (f- v 1)))
(sloop for i from 1 to (length lis) do (setf (aref *acursor* i) 0))))
(defun aset-by-cursor (ar val)
(let ((curs *acursor*))
(declare (type (lisp::array fixnum) curs))
(ecase (aref curs 0)
(1 (setf (aref ar (aref curs 1)) val))
(2 (setf (aref ar (aref curs 1) (aref curs 2)) val))
(3 (setf (aref ar (aref curs 1) (aref curs 2) (aref curs 3)) val))
(4 (setf (aref ar (aref curs 1) (aref curs 2) (aref curs 3)
(aref curs 4)) val))
(5 (setf (aref ar (aref curs 1) (aref curs 2) (aref curs 3)
(aref curs 4) (aref curs 5)) val)))
;; set the index (`cursor') for the next call to ASET-BY-CURSOR
(sloop for j downfrom (aref curs 0)
do (cond ((< (aref curs j) (aref curs (f+ 5 j)))
(setf (aref curs j) (f+ (aref curs j) 1))
(return-from aset-by-cursor t))
(t (setf (aref curs j) 0)))
(cond ((eql j 0) (return-from aset-by-cursor nil))))))
(defun fillarray (ar x)
(when (symbolp ar)
(setq ar (get ar 'ARRAY)))
#+cl
(when (/= (array-rank ar) 1)
(setq ar (make-array (array-total-size ar) :displaced-to ar)))
(setq x
(cond ((null x)
(ecase (array-element-type ar)
(fixnum '(0))
(float '(0.0))
((t) '(nil))))
((arrayp x)(listarray x))
((atom x) (list x))
(t x)))
(when (> (length ar) 0)
(set-up-cursor ar)
(sloop while (aset-by-cursor ar (car x))
do (and (cdr x) (setq x (cdr x))))))
;;; place this in 2nd file for 2nd test.
(defvar *li2* (make-array 15 :initial-element 0.0))
(eval-when (load eval)
(fillarray *li2*
'(14.0 1.93506430 .166073033 2.48793229e-2 4.68636196e-3
1.0016275e-3 2.32002196e-4 5.68178227e-5 1.44963006e-5
3.81632946e-6 1.02990426e-6 2.83575385e-7 7.9387055e-8
2.2536705e-8 6.474338e-9))
)
- RE: [Gcl-devel] memory damaged at (system:STRING-MATCH :anykey :verbose), Mike Thomas, 2004/07/05
- Re: [Gcl-devel] memory damaged in Maxima, Michael Koehne, 2004/07/05
- Re: [Gcl-devel] memory damaged at (system:STRING-MATCH :anykey :verbose), Camm Maguire, 2004/07/06
- RE: [Gcl-devel] memory damaged at (system:STRING-MATCH :anykey:verbose),
Mike Thomas <=
- Re: [Gcl-devel] memory damaged at (system:STRING-MATCH :anykey:verbose), Camm Maguire, 2004/07/07
- RE: [Gcl-devel] memory damaged at (system:STRING-MATCH:anykey:verbose), Mike Thomas, 2004/07/07
- Re: [Gcl-devel] memory damaged at (system:STRING-MATCH:anykey:verbose), Camm Maguire, 2004/07/07
- RE: [Gcl-devel] memory damaged at (system:STRING-MATCH:anykey:verbose), Mike Thomas, 2004/07/07
- RE: [Gcl-devel] memory damaged at (system:STRING-MATCH:anykey:verbose) - PS, Mike Thomas, 2004/07/08
- Re: [Gcl-devel] memory damaged at (system:STRING-MATCH:anykey:verbose) - PS, Camm Maguire, 2004/07/08
- RE: [Gcl-devel] memory damaged at(system:STRING-MATCH:anykey:verbose) - PS, Mike Thomas, 2004/07/09
- Re: [Gcl-devel] memory damaged at(system:STRING-MATCH:anykey:verbose) - PS, Camm Maguire, 2004/07/12
- RE: [Gcl-devel] memory damaged at(system:STRING-MATCH:anykey:verbose) - PS, Mike Thomas, 2004/07/12