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);