better low memory barrier handling

diff --git a/doc/handbook.tex b/doc/handbook.tex
index dcbc6db0c538cc8a2d8d87d85600422bbd6fffed..3cea508d6ac806f5a5fe16c8ff664cbc18e7594c 100644 (file)
--- a/doc/handbook.tex
+++ b/doc/handbook.tex
@@ -7,10 +7,9 @@
 \usepackage{alltt}
 \usepackage{times}
 \usepackage{tabularx}
-\usepackage{epstopdf}
 \usepackage{epsfig}
-\usepackage{epsf}
 \usepackage{amssymb}
+\usepackage{epstopdf}
 
 \pagestyle{headings}
 

diff --git a/library/test/strings.factor b/library/test/strings.factor
index d44eaef2aefdb2aad786e027a48ffc1c1a507ae0..66e7a77267829ceb9adb2853321d724b8c93b7a6 100644 (file)
--- a/library/test/strings.factor
+++ b/library/test/strings.factor
@@ -90,8 +90,8 @@ unit-test
 ]
 unit-test
 
-[ "05" ] [ "5" 2 CHAR: 0 pad ] unit-test
-[ "666" ] [ "666" 2 CHAR: 0 pad ] unit-test
+[ "05" ] [ "5" 2 CHAR: 0 pad-left ] unit-test
+[ "666" ] [ "666" 2 CHAR: 0 pad-left ] unit-test
 
 [ 1 "" nth ] unit-test-fails
 [ -6 "hello" nth ] unit-test-fails

diff --git a/native/alien.c b/native/alien.c
index f4734afdad2c925417184641a2ca9aa882af65f4..edd0ca24f3a1228cb129cc8f1c23b87823f322ce 100644 (file)
--- a/native/alien.c
+++ b/native/alien.c
@@ -52,7 +52,7 @@ void box_alien(void* ptr)
 void primitive_alien(void)
 {
        void* ptr = (void*)unbox_signed_cell();
-       maybe_garbage_collection();
+       maybe_gc(sizeof(ALIEN));
        box_alien(ptr);
 }
 
@@ -61,7 +61,7 @@ void primitive_displaced_alien(void)
        CELL alien;
        CELL displacement;
        DISPLACED_ALIEN* d;
-       maybe_garbage_collection();
+       maybe_gc(sizeof(DISPLACED_ALIEN));
        alien = dpop();
        displacement = unbox_unsigned_cell();
        d = allot_object(DISPLACED_ALIEN_TYPE,sizeof(DISPLACED_ALIEN));

diff --git a/native/array.c b/native/array.c
index 09be56e9a4932e3369b6dc15bbd4e4c0b355a75d..bbf9a4cbdf04e1f2dddc629babdc3c5e77e70de8 100644 (file)
--- a/native/array.c
+++ b/native/array.c
@@ -9,7 +9,7 @@ F_ARRAY* allot_array(CELL type, CELL capacity)
        if(capacity < 0)
                general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
 
-       array = allot_object(type,sizeof(F_ARRAY) + capacity * CELLS);
+       array = allot_object(type,array_size(capacity));
        array->capacity = tag_fixnum(capacity);
        return array;
 }
@@ -30,20 +30,23 @@ F_ARRAY* array(CELL type, CELL capacity, CELL fill)
 
 void primitive_array(void)
 {
-       maybe_garbage_collection();
-       dpush(tag_object(array(ARRAY_TYPE,to_fixnum(dpop()),F)));
+       CELL size = to_fixnum(dpop());
+       maybe_gc(array_size(size));
+       dpush(tag_object(array(ARRAY_TYPE,size,F)));
 }
 
 void primitive_tuple(void)
 {
-       maybe_garbage_collection();
-       dpush(tag_object(array(TUPLE_TYPE,to_fixnum(dpop()),F)));
+       CELL size = to_fixnum(dpop());
+       maybe_gc(array_size(size));
+       dpush(tag_object(array(TUPLE_TYPE,size,F)));
 }
 
 void primitive_byte_array(void)
 {
-       maybe_garbage_collection();
-       dpush(tag_object(array(BYTE_ARRAY_TYPE,to_fixnum(dpop()),0)));
+       CELL size = to_fixnum(dpop());
+       maybe_gc(array_size(size));
+       dpush(tag_object(array(BYTE_ARRAY_TYPE,size,0)));
 }
 
 /* see note about fill in array() */
