Import Upstream version 5e3upstream/5e3

1 files changed, 52 insertions, 39 deletions

diff --git a/sys.c b/sys.c
index 04b442e..d3243c4 100644
--- a/sys.c
+++ b/sys.c
@@ -50,7 +50,7 @@
 # include <io.h>
 #endif
 
-void	igc P((const char *what, STACKITEM *stackbase));
+void	igc P((const char *what, SCM basecont));
 void	lfflush P((SCM port));		/* internal SCM call */
 SCM	*loc_open_file;		/* for open-file callback */
 SCM	*loc_try_create_file;
@@ -1264,7 +1264,7 @@ static char *igc_for_alloc(where, olen, size, what)
 			/* Check to see that heap is initialized */
   ASRTER(heap_cells > 0, MAKINUM(size), NALLOC, what);
 /* printf("igc_for_alloc(%lx, %lu, %u, %s)\n", where, olen, size, what); fflush(stdout); */
-  igc(what, CONT(rootcont)->stkbse);
+  igc(what, rootcont);
   nm = mallocated + size - olen;
   if (nm > mltrigger) {
     if (nm > mtrigger) grew_lim(nm + nm/2);
@@ -1574,22 +1574,21 @@ SCM makcclo(proc, len)
 }
 #endif
 
-#ifdef STACK_LIMIT
 void stack_check()
 {
   STACKITEM *start = CONT(rootcont)->stkbse;
   STACKITEM stack;
-# ifdef STACK_GROWS_UP
+#ifdef STACK_GROWS_UP
   if (&stack - start > STACK_LIMIT/sizeof(STACKITEM))
-# else
+#else
   if (start - &stack > STACK_LIMIT/sizeof(STACKITEM))
-# endif /* def STACK_GROWS_UP */
+#endif /* def STACK_GROWS_UP */
     {
       stack_report();
       wta(UNDEFINED, (char *)SEGV_SIGNAL, "stack");
     }
 }
