Blob Blame Raw
Description: <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
Author: Camm Maguire <camm@debian.org>

---
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: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
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;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);