@@ -69,7 +72,7 @@ F_ARRAY* resize_array(F_ARRAY* array, CELL capacity, CELL fill)
 void primitive_resize_array(void)
 {
        F_ARRAY* array; CELL capacity;
-       maybe_garbage_collection();
+       maybe_gc(0);
        array = untag_array_fast(dpop());
        capacity = to_fixnum(dpop());
        dpush(tag_object(resize_array(array,capacity,F)));

diff --git a/native/array.h b/native/array.h
index 1ce208b81abff03e6b265e0a8f7d4a3eaf4186d7..f17fa5f9f5b7a45be81e40d21208faf18c2ce382 100644 (file)
--- a/native/array.h
+++ b/native/array.h
@@ -14,6 +14,11 @@ INLINE F_ARRAY* untag_byte_array_fast(CELL tagged)
        return (F_ARRAY*)UNTAG(tagged);
 }
 
+INLINE CELL array_size(CELL size)
+{
+       return align8(sizeof(F_ARRAY) + size * CELLS);
+}
+
 F_ARRAY* allot_array(CELL type, CELL capacity);
 F_ARRAY* array(CELL type, CELL capacity, CELL fill);
 

diff --git a/native/bignum.c b/native/bignum.c
index a15892ae14c6d6450a4317373680ec88e69b9a95..64d8d387693c0f3ac3916382fd8420b13d7187fc 100644 (file)
--- a/native/bignum.c
+++ b/native/bignum.c
@@ -43,13 +43,13 @@ F_ARRAY* to_bignum(CELL tagged)
 
 void primitive_to_bignum(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        drepl(tag_bignum(to_bignum(dpeek())));
 }
 
 #define GC_AND_POP_BIGNUMS(x,y) \
        F_ARRAY *x, *y; \
-       maybe_garbage_collection(); \
+       maybe_gc(0); \
        y = untag_bignum_fast(dpop()); \
        x = untag_bignum_fast(dpop());
 
@@ -128,7 +128,7 @@ void primitive_bignum_shift(void)
 {
        F_FIXNUM y;
         F_ARRAY* x;
-       maybe_garbage_collection();
+       maybe_gc(0);
        y = to_fixnum(dpop());
        x = to_bignum(dpop());
        dpush(tag_bignum(s48_bignum_arithmetic_shift(x,y)));
@@ -184,7 +184,7 @@ void primitive_bignum_greatereq(void)
 
 void primitive_bignum_not(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        drepl(tag_bignum(s48_bignum_bitwise_not(
                untag_bignum_fast(dpeek()))));
 }

diff --git a/native/complex.c b/native/complex.c
index abd86cd37514a5d17dce45aa8b0d26c951625b62..284ce590fade064fc8f594471fcf4e727fd5f04c 100644 (file)
--- a/native/complex.c
+++ b/native/complex.c
@@ -5,7 +5,7 @@ void primitive_from_rect(void)
        CELL real, imaginary;
        F_CONS* complex;
 
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_CONS));
 
        imaginary = dpop();
        real = dpop();

diff --git a/native/cons.c b/native/cons.c
index 0c06d82ba805ffa91cce3ff51865a2d7913d0380..e3fb76cbedaf91ffb78cc438de879cd627c6ac40 100644 (file)
--- a/native/cons.c
+++ b/native/cons.c
@@ -11,7 +11,7 @@ CELL cons(CELL car, CELL cdr)
 void primitive_cons(void)
 {
        CELL car, cdr;
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_CONS));
        cdr = dpop();
        car = dpop();
        dpush(cons(car,cdr));

diff --git a/native/dll.c b/native/dll.c
index 7f70d4181d43e6137717ac4f1054b7c2663c59fc..e5a17c99fb796f5ac53cdb158f29c3bdcfd4186e 100644 (file)
--- a/native/dll.c
+++ b/native/dll.c
@@ -5,7 +5,7 @@ void primitive_dlopen(void)
        DLL* dll;
        F_STRING* path;
 
-       maybe_garbage_collection();
+       maybe_gc(sizeof(DLL));
 
        path = untag_string(dpop());
        dll = allot_object(DLL_TYPE,sizeof(DLL));