-#endif
+
 void stack_report()
 {
   STACKITEM stack;
@@ -2029,7 +2028,7 @@ SCM scm_port_entry(stream, ptype, flags)
     }
   }
   else {
-    igc(s_port_table, CONT(rootcont)->stkbse);
+    igc(s_port_table, rootcont);
     for (i = 0; i < scm_port_table_len; i++)
       if (0L==scm_port_table[i].flags) goto ret;
     wta(UNDEFINED, s_nogrow, s_port_table);
@@ -2249,7 +2248,7 @@ SCM gc_for_newcell()
 	SCM fl;
 	int oints = ints_disabled; /* Temporary expedient */
 	if (!oints) ints_disabled = 1;
-	igc(s_cells, CONT(rootcont)->stkbse);
+	igc(s_cells, rootcont);
 	if ((gc_cells_collected < MIN_GC_YIELD) || IMP(freelist)) {
 	  alloc_some_heap();
 	  growth_mon(s_numheaps, (long)(hplim_ind/2), s_segs, !0);
@@ -2264,13 +2263,13 @@ SCM gc_for_newcell()
 
 void gc_for_open_files()
 {
-  igc("open files", CONT(rootcont)->stkbse);
+  igc("open files", rootcont);
 }
 
 void scm_fill_freelist()
 {
   while IMP(freelist) {
-    igc(s_cells, CONT(rootcont)->stkbse);
+    igc(s_cells, rootcont);
     if ((gc_cells_collected < MIN_GC_YIELD) || IMP(freelist)) {
       alloc_some_heap();
       growth_mon(s_numheaps, (long)(hplim_ind/2), s_segs, !0);
@@ -2280,7 +2279,6 @@ void scm_fill_freelist()
 }
 
 static char	s_bad_type[] = "unknown type in ";
-jump_buf save_regs_gc_mark;
 void mark_locations P((STACKITEM x[], sizet n));
 static void mark_syms P((SCM v));
 static void mark_sym_values P((SCM v));
@@ -2297,7 +2295,7 @@ SCM gc(arg)
 {
   DEFER_INTS;
   if (UNBNDP(arg))
-    igc("call", CONT(rootcont)->stkbse);
+    igc("call", rootcont);
   else
     scm_egc();
   ALLOW_INTS;
@@ -2346,12 +2344,13 @@ void scm_gc_hook ()
   gc_hook_active = 0;
 }
 
-void igc(what, stackbase)
+void igc(what, basecont)
      const char *what;
-     STACKITEM *stackbase;
+     SCM basecont;
 {
   int j = num_protects;
   long oheap_cells = heap_cells;
+  STACKITEM * stackbase = IMP(basecont) ? 0 : CONT(basecont)->stkbse;
 #ifdef DEBUG_GMALLOC
   int err = check_frag_blocks();
   if (err) wta(MAKINUM(err), "malloc corrupted", what);
@@ -2373,6 +2372,10 @@ void igc(what, stackbase)
   mark_subrs();
   egc_mark();
   if (stackbase) {
+#ifdef __ia64__
+    mark_regs_ia64(CONT(basecont));
+#else
+    jump_buf save_regs_gc_mark;
     FLUSH_REGISTER_WINDOWS;
     /* This assumes that all registers are saved into the jump_buf */
     setjump(save_regs_gc_mark);
@@ -2382,22 +2385,23 @@ void igc(what, stackbase)
     {
       /* stack_len is long rather than sizet in order to guarantee that
 	 &stack_len is long aligned */
-#ifdef STACK_GROWS_UP
-# ifdef nosve
+# ifdef STACK_GROWS_UP
+#  ifdef nosve
       long stack_len = (STACKITEM *)(&stack_len) - stackbase;
-# else
+#  else
       long stack_len = stack_size(stackbase);
-# endif
+#  endif
       mark_locations(stackbase, (sizet)stack_len);
-#else
-# ifdef nosve
-      long stack_len = stackbase - (STACKITEM *)(&stack_len);
 # else
+#  ifdef nosve
+      long stack_len = stackbase - (STACKITEM *)(&stack_len);
+#  else
       long stack_len = stack_size(stackbase);
-# endif
+#  endif
       mark_locations((stackbase - stack_len), (sizet)stack_len);
-#endif
+# endif
     }
+#endif
   }
   while(j--)
     gc_mark(sys_protects[j]);
@@ -2556,13 +2560,12 @@ void gc_mark(p)
     ASRTER(!(CHARS(ptr)[HUGE_LENGTH(ptr)]), MAKINUM(HUGE_LENGTH(ptr)),
 	   s_wrong_length, s_gc);
   case tc7_ssymbol:
-  case tc7_bvect:
-  case tc7_ivect:
-  case tc7_uvect:
-  case tc7_svect:
-  case tc7_fvect:
-  case tc7_dvect:
-  case tc7_cvect:
+  case tc7_Vbool:
+  case tc7_VfixZ32: case tc7_VfixN32:
+  case tc7_VfixZ16: case tc7_VfixN16:
+  case tc7_VfixN8: case tc7_VfixZ8:
+  case tc7_VfloR32: case tc7_VfloC32:
+  case tc7_VfloR64: case tc7_VfloC64:
     SETGC8MARK(ptr);
   case tcs_subrs:
     break;
@@ -2679,28 +2682,38 @@ static void gc_sweep(contin_bad)
 	must_free(CHARS(scmptr), minc);
 /*	SETCHARS(scmptr, 0);*/
 	break;
-      case tc7_bvect:
+      case tc7_Vbool:
 	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
 	minc = sizeof(long)*((HUGE_LENGTH(scmptr)+LONG_BIT-1)/LONG_BIT);
 	goto freechars;
-      case tc7_ivect:
-      case tc7_uvect:
+      case tc7_VfixZ32:
+      case tc7_VfixN32:
 	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
 	minc = HUGE_LENGTH(scmptr)*sizeof(long);
 	goto freechars;
-      case tc7_svect:
+      case tc7_VfixN8:
+      case tc7_VfixZ8:
+	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
+	minc = HUGE_LENGTH(scmptr)*sizeof(char);
+	goto freechars;
+      case tc7_VfixZ16:
+      case tc7_VfixN16:
 	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
 	minc = HUGE_LENGTH(scmptr)*sizeof(short);
 	goto freechars;
-      case tc7_fvect:
+      case tc7_VfloR32:
 	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
 	minc = HUGE_LENGTH(scmptr)*sizeof(float);
 	goto freechars;
-      case tc7_dvect:
+      case tc7_VfloC32:
+	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
+	minc = HUGE_LENGTH(scmptr)*2*sizeof(float);
+	goto freechars;
+      case tc7_VfloR64:
 	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
 	minc = HUGE_LENGTH(scmptr)*sizeof(double);
 	goto freechars;
-      case tc7_cvect:
+      case tc7_VfloC64:
 	if (GC8MARKP(scmptr)) goto c8mrkcontinue;
 	minc = HUGE_LENGTH(scmptr)*2*sizeof(double);
 	goto freechars;
@@ -3144,7 +3157,7 @@ void scm_egc()
 /* We need to make sure there are enough cells available to migrate
    the entire environment cache, gc does not work properly during ecache gc */
   while (egc_need_gc()) {
-    igc("ecache", CONT(rootcont)->stkbse);
+    igc("ecache", rootcont);
     if ((gc_cells_collected < MIN_GC_YIELD) ||
 	(heap_cells - cells_allocated <= scm_ecache_len) || IMP(freelist)) {
       alloc_some_heap();