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-58) unstable; urgency=medium
 .
   * list_order.14
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: 2018-01-12

--- gcl-2.6.12.orig/h/protoize.h
+++ gcl-2.6.12/h/protoize.h
@@ -1964,3 +1964,9 @@ vsystem(const char *);
 
 object
 n_cons_from_x(fixnum,object);
+
+int
+seek_to_end_ofile(FILE *);
+
+void
+travel_find_sharing(object,object);
--- gcl-2.6.12.orig/o/fasdump.c
+++ gcl-2.6.12/o/fasdump.c
@@ -976,100 +976,13 @@ fasd_patch_sharp(object x, int depth)
 }
 
 object sharing_table;
-static enum circ_ind
-is_it_there(object x)
-{ struct htent *e;
-  object table=sharing_table;
-  switch(type_of(x)){
-  case t_cons:
-  case t_symbol:
-  case t_structure:
-  case t_array:
-  case t_vector:
-  case t_package:
-  e= gethash(x,table);
-    if (e->hte_key ==OBJNULL)
-      {sethash(x,table,make_fixnum(-1));
-       return FIRST_INDEX;
-     }
-    else
-      {int n=fix(e->hte_value);
-       if (n <0)
-	 e->hte_value=make_fixnum(n-1);
-       return LATER_INDEX;}
-  break;
- default:
-  return NOT_INDEXED;}}
 