@@ -20,7 +20,7 @@ void primitive_dlsym(void)
        CELL dll;
        F_STRING* sym;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        dll = dpop();
        sym = untag_string(dpop());
@@ -32,7 +32,6 @@ void primitive_dlsym(void)
 
 void primitive_dlclose(void)
 {
-       maybe_garbage_collection();
        ffi_dlclose(untag_dll(dpop()));
 }
 

diff --git a/native/float.c b/native/float.c
index 071dec1b3135e7ff3072a59afc668d8262254fc6..d0742894cfacc9628b2c3d125ec85b4d7a0b63c0 100644 (file)
--- a/native/float.c
+++ b/native/float.c
@@ -1,13 +1,5 @@
 #include "factor.h"
 
-void foobar(int x, int y, int z, int t)
-{
-       printf("%d\n",x);
-       printf("%d\n",y);
-       printf("%d\n",z);
-       printf("%d\n",t);
-}
-
 double to_float(CELL tagged)
 {
        F_RATIO* r;
@@ -35,7 +27,7 @@ double to_float(CELL tagged)
 
 void primitive_to_float(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(to_float(dpeek())));
 }
 
@@ -45,7 +37,7 @@ void primitive_str_to_float(void)
        char *c_str, *end;
        double f;
 
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
 
        str = untag_string(dpeek());
        c_str = to_c_string(str);
@@ -60,7 +52,7 @@ void primitive_float_to_str(void)
 {
        char tmp[33];
 
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
 
        snprintf(tmp,32,"%.16g",to_float(dpop()));
        tmp[32] = '\0';
@@ -69,7 +61,7 @@ void primitive_float_to_str(void)
 
 #define GC_AND_POP_FLOATS(x,y) \
        double x, y; \
-       maybe_garbage_collection(); \
+       maybe_gc(sizeof(F_FLOAT)); \
        y = untag_float_fast(dpop()); \
        x = untag_float_fast(dpop());
 
@@ -129,26 +121,26 @@ void primitive_float_greatereq(void)
 
 void primitive_facos(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(acos(to_float(dpeek()))));
 }
 
 void primitive_fasin(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(asin(to_float(dpeek()))));
 }
 
 void primitive_fatan(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(atan(to_float(dpeek()))));
 }
 
 void primitive_fatan2(void)
 {
        double x, y;
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        y = to_float(dpop());
        x = to_float(dpop());
        dpush(tag_float(atan2(x,y)));
@@ -156,32 +148,32 @@ void primitive_fatan2(void)
 
 void primitive_fcos(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(cos(to_float(dpeek()))));
 }
 
 void primitive_fexp(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(exp(to_float(dpeek()))));
 }
 
 void primitive_fcosh(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(cosh(to_float(dpeek()))));
 }
 
 void primitive_flog(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(log(to_float(dpeek()))));
 }
 
 void primitive_fpow(void)
 {
        double x, y;
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        y = to_float(dpop());
        x = to_float(dpop());
        dpush(tag_float(pow(x,y)));
@@ -189,19 +181,19 @@ void primitive_fpow(void)
 
 void primitive_fsin(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(sin(to_float(dpeek()))));
 }
 
 void primitive_fsinh(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(sinh(to_float(dpeek()))));
 }
 
 void primitive_fsqrt(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_FLOAT));
        drepl(tag_float(sqrt(to_float(dpeek()))));
 }
 

diff --git a/native/gc.c b/native/gc.c
index d90a86dc540b527daf3f18ba5cbd469c6112747a..159eceab50fd80d5714689b561cbafb06d4248a5 100644 (file)
--- a/native/gc.c
+++ b/native/gc.c
@@ -318,9 +318,9 @@ void primitive_gc(void)
 
 /* WARNING: only call this from a context where all local variables
 are also reachable via the GC roots. */
