<short summary of the patch>

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

Gbp-Pq: Name list_order.11

diff --git a/o/print.d b/o/print.d
index d8dfe6868a62ee00bacd0aeb8a56611a5abaffa1..224b9bdff03d8f88eeca1c9fe75eca770891c58d 100755 (executable)
--- a/o/print.d
+++ b/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;i<x->s.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;i<x->s.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;i<x->s.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;i<x->a.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;i<x->v.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;i<x->a.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;i<x->v.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);