-
-
-static void
-find_sharing(object x)
-{
-  cs_check(x);
- BEGIN:
-  if(is_it_there(x)!=FIRST_INDEX) return;  
-
-	switch (type_of(x)) {
-
-	case DP(t_cons:)
-
-	  find_sharing(x->c.c_car);
-	  x=x->c.c_cdr;
-	  goto BEGIN; 
-	  
-	  break;
-
-	case DP(t_vector:)
-	{
-		int i;
-
-		if ((enum aelttype)x->v.v_elttype != aet_object)
-		  break;
-
-		for (i = 0;  i < x->v.v_fillp;  i++)
-		  find_sharing(x->v.v_self[i]);
-		break;
-	}
-	case DP(t_array:)
-	{
-		int i, j;
-		
-		if ((enum aelttype)x->a.a_elttype != aet_object)
-		  break;
-
-		for (i = 0, j = 1;  i < x->a.a_rank;  i++)
-			j *= x->a.a_dims[i];
-		for (i = 0;  i < j;  i++)
-			find_sharing(x->a.a_self[i]);
-		break;
-	}
-	case DP(t_structure:)
-	  {object def = x->str.str_def;
-	 int i;
-	 i=S_DATA(def)->length;
-	 while (i--> 0)
-	        find_sharing(structure_ref(x,def,i));
-	 break;
-	  }
-	default:
-	  break;
-	}
-	return;
-}
-
-DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"")
-/* static object */
-/* FFN(find_sharing_top)(object x, object table) */
-{sharing_table=table;
- find_sharing(x);
- return Ct;
+DEFUN_NEW("FIND-SHARING-TOP",object,fSfind_sharing_top,SI,2,2,NONE,OO,OO,OO,OO,(object x, object table),"") {
+  sharing_table=table;
+  travel_find_sharing(x,table);
+  return Ct;
 }
 
-
-
-
-
 /* static object            */
 /* read_fasd(int i) */
 /* {object tem; */
--- gcl-2.6.12.orig/o/print.d
+++ gcl-2.6.12/o/print.d
@@ -490,7 +490,6 @@ int level;
 	void (*wf)(int) = write_ch_fun;
 
 	object *vt = PRINTvs_top;
-	object *vl = PRINTvs_limit;
 	bool e = PRINTescape;
 	bool ra = PRINTreadably;
 	bool r = PRINTradix;
@@ -599,7 +598,6 @@ L:
 	PRINTradix = r;
 	PRINTescape = e;
 	PRINTreadably = ra;
-	PRINTvs_limit = vl;
 	PRINTvs_top = vt;
 
 	write_ch_fun = wf;
@@ -702,18 +700,19 @@ print_symbol_name_body(object x) {
 #define FOUND -1
 
 static int
-do_write_sharp_eq(object x,bool dot) {
+do_write_sharp_eq(struct htent *e,bool dot) {
 
-  bool defined=x->c.c_cdr!=Cnil;
+  fixnum val=fix(e->hte_value);
+  bool defined=val&1;
 
   if (dot) {
     write_str(" . ");
     if (!defined) return FOUND;
   }
 
-  x->c.c_cdr=Ct;
+  if (!defined) e->hte_value=make_fixnum(val|1);
   write_ch('#');
-  write_decimal(fix(x->c.c_car));
+  write_decimal(val>>1);
   write_ch(defined ? '#' : '=');
 
   return defined ? DONE : FOUND;
@@ -726,7 +725,7 @@ write_sharp_eq(object x,bool dot) {
   struct htent *e;
 
   return PRINTvs_top[0]!=Cnil && (e=gethash(x,PRINTvs_top[0]))->hte_key!=OBJNULL ?
-    do_write_sharp_eq(e->hte_value,dot) : 0;
+    do_write_sharp_eq(e,dot) : 0;
 
 }
 
@@ -1392,79 +1391,65 @@ int level;
 	}
 }
 
-static int dgs;
+static int dgs,dga;
 
 #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(object x) {
 
   int i;
 
-  if (NULL_OR_ON_C_STACK(x))
+  if (is_imm_fixnum(x))
     return;
 
-  if (travel_seen(x)) {
+  if (is_marked(x)) {
 
-    if (!travel_pushed(x)) {
+    if (imcdr(x) || !x->d.f)
       vs_check_push(x);
-      travel_pushed(x)=1;
-    }
-
-    return;
+    if (!imcdr(x))
+      x->d.f=1;
 
-  }
-
-  switch (type_of(x)) {
+  } else switch (type_of(x)) {
 
-  case t_symbol:
+    case t_symbol:
 
-    if (dgs && x->s.s_hpack==Cnil)
-      travel_seen(x)=1;
-    break;
-
-  case t_cons:
-
-    {
-      object y=x->c.c_cdr;
-      travel_seen(x)=1;
-      travel_push(x->c.c_car);
-      travel_push(y);
-    }
-    break;
+      if (dgs && x->s.s_hpack==Cnil) {
+    	mark(x);
+      }
+      break;
 
-  case t_array:
+    case t_cons:
 
-    travel_seen(x)=1;
-    if ((enum aelttype)x->a.a_elttype == aet_object)
-      for (i=0;i<x->a.a_dim;i++)
-	travel_push(x->a.a_self[i]);
-    break;
+      {
+	object y=x->c.c_cdr;
+	mark(x);
+	travel_push(x->c.c_car);
+	travel_push(y);
+      }
+      break;
 
-  case t_vector:
+    case t_vector:
+    case t_array:
 
-    travel_seen(x)=1;
-    if ((enum aelttype)x->v.v_elttype == aet_object)
-      for (i=0;i<x->v.v_fillp;i++)
-	travel_push(x->v.v_self[i]);
-    break;
+      mark(x);
+      if (dga && (enum aelttype)x->a.a_elttype==aet_object)
+	for (i=0;i<x->a.a_dim;i++)
+	  travel_push(x->a.a_self[i]);
+      break;
 
-  case t_structure:
+    case t_structure:
 
-    travel_seen(x)=1;
-    for (i = 0;  i < S_DATA(x->str.str_def)->length;  i++)
-      travel_push(structure_ref(x,x->str.str_def,i));
-    break;
+      mark(x);
+      for (i = 0;  i < S_DATA(x->str.str_def)->length;  i++)
+	travel_push(structure_ref(x,x->str.str_def,i));
+      break;
 
-  default:
+    default:
 
-    break;
+      break;
 
-  }
+    }
 
 }
 
@@ -1474,10 +1459,15 @@ travel_clear(object x) {
 
   int i;
 
-  if (NULL_OR_ON_C_STACK(x) || !travel_bits(x))
+  if (is_imm_fixnum(x))
+    return;
+
+  if (!is_marked(x))
     return;
 
-  travel_bits(x)=0;
+  unmark(x);
+  if (!imcdr(x))
+    x->d.f=0;
 
   switch (type_of(x)) {
 
@@ -1487,20 +1477,14 @@ travel_clear(object x) {
     travel_clear(x->c.c_cdr);
     break;
 
+  case t_vector:
   case t_array:
 
-    if ((enum aelttype)x->a.a_elttype == aet_object)
+    if (dga && (enum aelttype)x->a.a_elttype == aet_object)
       for (i=0;i<x->a.a_dim;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(x->v.v_self[i]);
-    break;
-
   case t_structure:
 
     for (i = 0;  i < S_DATA(x->str.str_def)->length;  i++)
@@ -1515,26 +1499,47 @@ travel_clear(object x) {
 
 }
 
-object sLeq;
-
 static void
-setupPRINTcircle(object x,int dogensyms) {
-
-  object *xp;
+travel(object x,int mdgs,int mdga) {
 
   BEGIN_NO_INTERRUPT;
-  dgs=dogensyms;
+  dgs=mdgs;
+  dga=mdga;
   travel_push(x);
-  dgs=0;
-  PRINTvs_limit = vs_top;
   travel_clear(x);
   END_NO_INTERRUPT;
 
-  vs_check_push(PRINTvs_limit>PRINTvs_top ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil);
-  for (xp=PRINTvs_top;xp<PRINTvs_limit;xp++)
-    sethash(*xp,vs_head,MMcons(make_fixnum(xp-PRINTvs_top),Cnil));
-  PRINTvs_top[0]=vs_head;
-  PRINTvs_limit=vs_top=PRINTvs_top+1;
+}
+
+object sLeq;
+
+static void
+setupPRINTcircle(object x,int dogensyms) {
+
+  object *vp=vs_top,*v=vp,h;
+  fixnum j;
+
+  travel(x,dogensyms,PRINTarray);
+
+  h=vs_top>vp ? funcall_cfun(Lmake_hash_table,2,sKtest,sLeq) : Cnil;
+  for (j=0;v<vs_top;v++)
+    if (!imcdr(*v) || gethash(*v,h)->hte_key==OBJNULL)
+      sethash(*v,h,make_fixnum((j++)<<1));
+
+  vs_top=vp;
+  vs_push(h);
+
+}
+
+void
+travel_find_sharing(object x,object table) {
+
+  object *vp=vs_top;
+
+  travel(x,1,1);
+
+  for (;vs_top>vp;vs_top--)
+      sethash(vs_head,table,make_fixnum(-2));
 
 }