[Gcl-devel] Re: 2.6.7

[Camm Maguire]

Greetings!

export CVS_RSH=ssh
export CVSROOT=:ext:address@hidden:/cvsroot/gcl

cvs -z9 -q co -d gcl-2.6.7pre -r Version_2_6_7pre gcl

BTW, I did see your issue when using full optimization.  gcc 4.0
clobbered a variable across a longjump without warning (typically one
gets a warning in this situation.)  The following mini-patch now in
the 2.6.7pre branch fixes this.  Perhaps you might be able to let the
gcc people know of this situation e.g. file a bug?  I'm too short on
time to do so myself now.

Take care,

=============================================================================
Ftagbody C function -- tinf and tinf_base are stored in registers on
opt level -O3 and clobbered across the longjump without warning using -Wall.
=============================================================================
FFD(Ftagbody)(object body)
{

        object *old_top = vs_top;
        object *new_top;
        VOL object *tinf;           /* These volatile declarations are
                                        needed to fix the problem. */
        VOL object *tinf_base;
        object *env = lex_env;
        object id = alloc_frame_id();
        object bodysv = body;
        object label;
        enum type item_type;

        vs_push(id);
        lex_copy();
        tinf_base = vs_top;
        while (!endp(body)) {
                label = MMcar(body);
                item_type = type_of(label);
                if (item_type == t_symbol || item_type == t_fixnum ||
                    item_type == t_bignum) {
                        lex_tag_bind(label, id);
                        vs_push(label);
                        vs_push(MMcdr(body));
                }
                body = MMcdr(body);
        }

        new_top = vs_top;

        frs_push(FRS_CATCH, id);
        body = bodysv;
        if (nlj_active) {
                label = cdr(nlj_tag);
                nlj_active = FALSE;
                for(tinf = tinf_base;
                    tinf < new_top && !eql(tinf[0],label);
                    tinf += 2)
                        ;
                if (tinf >= new_top)
                        FEerror("Someone tried to RETURN-FROM a TAGBODY.",0);
                body = tinf[1];
        }
        while (body != Cnil) {
                vs_top = new_top;
                item_type = type_of(MMcar(body));
                if (item_type != t_symbol && item_type != t_fixnum &&
                    item_type != t_bignum)
                        eval(MMcar(body));
                body = MMcdr(body);
        }
        frs_pop();
        lex_env = env;
        vs_base = old_top;
        vs_top = old_top+1;
        vs_base[0] = Cnil;
}


=============================================================================
Preprocessed output of above
=============================================================================

# 28 "prog.c" 2
# 47 "prog.c"
void Ftagbody(object body)
{

 object *old_top = vs_top;
 object *new_top;
 volatile object *tinf;
 volatile object *tinf_base;
 object *env = lex_env;
 object id = alloc_object(t_spice);
 object bodysv = body;
 object label;
 enum type item_type;

 (*vs_top++ = (id));
 ihs_top->ihs_base = vs_top; (*vs_top++ = (lex_env[0])); (*vs_top++ = 
(lex_env[1])); (*vs_top++ = (lex_env[2])); lex_env = vs_top - 3;
 tinf_base = vs_top;
 while (!({ static struct cons 
s_my_dot={t_cons,0,0,0,((object)&Dotnil_body),((object)&Dotnil_body)}; object 
_x=(body); bool _b=0; if (((enum type)(((object)(_x))->d.t))==t_cons) { if 
(((enum type)(((object)(_x->c.c_cdr))->d.t))!=t_cons && 
_x->c.c_cdr!=((object)&Cnil_body)) s_my_dot.c_car=_x->c.c_cdr; else 
s_my_dot.c_car=((object)&Dotnil_body); } else { if (_x==s_my_dot.c_car) 
body=(object)&s_my_dot; else { s_my_dot.c_car=((object)&Dotnil_body); if 
(_x==((object)&Cnil_body) || _x==((object)&Dotnil_body)) _b=1; else 
FEwrong_type_argument(sLlist, _x); } } _b; })) {
  label = (body)->c.c_car;
  item_type = ((enum type)(((object)(label))->d.t));
  if (item_type == t_symbol || item_type == t_fixnum ||
             item_type == t_bignum) {
   lex_tag_bind(label, id);
   (*vs_top++ = (label));
   (*vs_top++ = ((body)->c.c_cdr));
  }
  body = (body)->c.c_cdr;
 }

 new_top = vs_top;

 do { frame_ptr _frs_top = frs_top +1; if (_frs_top >= frs_limit) 
frs_overflow(); _frs_top->frs_lex = lex_env; _frs_top->frs_bds_top = bds_top; 
_frs_top->frs_class = (FRS_CATCH); _frs_top->frs_in_signal_handler = 
in_signal_handler; _frs_top->frs_val = (id); _frs_top->frs_ihs = ihs_top; 
frs_top=_frs_top; _setjmp (_frs_top->frs_jmpbuf); } while (0);
 body = bodysv;
 if (nlj_active) {
  label = cdr(nlj_tag);
  nlj_active = 0;
  for(tinf = tinf_base;
      tinf < new_top && !eql(tinf[0],label);
      tinf += 2)
   ;
  if (tinf >= new_top)
   FEerror("Someone tried to RETURN-FROM a TAGBODY.",0);
  body = tinf[1];
 }
 while (body != ((object)&Cnil_body)) {
  vs_top = new_top;
  item_type = ((enum type)(((object)((body)->c.c_car))->d.t));
  if (item_type != t_symbol && item_type != t_fixnum &&
      item_type != t_bignum)
   eval((body)->c.c_car);
  body = (body)->c.c_cdr;
 }
 frs_top--;
 lex_env = env;
 vs_base = old_top;
 vs_top = old_top+1;
 vs_base[0] = ((object)&Cnil_body);
}

=============================================================================


Take care,


Jorge Daza <address@hidden> writes:

> > If you want, I can show you how to get the
> > pre-release from cvs.
> 
> Yes, please, could you tell me ?
> 
> Thanks !
> 
> Jorge
> 
> 
> 

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