summaryrefslogtreecommitdiffstats
path: root/sys.c
diff options
context:
space:
mode:
Diffstat (limited to 'sys.c')
-rw-r--r--sys.c91
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();
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-21 22:20:35 +0000