"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "sys.c" between
scm-5f2.zip and scm-5f3.zip

About: SCM is a Scheme Language Interpreter.

sys.c  (scm-5f2):sys.c  (scm-5f3)
skipping to change at line 1250 skipping to change at line 1250
sizet hplim_ind = 0; sizet hplim_ind = 0;
long heap_cells = 0; long heap_cells = 0;
CELLPTR *hplims, heap_org; CELLPTR *hplims, heap_org;
VOLATILE SCM freelist = EOL; VOLATILE SCM freelist = EOL;
long mltrigger, mtrigger = INIT_MALLOC_LIMIT; long mltrigger, mtrigger = INIT_MALLOC_LIMIT;
int gc_hook_pending = 0, gc_hook_active = 0; int gc_hook_pending = 0, gc_hook_active = 0;
/* Ints should be deferred when calling igc_for_alloc. */ /* Ints should be deferred when calling igc_for_alloc. */
static char *igc_for_alloc(where, olen, size, what) static char *igc_for_alloc(where, olen, size, what)
char *where; char *where;
long olen; unsigned long olen;
sizet size; unsigned long size;
const char *what; const char *what;
{ {
char *ptr; char *ptr;
long nm; unsigned long nm;
/* Check to see that heap is initialized */ /* Check to see that heap is initialized */
ASRTER(heap_cells > 0, MAKINUM(size), NALLOC, what); ASRTER(heap_cells > 0, MAKINUM(size), NALLOC, what);
/* printf("igc_for_alloc(%lx, %lu, %u, %s)\n", where, olen, size, what); fflush( stdout); */ /* printf("igc_for_alloc(%lx, %lu, %u, %s)\n", where, olen, size, what); fflush( stdout); */
igc(what, rootcont); igc(what, rootcont);
nm = mallocated + size - olen; nm = mallocated + size - olen;
if (nm > mltrigger) { if (nm > mltrigger) {
if (nm > mtrigger) grew_lim(nm + nm/2); if (nm > mtrigger) grew_lim(nm + nm/2);
else grew_lim(mtrigger + mtrigger/2); else grew_lim(mtrigger + mtrigger/2);
} }
if (where) SYSCALL(ptr = (char *)realloc(where, size);); if (where) SYSCALL(ptr = (char *)realloc(where, size););
skipping to change at line 1282 skipping to change at line 1282
} }
mallocated = nm; mallocated = nm;
return ptr; return ptr;
} }
char *must_malloc(len, what) char *must_malloc(len, what)
long len; long len;
const char *what; const char *what;
{ {
char *ptr; char *ptr;
sizet size = len; sizet size = len;
long nm = mallocated + size; unsigned long nm = mallocated + size;
VERIFY_INTS("must_malloc", what); VERIFY_INTS("must_malloc", what);
#ifdef SHORT_SIZET #ifdef SHORT_SIZET
ASRTER(len==size, MAKINUM(len), NALLOC, what); ASRTER(len==size, MAKINUM(len), NALLOC, what);
#endif #endif
if (nm <= mtrigger) SYSCALL(ptr = (char *)malloc(size);); if (nm <= mtrigger) SYSCALL(ptr = (char *)malloc(size););
else ptr = 0; else ptr = 0;
if (!ptr) ptr = igc_for_alloc(0L, 0L, size, what); if (!ptr) ptr = igc_for_alloc(0L, 0L, size+0L, what);
else mallocated = nm; else mallocated = nm;
/* printf("must_malloc(%lu, %s) => %lx\n", len, what, ptr); fflush(stdout); */ /* printf("must_malloc(%lu, %s) => %lx\n", len, what, ptr); fflush(stdout); */
return ptr; return ptr;
} }
SCM must_malloc_cell(len, c, what) SCM must_malloc_cell(len, c, what)
long len; long len;
SCM c; SCM c;
const char *what; const char *what;
{ {
SCM z; SCM z;
char *ptr; char *ptr;
sizet size = len; sizet size = len;
long nm = mallocated + size; unsigned long nm = mallocated + size;
VERIFY_INTS("must_malloc_cell", what); VERIFY_INTS("must_malloc_cell", what);
#ifdef SHORT_SIZET #ifdef SHORT_SIZET
ASRTER(len==size, MAKINUM(len), NALLOC, what); ASRTER(len==size, MAKINUM(len), NALLOC, what);
#endif #endif
NEWCELL(z); NEWCELL(z);
if (nm <= mtrigger) SYSCALL(ptr = (char *)malloc(size);); if (nm <= mtrigger) SYSCALL(ptr = (char *)malloc(size););
else ptr = 0; else ptr = 0;
if (!ptr) ptr = igc_for_alloc(0L, 0L, size, what); if (!ptr) ptr = igc_for_alloc(0L, 0L, size+0L, what);
else mallocated = nm; else mallocated = nm;
/* printf("must_malloc_cell(%lu, %lx, %s) => %lx\n", len, c, what, ptr); fflush( stdout); */ /* printf("must_malloc_cell(%lu, %lx, %s) => %lx\n", len, c, what, ptr); fflush( stdout); */
SETCHARS(z, ptr); SETCHARS(z, ptr);
CAR(z) = c; CAR(z) = c;
return z; return z;
} }
char *must_realloc(where, olen, len, what) char *must_realloc(where, olen, len, what)
char *where; char *where;
long olen, len; unsigned long olen, len;
const char *what; const char *what;
{ {
char *ptr; char *ptr;
sizet size = len; sizet size = len;
long nm = mallocated + size - olen; unsigned long nm = mallocated + size - olen;
VERIFY_INTS("must_realloc", what); VERIFY_INTS("must_realloc", what);
#ifdef SHORT_SIZET #ifdef SHORT_SIZET
ASRTER(len==size, MAKINUM(len), NALLOC, what); ASRTER(len==size, MAKINUM(len), NALLOC, what);
#endif #endif
ASRTER(!errjmp_bad, MAKINUM(len), NALLOC, what); ASRTER(!errjmp_bad, MAKINUM(len), NALLOC, what);
/* printf("must_realloc(%lx, %lu, %lu, %s)\n", where, olen, len, what); fflush(s tdout); /* printf("must_realloc(%lx, %lu, %lu, %s)\n", where, olen, len, what); fflush(s tdout);
printf("nm = %ld <= mtrigger = %ld: %d; size = %u\n", nm, mtrigger, (nm <= mt rigger), size); fflush(stdout); */ printf("nm = %ld <= mtrigger = %ld: %d; size = %u\n", nm, mtrigger, (nm <= mt rigger), size); fflush(stdout); */
if (nm <= mtrigger) SYSCALL(ptr = (char *)realloc(where, size);); if (nm <= mtrigger) SYSCALL(ptr = (char *)realloc(where, size););
else ptr = 0; else ptr = 0;
if (!ptr) ptr = igc_for_alloc(where, olen, size, what); if (!ptr) ptr = igc_for_alloc(where, olen, size+0L, what);
else mallocated = nm; else mallocated = nm;
return ptr; return ptr;
} }
void must_realloc_cell(z, olen, len, what) void must_realloc_cell(z, olen, len, what)
SCM z; SCM z;
long olen, len; unsigned long olen, len;
const char *what; const char *what;
{ {
char *ptr, *where = CHARS(z); char *ptr, *where = CHARS(z);
sizet size = len; sizet size = len;
long nm = mallocated + size - olen; unsigned long nm = mallocated + size - olen;
VERIFY_INTS("must_realloc_cell", what); VERIFY_INTS("must_realloc_cell", what);
#ifdef SHORT_SIZET #ifdef SHORT_SIZET
ASRTER(len==size, MAKINUM(len), NALLOC, what); ASRTER(len==size, MAKINUM(len), NALLOC, what);
#endif #endif
ASRTER(!errjmp_bad, MAKINUM(len), NALLOC, what); ASRTER(!errjmp_bad, MAKINUM(len), NALLOC, what);
/* printf("must_realloc_cell(%lx, %lu, %lu, %s)\n", z, olen, len, what); fflush( stdout); */ /* printf("must_realloc_cell(%lx, %lu, %lu, %s)\n", z, olen, len, what); fflush( stdout); */
if (nm <= mtrigger) SYSCALL(ptr = (char *)realloc(where, size);); if (nm <= mtrigger) SYSCALL(ptr = (char *)realloc(where, size););
else ptr = 0; else ptr = 0;
if (!ptr) ptr = igc_for_alloc(where, olen, size, what); if (!ptr) ptr = igc_for_alloc(where, olen, size+0L, what);
else mallocated = nm; else mallocated = nm;
SETCHARS(z, ptr); SETCHARS(z, ptr);
} }
void must_free(obj, len) void must_free(obj, len)
char *obj; char *obj;
sizet len; sizet len;
{ {
if (obj) { if (obj) {
#ifdef CAREFUL_INTS #ifdef CAREFUL_INTS
while (len--) obj[len] = '#'; while (len--) obj[len] = '#';
skipping to change at line 2479 skipping to change at line 2479
/* ALLOW_INTS; */ /* A really bad idea, but printing does it anyway. */ /* ALLOW_INTS; */ /* A really bad idea, but printing does it anyway. */
/* exit_report(); */ /* exit_report(); */
/* lfflush(sys_errp); */ /* This causes segfault in fc9 */ /* lfflush(sys_errp); */ /* This causes segfault in fc9 */
scm_free_gra(&ptobs_gra); scm_free_gra(&ptobs_gra);
lmallocated = mallocated = 0; lmallocated = mallocated = 0;
/* Can't do gc_end() here because it uses ptobs which have been freed */ /* Can't do gc_end() here because it uses ptobs which have been freed */
fflush(stdout); /* in lieu of close */ fflush(stdout); /* in lieu of close */
fflush(stderr); /* in lieu of close */ fflush(stderr); /* in lieu of close */
} }
#define HUGE_LENGTH(x) (LENGTH_MAX==LENGTH(x) ? *((long *)VELTS(x)) : LENGTH(x)) #define HUGE_LENGTH(x) (LENGTH_MAX==LENGTH(x) ? *((unsigned long *)VELTS(x)) : L ENGTH(x))
/* This is used to force allocation of SCM temporaries on the stack, /* This is used to force allocation of SCM temporaries on the stack,
it should be called with any SCM variables used for malloc headers it should be called with any SCM variables used for malloc headers
and entirely local to a C procedure. */ and entirely local to a C procedure. */
void scm_protect_temp(ptr) void scm_protect_temp(ptr)
SCM *ptr; SCM *ptr;
{ {
return; return;
} }
skipping to change at line 2658 skipping to change at line 2658
{ {
register CELLPTR ptr; register CELLPTR ptr;
#ifdef POINTERS_MUNGED #ifdef POINTERS_MUNGED
register SCM scmptr; register SCM scmptr;
#else #else
# define scmptr (SCM)ptr # define scmptr (SCM)ptr
#endif #endif
register SCM nfreelist = EOL; register SCM nfreelist = EOL;
register long n = 0; register long n = 0;
register sizet j, minc; register sizet j, minc;
long pre_m = mallocated; unsigned long pre_m = mallocated;
sizet i = 0; sizet i = 0;
sizet seg_cells; sizet seg_cells;
while (i < hplim_ind) { while (i < hplim_ind) {
ptr = CELL_UP(hplims[i++]); ptr = CELL_UP(hplims[i++]);
seg_cells = CELL_DN(hplims[i++]) - ptr; seg_cells = CELL_DN(hplims[i++]) - ptr;
for (j = seg_cells; j--; ++ptr) { for (j = seg_cells; j--; ++ptr) {
#ifdef POINTERS_MUNGED #ifdef POINTERS_MUNGED
scmptr = PTR2SCM(ptr); scmptr = PTR2SCM(ptr);
#endif #endif
switch TYP7(scmptr) { switch TYP7(scmptr) {
 End of changes. 14 change blocks. 
15 lines changed or deleted 15 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)