-void maybe_garbage_collection(void)
+void maybe_gc(CELL size)
 {
-       if(nursery.here > nursery.alarm)
+       if(nursery.here + size > nursery.alarm)
        {
                CELL gen = NURSERY;
                while(gen < TENURED)
@@ -337,6 +337,6 @@ void maybe_garbage_collection(void)
 
 void primitive_gc_time(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        dpush(tag_bignum(s48_long_long_to_bignum(gc_time)));
 }

diff --git a/native/gc.h b/native/gc.h
index a7678d6d3073f16d87a2d098463809c4eb78357c..023f627c232d95dcc87a8ff303f23e6f3025001a 100644 (file)
--- a/native/gc.h
+++ b/native/gc.h
@@ -114,5 +114,5 @@ INLINE void* allot_object(CELL type, CELL length)
 CELL collect_next(CELL scan);
 void garbage_collection(CELL gen);
 void primitive_gc(void);
-void maybe_garbage_collection(void);
+void maybe_gc(CELL size);
 void primitive_gc_time(void);

diff --git a/native/hashtable.c b/native/hashtable.c
index c952fc99dbae10b2b7a4878d0f4550668892d1e8..f349a80b151a2fa94769edc2cce1ad8dafebc657 100644 (file)
--- a/native/hashtable.c
+++ b/native/hashtable.c
@@ -13,7 +13,7 @@ F_HASHTABLE* hashtable(F_FIXNUM capacity)
 
 void primitive_hashtable(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        drepl(tag_object(hashtable(to_fixnum(dpeek()))));
 }
 

diff --git a/native/io.c b/native/io.c
index ffaf089b85d62d38279f584c8e21c01dfbe39211..57622194431b5ed2f5c04b52e57554e63dfded8e 100644 (file)
--- a/native/io.c
+++ b/native/io.c
@@ -34,7 +34,7 @@ void primitive_fopen(void)
 {
        char *path, *mode;
        FILE* file;
-       maybe_garbage_collection();
+       maybe_gc(0);
        mode = unbox_c_string();
        path = unbox_c_string();
        file = fopen(path,mode);
@@ -50,7 +50,7 @@ void primitive_fgets(void)
        FILE* file;
        char line[FACTOR_LINE_LEN];
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        file = (FILE*)unbox_alien();
        if(fgets(line,FACTOR_LINE_LEN,file) == NULL) 
@@ -68,7 +68,7 @@ void primitive_fwrite(void)
 {
        FILE* file;
        F_STRING* text;
-       maybe_garbage_collection();
+       maybe_gc(0);
        file = (FILE*)unbox_alien();
        text = untag_string(dpop());
        if(fwrite(to_c_string_unchecked(text),1,

diff --git a/native/memory.c b/native/memory.c
index 5568624cf616363cb7a66959b410028780bcb183..245b982f6d46455e69d5883dc4bfd0fddaeb5d33 100644 (file)
--- a/native/memory.c
+++ b/native/memory.c
@@ -55,8 +55,7 @@ CELL untagged_object_size(CELL pointer)
        case TUPLE_TYPE:
        case BIGNUM_TYPE:
        case BYTE_ARRAY_TYPE:
-               size = align8(sizeof(F_ARRAY) +
-                       array_capacity((F_ARRAY*)(pointer)) * CELLS);
+               size = array_size(array_capacity((F_ARRAY*)(pointer)));
                break;
        case HASHTABLE_TYPE:
                size = sizeof(F_HASHTABLE);
@@ -65,7 +64,7 @@ CELL untagged_object_size(CELL pointer)
                size = sizeof(F_VECTOR);
                break;
        case STRING_TYPE:
-               size = SSIZE(pointer);
+               size = string_size(string_capacity((F_STRING*)(pointer)));
                break;
        case SBUF_TYPE:
                size = sizeof(F_SBUF);

diff --git a/native/misc.c b/native/misc.c
index 71ebf1e98d1d96a74d9cf824aaa65e1c5581bdba..b44017a9b4186ec77ac2203cb0fd751b79f64acf 100644 (file)
--- a/native/misc.c
+++ b/native/misc.c
@@ -9,7 +9,7 @@ void primitive_os_env(void)
 {
        char *name, *value;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        name = unbox_c_string();
        value = getenv(name);
@@ -43,13 +43,13 @@ s64 current_millis(void)
 
 void primitive_millis(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        dpush(tag_bignum(s48_long_long_to_bignum(current_millis())));
 }
 
 void primitive_random_int(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        dpush(tag_bignum(s48_long_to_bignum(rand())));
 }
 

diff --git a/native/ratio.c b/native/ratio.c
index 7875373cb63bfb55a179bc1b41cfc5872c30ad0d..1632149ea7a96ee6d7aacb6fffcd86d43e4d448a 100644 (file)
--- a/native/ratio.c
+++ b/native/ratio.c
@@ -7,7 +7,7 @@ void primitive_from_fraction(void)
        CELL numerator, denominator;
        F_RATIO* ratio;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        denominator = dpop();
        numerator = dpop();

diff --git a/native/relocate.c b/native/relocate.c
index 4470821534e771cf8e05b2dc0214b49c7a77f228..602524b592a2c57c6a0a43f8672624bd4394969c 100644 (file)
--- a/native/relocate.c
+++ b/native/relocate.c
@@ -140,7 +140,7 @@ INLINE CELL relocate_code_next(CELL relocating)
                        original = get(rel->offset);
 
                /* to_c_string can fill up the heap */
-               maybe_garbage_collection();
+               maybe_gc(0);
                new_value = compute_code_rel(rel,original);
 
                if(REL_RELATIVE(rel))

diff --git a/native/sbuf.c b/native/sbuf.c
index 56b19c109e82ef34ceaf670d07f63544795391f1..2b80e9a40b52882650b032798163656b394bd3a9 100644 (file)
--- a/native/sbuf.c
+++ b/native/sbuf.c
@@ -13,8 +13,9 @@ F_SBUF* sbuf(F_FIXNUM capacity)
 
 void primitive_sbuf(void)
 {
-       maybe_garbage_collection();
-       drepl(tag_object(sbuf(to_fixnum(dpeek()))));
+       CELL size = to_fixnum(dpeek());
+       maybe_gc(sizeof(F_SBUF) + string_size(size));
+       drepl(tag_object(sbuf(size)));
 }
 
 void primitive_sbuf_to_string(void)

diff --git a/native/stack.c b/native/stack.c
index b7eaba4927aa599ec86c985536cfcf8d2e57823d..d2b571f6db5b5f9f431a7a0cafec6e9a4f618350 100644 (file)
--- a/native/stack.c
+++ b/native/stack.c
@@ -83,13 +83,13 @@ F_VECTOR* stack_to_vector(CELL bottom, CELL top)
 
 void primitive_datastack(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        dpush(tag_object(stack_to_vector(ds_bot,ds)));
 }
 
 void primitive_callstack(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        dpush(tag_object(stack_to_vector(cs_bot,cs)));
 }
 

diff --git a/native/string.c b/native/string.c
index 3ba264251433c93b07d28a12e329909c9918b055..2b075189e4b6e046c31eb8dee73ace1942b18081 100644 (file)
--- a/native/string.c
+++ b/native/string.c
@@ -67,7 +67,7 @@ F_STRING* resize_string(F_STRING* string, F_FIXNUM capacity, u16 fill)
 void primitive_resize_string(void)
 {
        F_STRING* string; CELL capacity;
-       maybe_garbage_collection();
+       maybe_gc(0);
        string = untag_string_fast(dpop());
        capacity = to_fixnum(dpop());
        dpush(tag_object(resize_string(string,capacity,F)));

diff --git a/native/string.h b/native/string.h
index 16b4496f059f2041f3fb1dba2d7ba6a7e5edfddf..93bc61c13907c221e9f5a7a903e8aefaa4147870 100644 (file)
--- a/native/string.h
+++ b/native/string.h
@@ -24,8 +24,10 @@ INLINE CELL string_capacity(F_STRING* str)
        return untag_fixnum_fast(str->length);
 }
 
-#define SSIZE(pointer) align8(sizeof(F_STRING) + \
-       (string_capacity((F_STRING*)(pointer)) + 1) * CHARS)
+INLINE CELL string_size(CELL size)
+{
+       return align8(sizeof(F_STRING) + (size + 1) * CHARS);
+}
 
 F_STRING* allot_string(CELL capacity);
 F_STRING* string(CELL capacity, CELL fill);

diff --git a/native/unix/ffi.c b/native/unix/ffi.c
index 8c258abc9774751fdfa1e7dacb7b00015cf638fb..5583a0e22ea74afc76b4ef3720cc210c9304bf05 100644 (file)
--- a/native/unix/ffi.c
+++ b/native/unix/ffi.c
@@ -35,7 +35,7 @@ void *ffi_dlsym(DLL *dll, F_STRING *symbol)
 
 void ffi_dlclose(DLL *dll)
 {
-       if(dlclose(dll->dll) != NULL)
+       if(dlclose(dll->dll))
        {
                general_error(ERROR_FFI,tag_object(
                        from_c_string(dlerror())));

diff --git a/native/unix/file.c b/native/unix/file.c
index 763ff6f460de288475fcde9dc0a396395b07e4b3..3793b6d5bc9f7a713caf79f8205e796be811b504 100644 (file)
--- a/native/unix/file.c
+++ b/native/unix/file.c
@@ -5,7 +5,7 @@ void primitive_stat(void)
        struct stat sb;
        F_STRING* path;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        path = untag_string(dpop());
        if(stat(to_c_string(path),&sb) < 0)
@@ -33,7 +33,7 @@ void primitive_read_dir(void)
        DIR* dir;
        CELL result = F;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        path = untag_string(dpop());
        dir = opendir(to_c_string(path));
@@ -57,7 +57,7 @@ void primitive_read_dir(void)
 void primitive_cwd(void)
 {
        char wd[MAXPATHLEN];
-       maybe_garbage_collection();
+       maybe_gc(0);
        if(getcwd(wd,MAXPATHLEN) == NULL)
                io_error();
        box_c_string(wd);
@@ -65,7 +65,7 @@ void primitive_cwd(void)
 
 void primitive_cd(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        chdir(unbox_c_string());
 }
 

diff --git a/native/vector.c b/native/vector.c
index 928dbbf2ded7f9434d9daac70b3ea3dd1391af31..3bfb48f838071cefbf156e5b61d048ef9e55c4ed 100644 (file)
--- a/native/vector.c
+++ b/native/vector.c
@@ -13,8 +13,9 @@ F_VECTOR* vector(F_FIXNUM capacity)
 
 void primitive_vector(void)
 {
-       maybe_garbage_collection();
-       drepl(tag_object(vector(to_fixnum(dpeek()))));
+       CELL size = to_fixnum(dpeek());
+       maybe_gc(array_size(size) + sizeof(F_VECTOR));
+       drepl(tag_object(vector(size)));
 }
 
 void fixup_vector(F_VECTOR* vector)

diff --git a/native/win32/file.c b/native/win32/file.c
index e96a3af343225158146cf9e6b42c034f333198a0..13e7fc8db89ce798bf999a1470903349be7c94a1 100644 (file)
--- a/native/win32/file.c
+++ b/native/win32/file.c
@@ -5,7 +5,7 @@ void primitive_stat(void)
        F_STRING *path;
        WIN32_FILE_ATTRIBUTE_DATA st;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
        path = untag_string(dpop());
 
        if(!GetFileAttributesEx(to_c_string(path), GetFileExInfoStandard, &st)) 
@@ -34,7 +34,7 @@ void primitive_read_dir(void)
        WIN32_FIND_DATA find_data;
        CELL result = F;
 
-       maybe_garbage_collection();
+       maybe_gc(0);
 
        path = untag_string(dpop());
        if (INVALID_HANDLE_VALUE != (dir = FindFirstFile(".\\*", &find_data)))
@@ -55,7 +55,7 @@ void primitive_cwd(void)
 {
        char buf[MAX_PATH];
 
-       maybe_garbage_collection();
+       maybe_gc(0);
        if(!GetCurrentDirectory(MAX_PATH, buf))
                io_error();
 
@@ -64,6 +64,6 @@ void primitive_cwd(void)
 
 void primitive_cd(void)
 {
-       maybe_garbage_collection();
+       maybe_gc(0);
        SetCurrentDirectory(unbox_c_string());
 }
\ No newline at end of file

diff --git a/native/word.c b/native/word.c
index 2dad8a229938688f41c5755a63a4bdcd3a236932..77016fe84c16e905c10c592dbc9170a14193efc8 100644 (file)
--- a/native/word.c
+++ b/native/word.c
@@ -13,7 +13,7 @@ void primitive_word(void)
 {
        F_WORD* word;
 
-       maybe_garbage_collection();
+       maybe_gc(sizeof(F_WORD));
 
        word = allot_object(WORD_TYPE,sizeof(F_WORD));
        word->hashcode = tag_fixnum((CELL)word); /* initial address */