From be8eb34102c4900bf19fa915a16b4ade5cfcedaa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 13 Oct 2004 03:49:43 +0000 Subject: [PATCH] memory management change, allocating primitives call gc directly --- Makefile | 8 ++- library/cross-compiler.factor | 2 - library/platform/native/primitives.factor | 1 - library/platform/native/profiler.factor | 31 ++++------- library/test/math/irrational.factor | 39 +++++++------ native/bignum.c | 45 +++++++-------- native/complex.c | 8 ++- native/cons.c | 6 +- native/error.c | 4 +- native/error.h | 2 +- native/factor.h | 7 ++- native/ffi.c | 20 +++++-- native/file.c | 29 +++++++--- native/fixnum.h | 5 -- native/float.c | 68 +++++++++++++++-------- native/gc.c | 21 +++++++ native/gc.h | 1 + native/memory.c | 20 ------- native/memory.h | 6 -- native/misc.c | 20 +++---- native/misc.h | 1 - native/primitives.c | 1 - native/ratio.c | 8 ++- native/read.c | 44 +++++++++++---- native/sbuf.c | 51 +++++++++++++---- native/socket.c | 21 +++++-- native/stack.c | 5 +- native/string.c | 17 ++++-- native/vector.c | 22 ++++++-- native/word.c | 8 ++- native/write.c | 30 +++++++--- 31 files changed, 351 insertions(+), 200 deletions(-) diff --git a/Makefile b/Makefile index b5a00b37bd..1d5baee765 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ CC = gcc -DEFAULT_CFLAGS = -Os -Wall -export-dynamic -fomit-frame-pointer +DEFAULT_CFLAGS = -Os -Wall -export-dynamic -fomit-frame-pointer $(SITE_CFLAGS) DEFAULT_LIBS = -lm STRIP = strip @@ -22,6 +22,7 @@ default: @echo "Run 'make' with one of the following parameters:" @echo "" @echo "bsd" + @echo "bsd-nopthread - on FreeBSD 4, if you want to use profiling" @echo "linux" @echo "solaris" @echo "" @@ -36,6 +37,11 @@ bsd: CFLAGS="$(DEFAULT_CFLAGS) -DFFI -pthread" \ LIBS="$(DEFAULT_LIBS)" +bsd-nopthread: + $(MAKE) f \ + CFLAGS="$(DEFAULT_CFLAGS) -DFFI" \ + LIBS="$(DEFAULT_LIBS)" + linux: $(MAKE) f \ CFLAGS="$(DEFAULT_CFLAGS) -DFFI" \ diff --git a/library/cross-compiler.factor b/library/cross-compiler.factor index dcf2e14d2b..1bd90ab049 100644 --- a/library/cross-compiler.factor +++ b/library/cross-compiler.factor @@ -74,7 +74,6 @@ DEFER: os-env DEFER: type DEFER: size DEFER: address -DEFER: dump DEFER: heap-stats IN: strings @@ -357,7 +356,6 @@ IN: image (random-int) type size - dump cwd cd compiled-offset diff --git a/library/platform/native/primitives.factor b/library/platform/native/primitives.factor index a554da6255..19f299b485 100644 --- a/library/platform/native/primitives.factor +++ b/library/platform/native/primitives.factor @@ -209,7 +209,6 @@ USE: words [ allot-profiling | " depth -- " ] [ allot-count | " word -- n " ] [ set-allot-count | " n word -- n " ] - [ dump | " obj -- " ] [ cwd | " -- dir " ] [ cd | " dir -- " ] [ compiled-offset | " -- ptr " ] diff --git a/library/platform/native/profiler.factor b/library/platform/native/profiler.factor index 18d6300d8d..33c6a59765 100644 --- a/library/platform/native/profiler.factor +++ b/library/platform/native/profiler.factor @@ -36,8 +36,9 @@ USE: stack USE: words USE: vectors -! The variable "profile-top-only" toggles between +! The variable "only-top" toggles between ! culminative counts, and top of call stack counts. +SYMBOL: only-top : reset-counts ( -- ) [ 0 over set-call-count 0 swap set-allot-count ] each-word ; @@ -47,11 +48,7 @@ USE: vectors : call-count, ( word -- ) #! Add to constructing list if call count is non-zero. - dup call-count dup 0 = [ - 2drop - ] [ - cons , - ] ifte ; + dup call-count dup 0 = [ 2drop ] [ cons , ] ifte ; : counts. ( alist -- ) sort-counts [ . ] each ; @@ -61,27 +58,21 @@ USE: vectors [, [ call-count, ] each-word ,] counts. ; : profile-depth ( -- n ) - "profile-top-only" get [ - -1 - ] [ - callstack vector-length - ] ifte ; + only-top get [ -1 ] [ callstack vector-length ] ifte ; -: call-profile ( quot -- ) - #! Execute a quotation with the CPU profiler enabled. +: (call-profile) ( quot -- ) reset-counts profile-depth call-profiling call - f call-profiling - call-counts. ; + f call-profiling ; + +: call-profile ( quot -- ) + #! Execute a quotation with the CPU profiler enabled. + (call-profile) call-counts. ; : allot-count, ( word -- ) #! Add to constructing list if allot count is non-zero. - dup allot-count dup 0 = [ - 2drop - ] [ - cons , - ] ifte ; + dup allot-count dup 0 = [ 2drop ] [ cons , ] ifte ; : allot-counts. ( -- alist ) #! Print word/allot count pairs. diff --git a/library/test/math/irrational.factor b/library/test/math/irrational.factor index 2af5a62b50..41963093ec 100644 --- a/library/test/math/irrational.factor +++ b/library/test/math/irrational.factor @@ -2,24 +2,29 @@ IN: scratchpad USE: kernel USE: math USE: test +USE: real-math -[ 4.0 ] [ 16 ] [ sqrt ] test-word -[ #{ 0 4.0 } ] [ -16 ] [ sqrt ] test-word +! Lets get the argument order correct, eh? +[ 0.0 ] [ 0 1 fatan2 ] unit-test +[ 0.25 ] [ 2 -2 fpow ] unit-test -[ 4.0 ] [ 2 2 ] [ ^ ] test-word -[ 0.25 ] [ 2 -2 ] [ ^ ] test-word -[ t ] [ 2 0.5 ^ 2 ^ ] [ 2 2.00001 between? ] test-word -[ t ] [ e pi i * ^ real ] [ -1.0 = ] test-word -[ t ] [ e pi i * ^ imaginary ] [ -0.00001 0.00001 between? ] test-word +[ 4.0 ] [ 16 sqrt ] unit-test +[ #{ 0 4.0 } ] [ -16 sqrt ] unit-test -[ 1.0 ] [ 0 ] [ cosh ] test-word -[ 0.0 ] [ 1 ] [ acosh ] test-word +[ 4.0 ] [ 2 2 ^ ] unit-test +[ 0.25 ] [ 2 -2 ^ ] unit-test +[ t ] [ 2 0.5 ^ 2 ^ 2 2.00001 between? ] unit-test +[ t ] [ e pi i * ^ real -1.0 = ] unit-test +[ t ] [ e pi i * ^ imaginary -0.00001 0.00001 between? ] unit-test -[ 1.0 ] [ 0 ] [ cos ] test-word -[ 0.0 ] [ 1 ] [ acos ] test-word - -[ 0.0 ] [ 0 ] [ sinh ] test-word -[ 0.0 ] [ 0 ] [ asinh ] test-word - -[ 0.0 ] [ 0 ] [ sin ] test-word -[ 0.0 ] [ 0 ] [ asin ] test-word +[ 1.0 ] [ 0 cosh ] unit-test +[ 0.0 ] [ 1 acosh ] unit-test + +[ 1.0 ] [ 0 cos ] unit-test +[ 0.0 ] [ 1 acos ] unit-test + +[ 0.0 ] [ 0 sinh ] unit-test +[ 0.0 ] [ 0 asinh ] unit-test + +[ 0.0 ] [ 0 sin ] unit-test +[ 0.0 ] [ 0 asin ] unit-test diff --git a/native/bignum.c b/native/bignum.c index b07aba4516..dde761395d 100644 --- a/native/bignum.c +++ b/native/bignum.c @@ -55,6 +55,7 @@ ARRAY* to_bignum(CELL tagged) void primitive_to_bignum(void) { + maybe_garbage_collection(); drepl(tag_object(to_bignum(dpeek()))); } @@ -65,38 +66,39 @@ void primitive_bignum_eq(void) dpush(tag_boolean(s48_bignum_equal_p(x,y))); } +#define GC_AND_POP_BIGNUMS(x,y) \ + ARRAY *x, *y; \ + maybe_garbage_collection(); \ + y = to_bignum(dpop()); \ + x = to_bignum(dpop()); + void primitive_bignum_add(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_add(x,y))); } void primitive_bignum_subtract(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_subtract(x,y))); } void primitive_bignum_multiply(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_multiply(x,y))); } void primitive_bignum_divint(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_quotient(x,y))); } void primitive_bignum_divfloat(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(make_float( s48_bignum_to_double(x) / s48_bignum_to_double(y)))); @@ -104,9 +106,8 @@ void primitive_bignum_divfloat(void) void primitive_bignum_divmod(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); ARRAY *q, *r; + GC_AND_POP_BIGNUMS(x,y); s48_bignum_divide(x,y,&q,&r); dpush(tag_object(q)); dpush(tag_object(r)); @@ -114,36 +115,35 @@ void primitive_bignum_divmod(void) void primitive_bignum_mod(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_remainder(x,y))); } void primitive_bignum_and(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_bitwise_and(x,y))); } void primitive_bignum_or(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_bitwise_ior(x,y))); } void primitive_bignum_xor(void) { - ARRAY* y = to_bignum(dpop()); - ARRAY* x = to_bignum(dpop()); + GC_AND_POP_BIGNUMS(x,y); dpush(tag_object(s48_bignum_bitwise_xor(x,y))); } void primitive_bignum_shift(void) { - FIXNUM y = to_fixnum(dpop()); - ARRAY* x = to_bignum(dpop()); + FIXNUM y; + ARRAY* x; + maybe_garbage_collection(); + y = to_fixnum(dpop()); + x = to_bignum(dpop()); dpush(tag_object(s48_bignum_arithmetic_shift(x,y))); } @@ -207,6 +207,7 @@ void primitive_bignum_greatereq(void) void primitive_bignum_not(void) { + maybe_garbage_collection(); drepl(tag_object(s48_bignum_bitwise_not( untag_bignum(dpeek())))); } diff --git a/native/complex.c b/native/complex.c index c62f84ca5c..34ccbf7d31 100644 --- a/native/complex.c +++ b/native/complex.c @@ -62,8 +62,12 @@ void primitive_to_rect(void) void primitive_from_rect(void) { - CELL imaginary = dpop(); - CELL real = dpop(); + CELL imaginary, real; + + maybe_garbage_collection(); + + imaginary = dpop(); + real = dpop(); if(!realp(imaginary)) type_error(REAL_TYPE,imaginary); diff --git a/native/cons.c b/native/cons.c index 1f97aa3963..01c45df7db 100644 --- a/native/cons.c +++ b/native/cons.c @@ -10,8 +10,10 @@ CELL cons(CELL car, CELL cdr) void primitive_cons(void) { - CELL cdr = dpop(); - CELL car = dpop(); + CELL car, cdr; + maybe_garbage_collection(); + cdr = dpop(); + car = dpop(); dpush(cons(car,cdr)); } diff --git a/native/error.c b/native/error.c index 942e763ebc..263b944758 100644 --- a/native/error.c +++ b/native/error.c @@ -69,8 +69,8 @@ void type_error(CELL type, CELL tagged) general_error(ERROR_TYPE,c); } -void range_error(CELL tagged, CELL index, CELL max) +void range_error(CELL tagged, FIXNUM index, CELL max) { - CELL c = cons(tagged,cons(tag_fixnum(index),cons(tag_fixnum(max),F))); + CELL c = cons(tagged,cons(tag_integer(index),cons(tag_cell(max),F))); general_error(ERROR_RANGE,c); } diff --git a/native/error.h b/native/error.h index 24f1e56d1a..c6d0c3057b 100644 --- a/native/error.h +++ b/native/error.h @@ -21,4 +21,4 @@ void throw_error(CELL object); void general_error(CELL error, CELL tagged); void type_error(CELL type, CELL tagged); void primitive_throw(void); -void range_error(CELL tagged, CELL index, CELL max); +void range_error(CELL tagged, FIXNUM index, CELL max); diff --git a/native/factor.h b/native/factor.h index aa8525b5f9..6957cb43ef 100644 --- a/native/factor.h +++ b/native/factor.h @@ -33,6 +33,11 @@ typedef unsigned long int CELL; #define CELLS ((signed)sizeof(CELL)) +#define FIXNUM_MAX (LONG_MAX >> TAG_BITS) +#define FIXNUM_MIN (LONG_MIN >> TAG_BITS) + +#define FIXNUM long int /* unboxed */ + #define WORD_SIZE (CELLS*8) #define HALF_WORD_SIZE (CELLS*4) #define HALF_WORD_MASK (((unsigned long)1<ptr = ptr; alien->length = length; alien->local = false; @@ -95,8 +102,11 @@ void primitive_local_alien(void) { #ifdef FFI CELL length = unbox_integer(); - ALIEN* alien = allot_object(ALIEN_TYPE,sizeof(ALIEN)); - STRING* local = string(length / CHARS,'\0'); + ALIEN* alien; + STRING* local; + maybe_garbage_collection(); + alien = allot_object(ALIEN_TYPE,sizeof(ALIEN)); + local = string(length / CHARS,'\0'); alien->ptr = (CELL)local + sizeof(STRING); alien->length = length; alien->local = true; diff --git a/native/file.c b/native/file.c index 6305393bb3..4dfbf08636 100644 --- a/native/file.c +++ b/native/file.c @@ -4,9 +4,13 @@ void primitive_open_file(void) { bool write = untag_boolean(dpop()); bool read = untag_boolean(dpop()); - char* path = unbox_c_string(); - int mode; - int fd; + + char* path; + int mode, fd; + + maybe_garbage_collection(); + + path = unbox_c_string(); if(read && write) mode = O_RDWR | O_CREAT; @@ -28,7 +32,11 @@ void primitive_open_file(void) void primitive_stat(void) { struct stat sb; - STRING* path = untag_string(dpop()); + STRING* path; + + maybe_garbage_collection(); + + path = untag_string(dpop()); if(stat(to_c_string(path),&sb) < 0) dpush(F); else @@ -50,14 +58,19 @@ void primitive_stat(void) void primitive_read_dir(void) { - STRING* path = untag_string(dpop()); - DIR* dir = opendir(to_c_string(path)); + STRING* path; + DIR* dir; CELL result = F; + + maybe_garbage_collection(); + + path = untag_string(dpop()); + dir = opendir(to_c_string(path)); if(dir != NULL) { struct dirent* file; - while(file = readdir(dir)) + while((file = readdir(dir)) != NULL) { CELL name = tag_object(from_c_string( file->d_name)); @@ -73,6 +86,7 @@ void primitive_read_dir(void) void primitive_cwd(void) { char wd[MAXPATHLEN]; + maybe_garbage_collection(); if(getcwd(wd,MAXPATHLEN) < 0) io_error(__FUNCTION__); box_c_string(wd); @@ -80,5 +94,6 @@ void primitive_cwd(void) void primitive_cd(void) { + maybe_garbage_collection(); chdir(unbox_c_string()); } diff --git a/native/fixnum.h b/native/fixnum.h index a1bda42b04..933f3936b1 100644 --- a/native/fixnum.h +++ b/native/fixnum.h @@ -1,8 +1,3 @@ -#define FIXNUM_MAX (LONG_MAX >> TAG_BITS) -#define FIXNUM_MIN (LONG_MIN >> TAG_BITS) - -#define FIXNUM long int /* unboxed */ - INLINE FIXNUM untag_fixnum_fast(CELL tagged) { return ((FIXNUM)tagged) >> TAG_BITS; diff --git a/native/float.c b/native/float.c index 940533dceb..cc302c003e 100644 --- a/native/float.c +++ b/native/float.c @@ -27,15 +27,22 @@ double to_float(CELL tagged) void primitive_to_float(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(to_float(dpeek())))); } void primitive_str_to_float(void) { - STRING* str = untag_string(dpeek()); - char* c_str = to_c_string(str); - char* end = c_str; - double f = strtod(c_str,&end); + STRING* str; + char *c_str, *end; + double f; + + maybe_garbage_collection(); + + str = untag_string(dpeek()); + c_str = to_c_string(str); + end = c_str; + f = strtod(c_str,&end); if(end != c_str + str->capacity) general_error(ERROR_FLOAT_FORMAT,tag_object(str)); drepl(tag_object(make_float(f))); @@ -44,6 +51,9 @@ void primitive_str_to_float(void) void primitive_float_to_str(void) { char tmp[33]; + + maybe_garbage_collection(); + snprintf(tmp,32,"%.16g",to_float(dpop())); tmp[32] = '\0'; box_c_string(tmp); @@ -51,43 +61,49 @@ void primitive_float_to_str(void) void primitive_float_to_bits(void) { - double f = untag_float(dpeek()); - long long f_raw = *(long long*)&f; + double f; + long long f_raw; + + maybe_garbage_collection(); + + f = untag_float(dpeek()); + f_raw = *(long long*)&f; drepl(tag_object(s48_long_long_to_bignum(f_raw))); } +#define GC_AND_POP_FLOATS(x,y) \ + double x, y; \ + maybe_garbage_collection(); \ + y = to_float(dpop()); \ + x = to_float(dpop()); + void primitive_float_eq(void) { - double y = to_float(dpop()); - double x = to_float(dpop()); + GC_AND_POP_FLOATS(x,y); dpush(tag_boolean(x == y)); } void primitive_float_add(void) { - double y = to_float(dpop()); - double x = to_float(dpop()); + GC_AND_POP_FLOATS(x,y); dpush(tag_object(make_float(x + y))); } void primitive_float_subtract(void) { - double y = to_float(dpop()); - double x = to_float(dpop()); + GC_AND_POP_FLOATS(x,y); dpush(tag_object(make_float(x - y))); } void primitive_float_multiply(void) { - double y = to_float(dpop()); - double x = to_float(dpop()); + GC_AND_POP_FLOATS(x,y); dpush(tag_object(make_float(x * y))); } void primitive_float_divfloat(void) { - double y = to_float(dpop()); - double x = to_float(dpop()); + GC_AND_POP_FLOATS(x,y); dpush(tag_object(make_float(x / y))); } @@ -121,64 +137,72 @@ void primitive_float_greatereq(void) void primitive_facos(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(acos(to_float(dpeek()))))); } void primitive_fasin(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(asin(to_float(dpeek()))))); } void primitive_fatan(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(atan(to_float(dpeek()))))); } void primitive_fatan2(void) { - double x = to_float(dpop()); - double y = to_float(dpop()); - dpush(tag_object(make_float(atan2(y,x)))); + GC_AND_POP_FLOATS(x,y); + dpush(tag_object(make_float(atan2(x,y)))); } void primitive_fcos(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(cos(to_float(dpeek()))))); } void primitive_fexp(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(exp(to_float(dpeek()))))); } void primitive_fcosh(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(cosh(to_float(dpeek()))))); } void primitive_flog(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(log(to_float(dpeek()))))); } void primitive_fpow(void) { - double x = to_float(dpop()); - double y = to_float(dpop()); - dpush(tag_object(make_float(pow(y,x)))); + GC_AND_POP_FLOATS(x,y); + dpush(tag_object(make_float(pow(x,y)))); } void primitive_fsin(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(sin(to_float(dpeek()))))); } void primitive_fsinh(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(sinh(to_float(dpeek()))))); } void primitive_fsqrt(void) { + maybe_garbage_collection(); drepl(tag_object(make_float(sqrt(to_float(dpeek()))))); } diff --git a/native/gc.c b/native/gc.c index 0af8d727b2..005c20b382 100644 --- a/native/gc.c +++ b/native/gc.c @@ -132,6 +132,7 @@ void collect_roots(void) void primitive_gc(void) { + fprintf(stderr,"GC!\n"); gc_in_progress = true; flip_zones(); @@ -149,3 +150,23 @@ void primitive_gc(void) gc_in_progress = false; } + +/* WARNING: only call this from a context where all local variables +are also reachable via the GC roots. */ +void maybe_garbage_collection(void) +{ + if(active.here > active.alarm) + { + if(active.here > active.limit) + { + fprintf(stderr,"Out of memory\n"); + fprintf(stderr,"active.base = %ld\n",active.base); + fprintf(stderr,"active.here = %ld\n",active.here); + fprintf(stderr,"active.limit = %ld\n",active.limit); + fflush(stderr); + exit(1); + } + else + primitive_gc(); + } +} diff --git a/native/gc.h b/native/gc.h index f90f3fc147..c6e1b0f907 100644 --- a/native/gc.h +++ b/native/gc.h @@ -7,3 +7,4 @@ void collect_object(void); void collect_next(void); void collect_roots(void); void primitive_gc(void); +void maybe_garbage_collection(void); diff --git a/native/memory.c b/native/memory.c index 0fdfbf2300..a134242d17 100644 --- a/native/memory.c +++ b/native/memory.c @@ -36,7 +36,6 @@ void init_arena(CELL size) init_zone(&prior,size); allot_profiling = false; gc_in_progress = false; - gc_protect = false; } void allot_profile_step(CELL a) @@ -58,25 +57,6 @@ void allot_profile_step(CELL a) executing->allot_count += a; } -void garbage_collection_later(void) -{ - if(gc_protect) - return; - - if(active.here > active.limit) - { - fprintf(stderr,"Out of memory\n"); - fprintf(stderr,"active.base = %ld\n",active.base); - fprintf(stderr,"active.here = %ld\n",active.here); - fprintf(stderr,"active.limit = %ld\n",active.limit); - fflush(stderr); - exit(1); - } - - /* Execute the 'garbage-collection' word */ - call(userenv[GC_ENV]); -} - void flip_zones() { ZONE z = active; diff --git a/native/memory.h b/native/memory.h index 440a5f84bf..2b0e89275b 100644 --- a/native/memory.h +++ b/native/memory.h @@ -10,15 +10,11 @@ ZONE prior; bool allot_profiling; -/* we can temporarily disable GC */ -bool gc_protect; - void* alloc_guarded(CELL size); void init_zone(ZONE* zone, CELL size); void init_arena(CELL size); void flip_zones(); -void garbage_collection_later(void); void allot_profile_step(CELL a); INLINE CELL align8(CELL a) @@ -32,8 +28,6 @@ INLINE void* allot(CELL a) active.here += align8(a); if(allot_profiling) allot_profile_step(align8(a)); - if(active.here > active.alarm) - garbage_collection_later(); return (void*)h; } diff --git a/native/misc.c b/native/misc.c index 8e6822f8a6..fc71056790 100644 --- a/native/misc.c +++ b/native/misc.c @@ -7,8 +7,12 @@ void primitive_exit(void) void primitive_os_env(void) { - char* name = unbox_c_string(); - char* value = getenv(name); + char *name, *value; + + maybe_garbage_collection(); + + name = unbox_c_string(); + value = getenv(name); if(value == NULL) dpush(F); else @@ -24,6 +28,7 @@ void primitive_millis(void) { struct timeval t; gettimeofday(&t,NULL); + maybe_garbage_collection(); dpush(tag_object(s48_long_long_to_bignum( (long long)t.tv_sec * 1000 + t.tv_usec/1000))); } @@ -41,15 +46,6 @@ void primitive_init_random(void) void primitive_random_int(void) { + maybe_garbage_collection(); dpush(tag_object(s48_long_to_bignum(random()))); } - -void primitive_dump(void) -{ - /* Take an object, and print its memory. Later, return a vector */ - CELL obj = dpop(); - CELL size = object_size(obj); - int i; - for(i = 0; i < size; i += CELLS) - fprintf(stderr,"%lx\n",get(UNTAG(obj) + i)); -} diff --git a/native/misc.h b/native/misc.h index 5c8e8e64ac..8118ef2959 100644 --- a/native/misc.h +++ b/native/misc.h @@ -4,4 +4,3 @@ void primitive_eq(void); void primitive_millis(void); void primitive_init_random(void); void primitive_random_int(void); -void primitive_dump(void); diff --git a/native/primitives.c b/native/primitives.c index 98a3147ced..a3c05b0ca7 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -169,7 +169,6 @@ XT primitives[] = { primitive_random_int, primitive_type, primitive_size, - primitive_dump, primitive_cwd, primitive_cd, primitive_compiled_offset, diff --git a/native/ratio.c b/native/ratio.c index 005f7ca4f0..2df44e6f08 100644 --- a/native/ratio.c +++ b/native/ratio.c @@ -4,8 +4,12 @@ library implementation, to avoid breaking invariants. */ void primitive_from_fraction(void) { - CELL denominator = dpop(); - CELL numerator = dpop(); + CELL numerator, denominator; + + maybe_garbage_collection(); + + denominator = dpop(); + numerator = dpop(); if(zerop(denominator)) raise(SIGFPE); if(onep(denominator)) diff --git a/native/read.c b/native/read.c index 35abaa101d..0bf9d0f570 100644 --- a/native/read.c +++ b/native/read.c @@ -107,8 +107,12 @@ void primitive_can_read_line(void) void primitive_add_read_line_io_task(void) { - CELL callback = dpop(); - CELL port = dpop(); + CELL callback, port; + + maybe_garbage_collection(); + + callback = dpop(); + port = dpop(); add_io_task(IO_TASK_READ_LINE,port,F,callback, read_io_tasks,&read_fd_count); @@ -140,7 +144,11 @@ bool perform_read_line_io_task(PORT* port) void primitive_read_line_8(void) { - PORT* port = untag_port(dpeek()); + PORT* port; + + maybe_garbage_collection(); + + port = untag_port(dpeek()); pending_io_error(port); @@ -199,16 +207,27 @@ bool can_read_count(PORT* port, FIXNUM count) void primitive_can_read_count(void) { - PORT* port = untag_port(dpop()); - FIXNUM len = to_fixnum(dpop()); + PORT* port; + FIXNUM len; + + maybe_garbage_collection(); + + port = untag_port(dpop()); + len = to_fixnum(dpop()); dpush(tag_boolean(can_read_count(port,len))); } void primitive_add_read_count_io_task(void) { - CELL callback = dpop(); - PORT* port = untag_port(dpop()); - FIXNUM count = to_fixnum(dpop()); + CELL callback; + PORT* port; + FIXNUM count; + + maybe_garbage_collection(); + + callback = dpop(); + port = untag_port(dpop()); + count = to_fixnum(dpop()); add_io_task(IO_TASK_READ_COUNT, tag_object(port),F,callback, read_io_tasks,&read_fd_count); @@ -233,8 +252,13 @@ bool perform_read_count_io_task(PORT* port) void primitive_read_count_8(void) { - PORT* port = untag_port(dpop()); - FIXNUM len = to_fixnum(dpop()); + PORT* port; + FIXNUM len; + + maybe_garbage_collection(); + + port = untag_port(dpop()); + len = to_fixnum(dpop()); if(port->count != len) critical_error("read# counts don't match",tag_object(port)); diff --git a/native/sbuf.c b/native/sbuf.c index 9c1cefa9a8..125dc8eb19 100644 --- a/native/sbuf.c +++ b/native/sbuf.c @@ -10,6 +10,7 @@ SBUF* sbuf(FIXNUM capacity) void primitive_sbuf(void) { + maybe_garbage_collection(); drepl(tag_object(sbuf(to_fixnum(dpeek())))); } @@ -20,8 +21,13 @@ void primitive_sbuf_length(void) void primitive_set_sbuf_length(void) { - SBUF* sbuf = untag_sbuf(dpop()); - FIXNUM length = to_fixnum(dpop()); + SBUF* sbuf; + FIXNUM length; + + maybe_garbage_collection(); + + sbuf = untag_sbuf(dpop()); + length = to_fixnum(dpop()); if(length < 0) range_error(tag_object(sbuf),length,sbuf->top); sbuf->top = length; @@ -61,9 +67,15 @@ void set_sbuf_nth(SBUF* sbuf, CELL index, CHAR value) void primitive_set_sbuf_nth(void) { - SBUF* sbuf = untag_sbuf(dpop()); - FIXNUM index = to_fixnum(dpop()); - CELL value = dpop(); + SBUF* sbuf; + FIXNUM index; + CELL value; + + maybe_garbage_collection(); + + sbuf = untag_sbuf(dpop()); + index = to_fixnum(dpop()); + value = dpop(); set_sbuf_nth(sbuf,index,value); } @@ -79,8 +91,14 @@ void sbuf_append_string(SBUF* sbuf, STRING* string) void primitive_sbuf_append(void) { - SBUF* sbuf = untag_sbuf(dpop()); - CELL object = dpop(); + SBUF* sbuf; + CELL object; + + maybe_garbage_collection(); + + sbuf = untag_sbuf(dpop()); + object = dpop(); + switch(type_of(object)) { case FIXNUM_TYPE: @@ -98,8 +116,13 @@ void primitive_sbuf_append(void) void primitive_sbuf_to_string(void) { - SBUF* sbuf = untag_sbuf(dpeek()); - STRING* s = string_clone(sbuf->string,sbuf->top); + SBUF* sbuf; + STRING* s; + + maybe_garbage_collection(); + + sbuf = untag_sbuf(dpeek()); + s = string_clone(sbuf->string,sbuf->top); rehash_string(s); drepl(tag_object(s)); } @@ -112,8 +135,14 @@ void primitive_sbuf_reverse(void) void primitive_sbuf_clone(void) { - SBUF* s = untag_sbuf(dpeek()); - SBUF* new_s = sbuf(s->top); + SBUF* s; + SBUF* new_s; + + maybe_garbage_collection(); + + s = untag_sbuf(dpeek()); + new_s = sbuf(s->top); + sbuf_append_string(new_s,s->string); drepl(tag_object(new_s)); } diff --git a/native/socket.c b/native/socket.c index 3919fc8d1a..5b5b59bd6c 100644 --- a/native/socket.c +++ b/native/socket.c @@ -45,8 +45,14 @@ int make_client_socket(const char* hostname, uint16_t port) void primitive_client_socket(void) { uint16_t p = (uint16_t)to_fixnum(dpop()); - char* host = unbox_c_string(); - int sock = make_client_socket(host,p); + char* host; + int sock; + + maybe_garbage_collection(); + + host = unbox_c_string(); + sock = make_client_socket(host,p); + dpush(tag_object(port(PORT_RECV,sock))); dpush(tag_object(port(PORT_WRITE,sock))); } @@ -91,13 +97,16 @@ int make_server_socket(uint16_t port) void primitive_server_socket(void) { uint16_t p = (uint16_t)to_fixnum(dpop()); + maybe_garbage_collection(); dpush(tag_object(port(PORT_SPECIAL,make_server_socket(p)))); } void primitive_add_accept_io_task(void) { - CELL callback = dpop(); - CELL port = dpop(); + CELL callback, port; + maybe_garbage_collection(); + callback = dpop(); + port = dpop(); add_io_task(IO_TASK_ACCEPT,port,F,callback, read_io_tasks,&read_fd_count); } @@ -131,7 +140,9 @@ CELL accept_connection(PORT* p) void primitive_accept_fd(void) { - PORT* p = untag_port(dpop()); + PORT* p; + maybe_garbage_collection(); + p = untag_port(dpop()); dpush(p->client_host); dpush(p->client_port); dpush(tag_object(port(PORT_RECV,p->client_socket))); diff --git a/native/stack.c b/native/stack.c index efb1acc447..5f00912d91 100644 --- a/native/stack.c +++ b/native/stack.c @@ -94,15 +94,14 @@ VECTOR* stack_to_vector(CELL bottom, CELL top) void primitive_datastack(void) { + maybe_garbage_collection(); dpush(tag_object(stack_to_vector(ds_bot,ds))); } void primitive_callstack(void) { - /* we don't want gc word to end up on callstack. */ - gc_protect = true; + maybe_garbage_collection(); dpush(tag_object(stack_to_vector(cs_bot,cs))); - gc_protect = false; } /* Returns top of stack */ diff --git a/native/string.c b/native/string.c index 42a9fcd4c8..66cbae3d6e 100644 --- a/native/string.c +++ b/native/string.c @@ -274,9 +274,14 @@ INLINE STRING* substring(CELL start, CELL end, STRING* string) /* start end string -- string */ void primitive_substring(void) { - STRING* string = untag_string(dpop()); - CELL end = to_fixnum(dpop()); - CELL start = to_fixnum(dpop()); + STRING* string; + CELL end, start; + + maybe_garbage_collection(); + + string = untag_string(dpop()); + end = to_fixnum(dpop()); + start = to_fixnum(dpop()); dpush(tag_object(substring(start,end,string))); } @@ -305,7 +310,11 @@ STRING* string_clone(STRING* s, int len) void primitive_string_reverse(void) { - STRING* s = untag_string(dpeek()); + STRING* s; + + maybe_garbage_collection(); + + s = untag_string(dpeek()); s = string_clone(s,s->capacity); string_reverse(s,s->capacity); rehash_string(s); diff --git a/native/vector.c b/native/vector.c index 761e2f79d0..3c704764e5 100644 --- a/native/vector.c +++ b/native/vector.c @@ -10,6 +10,7 @@ VECTOR* vector(FIXNUM capacity) void primitive_vector(void) { + maybe_garbage_collection(); drepl(tag_object(vector(to_fixnum(dpeek())))); } @@ -20,8 +21,13 @@ void primitive_vector_length(void) void primitive_set_vector_length(void) { - VECTOR* vector = untag_vector(dpop()); - FIXNUM length = to_fixnum(dpop()); + VECTOR* vector; + FIXNUM length; + + maybe_garbage_collection(); + + vector = untag_vector(dpop()); + length = to_fixnum(dpop()); if(length < 0) range_error(tag_object(vector),length,vector->top); vector->top = length; @@ -51,9 +57,15 @@ void vector_ensure_capacity(VECTOR* vector, CELL index) void primitive_set_vector_nth(void) { - VECTOR* vector = untag_vector(dpop()); - FIXNUM index = to_fixnum(dpop()); - CELL value = dpop(); + VECTOR* vector; + FIXNUM index; + CELL value; + + maybe_garbage_collection(); + + vector = untag_vector(dpop()); + index = to_fixnum(dpop()); + value = dpop(); if(index < 0) range_error(tag_object(vector),index,vector->top); diff --git a/native/word.c b/native/word.c index 0b9f70a2a3..e611fd4d45 100644 --- a/native/word.c +++ b/native/word.c @@ -25,9 +25,13 @@ void update_xt(WORD* word) /* ( primitive parameter plist -- word ) */ void primitive_word(void) { - CELL plist = dpop(); + CELL plist, parameter; FIXNUM primitive; - CELL parameter = dpop(); + + maybe_garbage_collection(); + + plist = dpop(); + parameter = dpop(); primitive = to_fixnum(dpop()); dpush(tag_word(word(primitive,parameter,plist))); } diff --git a/native/write.c b/native/write.c index 84e6c7dd28..363805b6be 100644 --- a/native/write.c +++ b/native/write.c @@ -38,16 +38,25 @@ bool can_write(PORT* port, FIXNUM len) void primitive_can_write(void) { - PORT* port = untag_port(dpop()); - FIXNUM len = to_fixnum(dpop()); + PORT* port; + FIXNUM len; + + maybe_garbage_collection(); + + port = untag_port(dpop()); + len = to_fixnum(dpop()); pending_io_error(port); dpush(tag_boolean(can_write(port,len))); } void primitive_add_write_io_task(void) { - CELL callback = dpop(); - CELL port = dpop(); + CELL callback, port; + + maybe_garbage_collection(); + + callback = dpop(); + port = dpop(); add_io_task(IO_TASK_WRITE,port,F,callback, write_io_tasks,&write_fd_count); } @@ -107,12 +116,17 @@ void write_string_8(PORT* port, STRING* str) void primitive_write_8(void) { - PORT* port = untag_port(dpop()); - - CELL text = dpop(); - CELL type = type_of(text); + PORT* port; + CELL text, type; STRING* str; + maybe_garbage_collection(); + + port = untag_port(dpop()); + + text = dpop(); + type = type_of(text); + pending_io_error(port); switch(type)