Description: TODO: Put a short summary on the line above and replace this paragraph with a longer explanation of this change. Complete the meta-information with other relevant fields (see below for details). To make it easier, the information below has been extracted from the changelog. Adjust it or drop it. . gcl (2.6.12-53) unstable; urgency=medium . * list_order.9 Author: Camm Maguire --- The information above should follow the Patch Tagging Guidelines, please checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here are templates for supplementary fields that you might want to add: Origin: , Bug: Bug-Debian: https://bugs.debian.org/ Bug-Ubuntu: https://launchpad.net/bugs/ Forwarded: Reviewed-By: Last-Update: 2017-08-23 --- gcl-2.6.12.orig/o/print.d +++ gcl-2.6.12/o/print.d @@ -35,12 +35,6 @@ int line_length = 72; #define WRITEC_NEWLINE(strm) (writec_stream('\n',strm)) #endif -#define to_be_escaped(c) \ - (standard_readtable->rt.rt_self[(c)&0377].rte_chattrib \ - != cat_constituent || \ - isLower((c)&0377) || (c) == ':') - - #define READ_TABLE_CASE (Vreadtable->s.s_dbind->rt.rt_case) #define mod(x) ((x)%Q_SIZE) @@ -637,50 +631,31 @@ constant_case(object x) { } static int -all_dots(object x) { - - fixnum i; - - for (i=0;is.s_fillp;i++) - if (x->s.s_self[i]!='.') - return 0; +needs_escape (object x) { - return 1; - -} - -static int -needs_escape (object x,int pp) { - - fixnum i; - char ch; + fixnum i,all_dots=1; + int ch; if (!PRINTescape) return 0; for (i=0;is.s_fillp;i++) switch((ch=x->s.s_self[i])) { - case '(': - case ')': case ':': - case '`': - case '\'': - case '"': - case ';': - case ',': - case '\n': return 1; - case ' ': - if (!i) return 1; + case '.': + break; default: + all_dots=0; + if (Vreadtable->s.s_dbind->rt.rt_self[ch].rte_chattrib!=cat_constituent) + return 1; if ((READ_TABLE_CASE==sKupcase && isLower(ch)) || (READ_TABLE_CASE==sKdowncase && isUpper(ch))) return 1; } - if (pp) - if (potential_number_p(x, PRINTbase) || all_dots(x)) - return 1; + if (potential_number_p(x, PRINTbase) || all_dots) + return 1; return !x->s.s_fillp; @@ -690,19 +665,21 @@ needs_escape (object x,int pp) { #define convertible_lower(c) ((READ_TABLE_CASE==sKdowncase||READ_TABLE_CASE==sKinvert)&& isLower(c)) static void -print_symbol_name_body(object x,int pp) { +print_symbol_name_body(object x) { int i,j,fc,tc,lw,k,cc; cc=constant_case(x); - k=needs_escape(x,pp); + k=needs_escape(x); if (k) write_ch('|'); for (lw=i=0;is.s_fillp;i++) { j = x->s.s_self[i]; - if (PRINTescape && (j == '|' || j == '\\')) + if (PRINTescape && + (Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_single_escape || + Vreadtable->s.s_dbind->rt.rt_self[j].rte_chattrib==cat_multiple_escape)) write_ch('\\'); fc=convertible_upper(j) ? 1 : (convertible_lower(j) ? -1 : 0); @@ -711,7 +688,7 @@ print_symbol_name_body(object x,int pp) (PRINTcase == sKdowncase ? -1 : (PRINTcase == sKcapitalize ? (i==lw ? 1 : -1) : 0)))); if (ispunct(j)||isspace(j)) lw=i+1; - j+=(tc*fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); + j+=(tc && fc && !k ? (tc-fc)>>1 : 0)*('A'-'a'); write_ch(j); } @@ -721,6 +698,42 @@ print_symbol_name_body(object x,int pp) } +#define DONE 1 +#define FOUND -1 + +static int +write_sharp_eq(object *vp,bool dot) { + + bool defined=vp[1]!=Cnil; + + if (dot) { + write_str(" . "); + if (!defined) return FOUND; + } + + vp[1]=Ct; + write_ch('#'); + write_decimal((vp-PRINTvs_top)/2); + write_ch(defined ? '#' : '='); + + return defined ? DONE : FOUND; + +} + +static int +write_sharp_eqs(object x,bool dot) { + + object *vp; + + for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) + if (x == *vp) + return write_sharp_eq(vp,dot); + + return 0; + +} + + void write_object(x, level) object x; @@ -728,7 +741,6 @@ int level; { object r, y; int i, j, k; - object *vp; cs_check(x); @@ -903,29 +915,15 @@ int level; if (PRINTescape) { if (x->s.s_hpack == Cnil) { - if (PRINTcircle) { - for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) - if (x == *vp) { - if (vp[1] != Cnil) { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2+1); - write_ch('#'); - return; - } else { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2+1); - write_ch('='); - vp[1] = Ct; - } - } - } + if (PRINTcircle) + if (write_sharp_eqs(x,FALSE)==DONE) return; if (PRINTgensym) write_str("#:"); } else if (x->s.s_hpack == keyword_package) { write_ch(':'); } else if (PRINTpackage||find_symbol(x,current_package())!=x || !intern_flag) { - print_symbol_name_body(x->s.s_hpack->p.p_name,0); + print_symbol_name_body(x->s.s_hpack->p.p_name); if (find_symbol(x, x->s.s_hpack) != x) error("can't print symbol"); @@ -939,7 +937,7 @@ int level; } } - print_symbol_name_body(x,1); + print_symbol_name_body(x); break; } case t_array: @@ -953,23 +951,8 @@ int level; write_str(">"); break; } - if (PRINTcircle) { - for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) - if (x == *vp) { - if (vp[1] != Cnil) { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('#'); - return; - } else { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('='); - vp[1] = Ct; - break; - } - } - } + if (PRINTcircle) + if (write_sharp_eqs(x,FALSE)==DONE) return; if (PRINTlevel >= 0 && level >= PRINTlevel) { write_ch('#'); break; @@ -1044,23 +1027,8 @@ int level; write_str(">"); break; } - if (PRINTcircle) { - for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) - if (x == *vp) { - if (vp[1] != Cnil) { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('#'); - return; - } else { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('='); - vp[1] = Ct; - break; - } - } - } + if (PRINTcircle) + if (write_sharp_eqs(x,FALSE)==DONE) return; if (PRINTlevel >= 0 && level >= PRINTlevel) { write_ch('#'); break; @@ -1130,23 +1098,8 @@ int level; write_object(x->c.c_cdr, level); break; } - if (PRINTcircle) { - for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) - if (x == *vp) { - if (vp[1] != Cnil) { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('#'); - return; - } else { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('='); - vp[1] = Ct; - break; - } - } - } + if (PRINTcircle) + if (write_sharp_eqs(x,FALSE)==DONE) return; if (PRINTpretty) { if (x->c.c_car == sLquote && type_of(x->c.c_cdr) == t_cons && @@ -1192,22 +1145,15 @@ int level; } break; } - if (PRINTcircle) { - for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) - if (x == *vp) { - if (vp[1] != Cnil) { - write_str(" . #"); - write_decimal((vp-PRINTvs_top)/2); - write_ch('#'); - goto RIGHT_PAREN; - } else { - write_ch(INDENT); - write_str(". "); - write_object(x, level); - goto RIGHT_PAREN; - } - } - } + if (PRINTcircle) + switch (write_sharp_eqs(x,TRUE)) { + case FOUND: + write_object(x, level); + case DONE: + goto RIGHT_PAREN; + default: + break; + } if (i == 0 && y != OBJNULL && type_of(y) == t_symbol) write_ch(INDENT1); else @@ -1369,23 +1315,8 @@ int level; break; case t_structure: - if (PRINTcircle) { - for (vp = PRINTvs_top; vp < PRINTvs_limit; vp += 2) - if (x == *vp) { - if (vp[1] != Cnil) { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('#'); - return; - } else { - write_ch('#'); - write_decimal((vp-PRINTvs_top)/2); - write_ch('='); - vp[1] = Ct; - break; - } - } - } + if (PRINTcircle) + if (write_sharp_eqs(x,FALSE)==DONE) return; if (PRINTlevel >= 0 && level >= PRINTlevel) { write_ch('#'); break; @@ -1468,48 +1399,73 @@ static int dgs; #include "page.h" +#define travel_seen(x) x->d.m +#define travel_pushed(x) x->d.f +#define travel_bits(x) x->md.mf + static void -travel_push_new(object x) { +travel_push(object x) { - object y; int i; - BEGIN: - if (NULL_OR_ON_C_STACK(x)) return; - if (is_marked(x)) { - vs_check_push(x); - vs_check_push(Cnil); + if (NULL_OR_ON_C_STACK(x)) + return; + + if (travel_seen(x)) { + + if (!travel_pushed(x)) { + vs_check_push(x); + vs_check_push(Cnil); + travel_pushed(x)=1; + } + return; + } + switch (type_of(x)) { + case t_symbol: - if (dgs && x->s.s_hpack==Cnil) {mark(x);} + + if (dgs && x->s.s_hpack==Cnil) + travel_seen(x)=1; break; + case t_cons: - y=x->c.c_cdr; - mark(x); - travel_push_new(x->c.c_car); - x=y; - goto BEGIN; + + { + object y=x->c.c_cdr; + travel_seen(x)=1; + travel_push(x->c.c_car); + travel_push(y); + } break; + case t_array: - mark(x); + + travel_seen(x)=1; if ((enum aelttype)x->a.a_elttype == aet_object) for (i=0;ia.a_dim;i++) - travel_push_new(x->a.a_self[i]); + travel_push(x->a.a_self[i]); break; + case t_vector: - mark(x); + + travel_seen(x)=1; if ((enum aelttype)x->v.v_elttype == aet_object) for (i=0;iv.v_fillp;i++) - travel_push_new(x->v.v_self[i]); + travel_push(x->v.v_self[i]); break; + case t_structure: - mark(x); + + travel_seen(x)=1; for (i = 0; i < S_DATA(x->str.str_def)->length; i++) - travel_push_new(structure_ref(x,x->str.str_def,i)); + travel_push(structure_ref(x,x->str.str_def,i)); break; + default: + break; } @@ -1518,34 +1474,45 @@ travel_push_new(object x) { static void -travel_clear_new(object x) { +travel_clear(object x) { int i; - BEGIN: - if (NULL_OR_ON_C_STACK(x) || !is_marked(x)) return; - unmark(x); + if (NULL_OR_ON_C_STACK(x) || !travel_bits(x)) + return; + + travel_bits(x)=0; + switch (type_of(x)) { + case t_cons: - travel_clear_new(x->c.c_car); - x=x->c.c_cdr; - goto BEGIN; + + travel_clear(x->c.c_car); + travel_clear(x->c.c_cdr); break; + case t_array: + if ((enum aelttype)x->a.a_elttype == aet_object) for (i=0;ia.a_dim;i++) - travel_clear_new(x->a.a_self[i]); + travel_clear(x->a.a_self[i]); break; + case t_vector: + if ((enum aelttype)x->v.v_elttype == aet_object) for (i=0;iv.v_fillp;i++) - travel_clear_new(x->v.v_self[i]); + travel_clear(x->v.v_self[i]); break; + case t_structure: + for (i = 0; i < S_DATA(x->str.str_def)->length; i++) - travel_clear_new(structure_ref(x,x->str.str_def,i)); + travel_clear(structure_ref(x,x->str.str_def,i)); break; + default: + break; } @@ -1558,74 +1525,14 @@ setupPRINTcircle(object x,int dogensyms) BEGIN_NO_INTERRUPT; dgs=dogensyms; - travel_push_new(x); + travel_push(x); dgs=0; PRINTvs_limit = vs_top; - travel_clear_new(x); + travel_clear(x); END_NO_INTERRUPT; } -/* char travel_push_type[32]; */ - -/* static void */ -/* travel_push_object(x) */ -/* object x; */ -/* { */ -/* enum type t; */ -/* int i; */ -/* object *vp; */ - -/* cs_check(x); */ - -/* BEGIN: */ -/* t = type_of(x); */ -/* if(travel_push_type[(int)t]==0) return; */ -/* if(t==t_symbol && x->s.s_hpack != Cnil) return; */ - -/* for (vp = PRINTvs_top; vp < vs_top; vp += 2) */ -/* if (x == *vp) { */ -/* if (vp[1] != Cnil) */ -/* return; */ -/* vp[1] = Ct; */ -/* return; */ -/* } */ -/* vs_check_push(x); */ -/* vs_check_push(Cnil); */ -/* if (t == t_array && (enum aelttype)x->a.a_elttype == aet_object) */ -/* for (i = 0; i < x->a.a_dim; i++) */ -/* travel_push_object(x->a.a_self[i]); */ -/* else if (t == t_vector && (enum aelttype)x->v.v_elttype == aet_object) */ -/* for (i = 0; i < x->v.v_fillp; i++) */ -/* travel_push_object(x->v.v_self[i]); */ -/* else if (t == t_cons) { */ -/* travel_push_object(x->c.c_car); */ -/* x = x->c.c_cdr; */ -/* goto BEGIN; */ -/* } else if (t == t_structure) { */ -/* for (i = 0; i < S_DATA(x->str.str_def)->length; i++) */ -/* travel_push_object(structure_ref(x,x->str.str_def,i)); */ -/* } */ -/* } */ - -/* static void */ -/* setupPRINTcircle(x,dogensyms) */ -/* object x; */ -/* int dogensyms; */ -/* { object *vp,*vq; */ -/* travel_push_type[(int)t_symbol]=dogensyms; */ -/* travel_push_type[(int)t_array]= */ -/* (travel_push_type[(int)t_vector]=PRINTarray); */ -/* travel_push_object(x); */ -/* for (vp = vq = PRINTvs_top; vp < vs_top; vp += 2) */ -/* if (vp[1] != Cnil) { */ -/* vq[0] = vp[0]; */ -/* vq[1] = Cnil; */ -/* vq += 2; */ -/* } */ -/* PRINTvs_limit = vs_top = vq; */ -/* } */ - void setupPRINTdefault(x) object x; @@ -1640,8 +1547,8 @@ object x; vs_push(PRINTstream); FEwrong_type_argument(sLstream, PRINTstream); } - PRINTescape = symbol_value(sLAprint_escapeA) != Cnil; PRINTreadably = symbol_value(sLAprint_readablyA) != Cnil; + PRINTescape = PRINTreadably || symbol_value(sLAprint_escapeA) != Cnil; PRINTpretty = symbol_value(sLAprint_prettyA) != Cnil; PRINTcircle = symbol_value(sLAprint_circleA) != Cnil; y = symbol_value(sLAprint_baseA);