From 56f8f8475106bbc589c02bf18c4cc1e122704858 Mon Sep 17 00:00:00 2001 From: slava Date: Thu, 2 Nov 2006 23:29:11 +0000 Subject: [PATCH] More allot_* cleanups --- TODO.FACTOR.txt | 5 - library/compiler/generator/xt.factor | 4 +- library/compiler/test/alien.factor | 4 +- library/test/kernel.factor | 8 +- library/test/math/integer.factor | 4 +- library/test/random.factor | 6 +- vm/alien.c | 18 +- vm/alien.h | 2 +- vm/bignum.c | 284 ++++++++++++++------------- vm/bignum.h | 4 +- vm/bignumint.h | 11 -- vm/code_gc.c | 2 +- vm/compiler.c | 11 +- vm/data_gc.c | 12 +- vm/data_gc.h | 40 ++-- vm/io.c | 10 +- vm/layouts.h | 2 +- vm/os-unix.c | 12 +- vm/os-unix.h | 2 +- vm/os-windows.c | 20 +- vm/os-windows.h | 2 +- vm/run.c | 2 + vm/run.h | 25 +++ vm/stack.c | 40 ++-- vm/stack.h | 64 ++---- vm/types.h | 5 - 26 files changed, 285 insertions(+), 314 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index f9b96f0c2f..a5ae63bd84 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,13 +1,8 @@ + allot refactoring: -- bignum operations -- rethink all string conversions - os-windows.c error_message &co - inline float allocation needs a gc check - alien invoke, callback need a gc check -- relocation should not cons at all -- ffi_dlopen, etc -- throwing an error can fill up the extra_roots stack - last-index miscompiles + ui: diff --git a/library/compiler/generator/xt.factor b/library/compiler/generator/xt.factor index bde4a151e3..d60108bc45 100644 --- a/library/compiler/generator/xt.factor +++ b/library/compiler/generator/xt.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: compiler -USING: arrays assembler errors generic hashtables kernel +USING: alien arrays assembler errors generic hashtables kernel kernel-internals math namespaces prettyprint queues sequences strings vectors words ; @@ -60,7 +60,7 @@ SYMBOL: label-table compiled-offset (rel) relocation-table get swap nappend ; : rel-dlsym ( name dll class -- ) - >r 2array add-literal r> 1 rel, ; + >r >r string>char-alien r> 2array add-literal r> 1 rel, ; : rel-here ( class -- ) dup rel-relative = [ drop ] [ 0 swap 2 rel, ] if ; diff --git a/library/compiler/test/alien.factor b/library/compiler/test/alien.factor index 996a843cec..fec2c8c4db 100644 --- a/library/compiler/test/alien.factor +++ b/library/compiler/test/alien.factor @@ -78,11 +78,11 @@ cpu "x86" = macosx? and [ : indirect-test-1 "int" { } "cdecl" alien-indirect ; -[ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test +[ 3 ] [ "ffi_test_1" f dlsym indirect-test-1 ] unit-test : indirect-test-2 "int" { "int" "int" } "cdecl" alien-indirect ; [ 5 ] -[ 2 3 "ffi_test_2" f dlsym indirect-test-2 ] +[ 2 3 "ffi_test_2" f dlsym indirect-test-2 ] unit-test diff --git a/library/test/kernel.factor b/library/test/kernel.factor index 4a9b57e784..423a4d76c1 100644 --- a/library/test/kernel.factor +++ b/library/test/kernel.factor @@ -1,6 +1,6 @@ IN: scratchpad -USING: kernel kernel-internals math memory namespaces sequences -test errors math-internals ; +USING: arrays kernel kernel-internals math memory namespaces +sequences test errors math-internals ; [ 0 ] [ f size ] unit-test [ t ] [ [ \ = \ = ] all-equal? ] unit-test @@ -8,8 +8,8 @@ test errors math-internals ; ! some primitives are missing GC checks [ ] [ 1000000 [ drop H{ } clone >n n> drop ] each ] unit-test ! [ ] [ 1.0 10000000 [ drop 1.0 * ] each ] unit-test -! [ ] [ 268435455 >fixnum 10000000 [ dup dup + drop ] each drop ] unit-test -[ ] [ 268435455 >fixnum 10000000 [ dup dup fixnum+ drop ] each drop ] unit-test +[ ] [ 268435455 >fixnum 10000000 [ dup dup + drop ] times drop ] unit-test +[ ] [ 268435455 >fixnum 10000000 [ dup dup fixnum+ drop ] times drop ] unit-test [ ] [ 10000000 [ drop 1/3 >fixnum drop ] each ] unit-test [ ] [ 10000000 [ drop 1/3 >bignum drop ] each ] unit-test [ ] [ 10000000 [ drop 1/3 >float drop ] each ] unit-test diff --git a/library/test/math/integer.factor b/library/test/math/integer.factor index e658d419cd..ba69dab132 100644 --- a/library/test/math/integer.factor +++ b/library/test/math/integer.factor @@ -54,8 +54,8 @@ USING: kernel math namespaces prettyprint test ; gcd nip ] unit-test -: verify-gcd ( x y ) - 2dup swap gcd ( a d ) +: verify-gcd + 2dup swap gcd >r rot * swap rem r> = ; [ t ] [ 123 124 verify-gcd ] unit-test diff --git a/library/test/random.factor b/library/test/random.factor index ed6a8f1f40..67fb03187c 100644 --- a/library/test/random.factor +++ b/library/test/random.factor @@ -1,10 +1,10 @@ IN: temporary USING: errors kernel math namespaces sequences test ; -: check-random-int ( max -- ) - >r random-int 0 r> between? ; +: check-random-int ( max -- ? ) + dup >r random-int 0 r> between? ; -[ t ] [ 100 [ 674 check-random-int ] all? ] unit-test +[ t ] [ 100 [ drop 674 check-random-int ] all? ] unit-test : make-100-random-ints [ 100 [ 100 random-int , ] times ] { } make ; diff --git a/vm/alien.c b/vm/alien.c index 603c6c609b..0d3ddef385 100644 --- a/vm/alien.c +++ b/vm/alien.c @@ -25,7 +25,7 @@ void *alien_offset(CELL object) switch(type_of(object)) { case BYTE_ARRAY_TYPE: - array = untag_byte_array_fast(object); + array = untag_array_fast(object); return array + 1; case ALIEN_TYPE: alien = untag_alien_fast(object); @@ -59,12 +59,12 @@ CELL allot_alien(CELL delegate, CELL displacement) } /* make an alien and push */ -void box_alien(CELL ptr) +void box_alien(void* ptr) { - if(ptr == 0) + if(ptr == NULL) dpush(F); else - dpush(allot_alien(F,ptr)); + dpush(allot_alien(F,(CELL)ptr)); } /* make an alien pointing at an offset of another alien */ @@ -155,6 +155,7 @@ void box_value_pair(CELL x, CELL y) /* open a native library and push a handle */ void primitive_dlopen(void) { + primitive_string_to_char_alien(); F_DLL* dll = allot_object(DLL_TYPE,sizeof(F_DLL)); dll->path = dpop(); ffi_dlopen(dll,true); @@ -165,9 +166,12 @@ void primitive_dlopen(void) void primitive_dlsym(void) { CELL dll = dpop(); - F_STRING *sym = untag_string(dpop()); + REGISTER_ROOT(dll); + char *sym = unbox_char_string(); + UNREGISTER_ROOT(dll); + F_DLL *d; - + if(dll == F) d = NULL; else @@ -177,7 +181,7 @@ void primitive_dlsym(void) general_error(ERROR_EXPIRED,dll,F,true); } - box_signed_cell((CELL)ffi_dlsym(d,sym,true)); + box_alien(ffi_dlsym(d,sym,true)); } /* close a native library handle */ diff --git a/vm/alien.h b/vm/alien.h index 9ce76687d2..68784b7e2a 100644 --- a/vm/alien.h +++ b/vm/alien.h @@ -16,7 +16,7 @@ void* alien_offset(CELL object); void fixup_alien(F_ALIEN* d); DLLEXPORT void *unbox_alien(void); -DLLEXPORT void box_alien(CELL ptr); +DLLEXPORT void box_alien(void *ptr); void primitive_alien_signed_cell(void); void primitive_set_alien_signed_cell(void); diff --git a/vm/bignum.c b/vm/bignum.c index 18515d3672..51bd4583bd 100644 --- a/vm/bignum.c +++ b/vm/bignum.c @@ -91,6 +91,7 @@ s48_bignum_compare(bignum_type x, bignum_type y) : (bignum_compare_unsigned (x, y)))); } +/* allocates memory */ bignum_type s48_bignum_add(bignum_type x, bignum_type y) { @@ -108,6 +109,7 @@ s48_bignum_add(bignum_type x, bignum_type y) : (bignum_add_unsigned (x, y, 0))))); } +/* allocates memory */ bignum_type s48_bignum_subtract(bignum_type x, bignum_type y) { @@ -127,6 +129,7 @@ s48_bignum_subtract(bignum_type x, bignum_type y) : (bignum_subtract_unsigned (x, y)))))); } +/* allocates memory */ bignum_type s48_bignum_multiply(bignum_type x, bignum_type y) { @@ -159,6 +162,7 @@ s48_bignum_multiply(bignum_type x, bignum_type y) return (bignum_multiply_unsigned (x, y, negative_p)); } +/* allocates memory */ void s48_bignum_divide(bignum_type numerator, bignum_type denominator, bignum_type * quotient, bignum_type * remainder) @@ -231,6 +235,7 @@ s48_bignum_divide(bignum_type numerator, bignum_type denominator, } } +/* allocates memory */ bignum_type s48_bignum_quotient(bignum_type numerator, bignum_type denominator) { @@ -283,6 +288,7 @@ s48_bignum_quotient(bignum_type numerator, bignum_type denominator) } } +/* allocates memory */ bignum_type s48_bignum_remainder(bignum_type numerator, bignum_type denominator) { @@ -348,7 +354,7 @@ s48_bignum_remainder(bignum_type numerator, bignum_type denominator) } \ { \ bignum_type result = \ - (bignum_allocate ((end_digits - result_digits), negative_p)); \ + (allot_bignum ((end_digits - result_digits), negative_p)); \ bignum_digit_type * scan_digits = result_digits; \ bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \ while (scan_digits < end_digits) \ @@ -357,6 +363,7 @@ s48_bignum_remainder(bignum_type numerator, bignum_type denominator) } \ } +/* all below allocate memory */ FOO_TO_BIGNUM(cell,CELL,CELL) FOO_TO_BIGNUM(fixnum,F_FIXNUM,CELL) FOO_TO_BIGNUM(long,long,unsigned long) @@ -368,28 +375,30 @@ FOO_TO_BIGNUM(ulong_long,u64,u64) it probaly does not matter */ bignum_type s48_fixnum_pair_to_bignum(CELL x, F_FIXNUM y) { - return s48_bignum_add( - s48_bignum_arithmetic_shift( - s48_fixnum_to_bignum(y), - sizeof(unsigned long) * 8), - s48_cell_to_bignum(x)); + bignum_type hiword = s48_bignum_arithmetic_shift( + s48_fixnum_to_bignum(y),sizeof(unsigned long) * 8); + REGISTER_BIGNUM(hiword); + bignum_type loword = s48_cell_to_bignum(x); + UNREGISTER_BIGNUM(hiword); + return s48_bignum_add(hiword,loword); } #define BIGNUM_TO_FOO(name,type,utype) \ - type s48_bignum_to_##name(bignum_type bignum) \ - { \ - if (BIGNUM_ZERO_P (bignum)) \ - return (0); \ - { \ - utype accumulator = 0; \ - bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \ - bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \ - while (start < scan) \ - accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \ + type s48_bignum_to_##name(bignum_type bignum) \ + { \ + if (BIGNUM_ZERO_P (bignum)) \ + return (0); \ + { \ + utype accumulator = 0; \ + bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \ + bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \ + while (start < scan) \ + accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \ return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \ - } \ + } \ } +/* all of the below allocate memory */ BIGNUM_TO_FOO(cell,CELL,CELL); BIGNUM_TO_FOO(fixnum,F_FIXNUM,CELL); BIGNUM_TO_FOO(long,long,unsigned long) @@ -412,14 +421,15 @@ s48_bignum_to_double(bignum_type bignum) } } -#define DTB_WRITE_DIGIT(factor) \ -{ \ - significand *= (factor); \ - digit = ((bignum_digit_type) significand); \ - (*--scan) = digit; \ - significand -= ((double) digit); \ +#define DTB_WRITE_DIGIT(factor) \ +{ \ + significand *= (factor); \ + digit = ((bignum_digit_type) significand); \ + (*--scan) = digit; \ + significand -= ((double) digit); \ } +/* allocates memory */ bignum_type s48_double_to_bignum(double x) { @@ -430,7 +440,7 @@ s48_double_to_bignum(double x) if (significand < 0) significand = (-significand); { bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent)); - bignum_type result = (bignum_allocate (length, (x < 0))); + bignum_type result = (allot_bignum (length, (x < 0))); bignum_digit_type * start = (BIGNUM_START_PTR (result)); bignum_digit_type * scan = (start + length); bignum_digit_type digit; @@ -501,6 +511,7 @@ bignum_compare_unsigned(bignum_type x, bignum_type y) /* Addition */ +/* allocates memory */ bignum_type bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p) { @@ -515,7 +526,7 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p) REGISTER_BIGNUM(x); REGISTER_BIGNUM(y); - bignum_type r = (bignum_allocate ((x_length + 1), negative_p)); + bignum_type r = (allot_bignum ((x_length + 1), negative_p)); UNREGISTER_BIGNUM(y); UNREGISTER_BIGNUM(x); @@ -570,6 +581,7 @@ bignum_add_unsigned(bignum_type x, bignum_type y, int negative_p) /* Subtraction */ +/* allocates memory */ bignum_type bignum_subtract_unsigned(bignum_type x, bignum_type y) { @@ -595,7 +607,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y) REGISTER_BIGNUM(x); REGISTER_BIGNUM(y); - bignum_type r = (bignum_allocate (x_length, negative_p)); + bignum_type r = (allot_bignum (x_length, negative_p)); UNREGISTER_BIGNUM(y); UNREGISTER_BIGNUM(x); @@ -650,6 +662,7 @@ bignum_subtract_unsigned(bignum_type x, bignum_type y) Maximum value for carry: ((R * (R - 1)) + (R - 1)) where R == BIGNUM_RADIX_ROOT */ +/* allocates memory */ bignum_type bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p) { @@ -674,7 +687,7 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p) REGISTER_BIGNUM(x); REGISTER_BIGNUM(y); bignum_type r = - (bignum_allocate_zeroed ((x_length + y_length), negative_p)); + (allot_bignum_zeroed ((x_length + y_length), negative_p)); UNREGISTER_BIGNUM(y); UNREGISTER_BIGNUM(x); @@ -723,6 +736,7 @@ bignum_multiply_unsigned(bignum_type x, bignum_type y, int negative_p) } } +/* allocates memory */ bignum_type bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y, int negative_p) @@ -730,7 +744,7 @@ bignum_multiply_unsigned_small_factor(bignum_type x, bignum_digit_type y, bignum_length_type length_x = (BIGNUM_LENGTH (x)); REGISTER_BIGNUM(x); - bignum_type p = (bignum_allocate ((length_x + 1), negative_p)); + bignum_type p = (allot_bignum ((length_x + 1), negative_p)); UNREGISTER_BIGNUM(x); bignum_destructive_copy (x, p); @@ -776,6 +790,7 @@ bignum_destructive_scale_up(bignum_type bignum, bignum_digit_type factor) volume 2, "Seminumerical Algorithms" section 4.3.1, "Multiple-Precision Arithmetic". */ +/* allocates memory */ void bignum_divide_unsigned_large_denominator(bignum_type numerator, bignum_type denominator, @@ -789,13 +804,11 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator, bignum_type q = ((quotient != ((bignum_type *) 0)) - ? (bignum_allocate ((length_n - length_d), q_negative_p)) + ? (allot_bignum ((length_n - length_d), q_negative_p)) : BIGNUM_OUT_OF_BAND); REGISTER_BIGNUM(q); - - bignum_type u = (bignum_allocate (length_n, r_negative_p)); - + bignum_type u = (allot_bignum (length_n, r_negative_p)); UNREGISTER_BIGNUM(q); int shift = 0; @@ -820,7 +833,7 @@ bignum_divide_unsigned_large_denominator(bignum_type numerator, REGISTER_BIGNUM(denominator); REGISTER_BIGNUM(u); REGISTER_BIGNUM(q); - bignum_type v = (bignum_allocate (length_d, 0)); + bignum_type v = (allot_bignum (length_d, 0)); UNREGISTER_BIGNUM(q); UNREGISTER_BIGNUM(u); UNREGISTER_BIGNUM(denominator); @@ -1004,6 +1017,7 @@ bignum_divide_subtract(bignum_digit_type * v_start, return (guess - 1); } +/* allocates memory */ void bignum_divide_unsigned_medium_denominator(bignum_type numerator, bignum_digit_type denominator, @@ -1027,7 +1041,7 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator, length_q = length_n; REGISTER_BIGNUM(numerator); - q = (bignum_allocate (length_q, q_negative_p)); + q = (allot_bignum (length_q, q_negative_p)); UNREGISTER_BIGNUM(numerator); bignum_destructive_copy (numerator, q); @@ -1037,7 +1051,7 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator, length_q = (length_n + 1); REGISTER_BIGNUM(numerator); - q = (bignum_allocate (length_q, q_negative_p)); + q = (allot_bignum (length_q, q_negative_p)); UNREGISTER_BIGNUM(numerator); bignum_destructive_normalization (numerator, q, shift); @@ -1047,28 +1061,27 @@ bignum_divide_unsigned_medium_denominator(bignum_type numerator, bignum_digit_type * start = (BIGNUM_START_PTR (q)); bignum_digit_type * scan = (start + length_q); bignum_digit_type qj; - if (quotient != ((bignum_type *) 0)) - { - while (start < scan) - { - r = (bignum_digit_divide (r, (*--scan), denominator, (&qj))); - (*scan) = qj; - } - (*quotient) = (bignum_trim (q)); - } - else + while (start < scan) { - while (start < scan) - r = (bignum_digit_divide (r, (*--scan), denominator, (&qj))); + r = (bignum_digit_divide (r, (*--scan), denominator, (&qj))); + (*scan) = qj; } + q = bignum_trim (q); + if (remainder != ((bignum_type *) 0)) { if (shift != 0) r >>= shift; + + REGISTER_BIGNUM(q); (*remainder) = (bignum_digit_to_bignum (r, r_negative_p)); + UNREGISTER_BIGNUM(q); } + + if (quotient != ((bignum_type *) 0)) + (*quotient) = q; } return; } @@ -1121,28 +1134,28 @@ bignum_destructive_unnormalization(bignum_type bignum, int shift_right) case of dividing two bignum digits by one bignum digit. It is assumed that the numerator, denominator are normalized. */ -#define BDD_STEP(qn, j) \ -{ \ - uj = (u[j]); \ - if (uj != v1) \ - { \ - uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \ - guess = (uj_uj1 / v1); \ - comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \ - } \ - else \ - { \ - guess = (BIGNUM_RADIX_ROOT - 1); \ - comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \ - } \ - while ((guess * v2) > comparand) \ - { \ - guess -= 1; \ - comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \ - if (comparand >= BIGNUM_RADIX) \ - break; \ - } \ - qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \ +#define BDD_STEP(qn, j) \ +{ \ + uj = (u[j]); \ + if (uj != v1) \ + { \ + uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \ + guess = (uj_uj1 / v1); \ + comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \ + } \ + else \ + { \ + guess = (BIGNUM_RADIX_ROOT - 1); \ + comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \ + } \ + while ((guess * v2) > comparand) \ + { \ + guess -= 1; \ + comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \ + if (comparand >= BIGNUM_RADIX) \ + break; \ + } \ + qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \ } bignum_digit_type @@ -1186,35 +1199,35 @@ bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, #undef BDD_STEP -#define BDDS_MULSUB(vn, un, carry_in) \ -{ \ - product = ((vn * guess) + carry_in); \ - diff = (un - (HD_LOW (product))); \ - if (diff < 0) \ - { \ - un = (diff + BIGNUM_RADIX_ROOT); \ - carry = ((HD_HIGH (product)) + 1); \ - } \ - else \ - { \ - un = diff; \ - carry = (HD_HIGH (product)); \ - } \ +#define BDDS_MULSUB(vn, un, carry_in) \ +{ \ + product = ((vn * guess) + carry_in); \ + diff = (un - (HD_LOW (product))); \ + if (diff < 0) \ + { \ + un = (diff + BIGNUM_RADIX_ROOT); \ + carry = ((HD_HIGH (product)) + 1); \ + } \ + else \ + { \ + un = diff; \ + carry = (HD_HIGH (product)); \ + } \ } -#define BDDS_ADD(vn, un, carry_in) \ -{ \ - sum = (vn + un + carry_in); \ - if (sum < BIGNUM_RADIX_ROOT) \ - { \ - un = sum; \ - carry = 0; \ - } \ - else \ - { \ - un = (sum - BIGNUM_RADIX_ROOT); \ - carry = 1; \ - } \ +#define BDDS_ADD(vn, un, carry_in) \ +{ \ + sum = (vn + un + carry_in); \ + if (sum < BIGNUM_RADIX_ROOT) \ + { \ + un = sum; \ + carry = 0; \ + } \ + else \ + { \ + un = (sum - BIGNUM_RADIX_ROOT); \ + carry = 1; \ + } \ } bignum_digit_type @@ -1252,6 +1265,7 @@ bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, #undef BDDS_MULSUB #undef BDDS_ADD +/* allocates memory */ void bignum_divide_unsigned_small_denominator(bignum_type numerator, bignum_digit_type denominator, @@ -1307,6 +1321,7 @@ bignum_destructive_scale_down(bignum_type bignum, bignum_digit_type denominator) #undef quotient_high } +/* allocates memory */ bignum_type bignum_remainder_unsigned_small_denominator( bignum_type n, bignum_digit_type d, int negative_p) @@ -1327,6 +1342,7 @@ bignum_remainder_unsigned_small_denominator( return (bignum_digit_to_bignum (r, negative_p)); } +/* allocates memory */ bignum_type bignum_digit_to_bignum(bignum_digit_type digit, int negative_p) { @@ -1334,40 +1350,38 @@ bignum_digit_to_bignum(bignum_digit_type digit, int negative_p) return (BIGNUM_ZERO ()); else { - bignum_type result = (bignum_allocate (1, negative_p)); + bignum_type result = (allot_bignum (1, negative_p)); (BIGNUM_REF (result, 0)) = digit; return (result); } } -/* Allocation */ - +/* allocates memory */ bignum_type -bignum_allocate(bignum_length_type length, int negative_p) +allot_bignum(bignum_length_type length, int negative_p) { BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX)); - { - bignum_type result = (BIGNUM_ALLOCATE (length)); - BIGNUM_SET_NEGATIVE_P (result, negative_p); - return (result); - } + bignum_type result = allot_array_internal(BIGNUM_TYPE,length + 1); + BIGNUM_SET_NEGATIVE_P (result, negative_p); + return (result); } +/* allocates memory */ bignum_type -bignum_allocate_zeroed(bignum_length_type length, int negative_p) +allot_bignum_zeroed(bignum_length_type length, int negative_p) { - BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX)); - { - bignum_type result = (BIGNUM_ALLOCATE (length)); - bignum_digit_type * scan = (BIGNUM_START_PTR (result)); - bignum_digit_type * end = (scan + length); - BIGNUM_SET_NEGATIVE_P (result, negative_p); - while (scan < end) - (*scan++) = 0; - return (result); - } + bignum_type result = allot_bignum(length,negative_p); + bignum_digit_type * scan = (BIGNUM_START_PTR (result)); + bignum_digit_type * end = (scan + length); + while (scan < end) + (*scan++) = 0; + return (result); } +#define BIGNUM_REDUCE_LENGTH(source, length) \ + source = reallot_array(source,length + 1,69) + +/* allocates memory */ bignum_type bignum_shorten_length(bignum_type bignum, bignum_length_type length) { @@ -1381,6 +1395,7 @@ bignum_shorten_length(bignum_type bignum, bignum_length_type length) return (bignum); } +/* allocates memory */ bignum_type bignum_trim(bignum_type bignum) { @@ -1401,18 +1416,20 @@ bignum_trim(bignum_type bignum) /* Copying */ +/* allocates memory */ bignum_type bignum_new_sign(bignum_type bignum, int negative_p) { REGISTER_BIGNUM(bignum); bignum_type result = - (bignum_allocate ((BIGNUM_LENGTH (bignum)), negative_p)); + (allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p)); UNREGISTER_BIGNUM(bignum); bignum_destructive_copy (bignum, result); return (result); } +/* allocates memory */ bignum_type bignum_maybe_new_sign(bignum_type bignum, int negative_p) { @@ -1421,7 +1438,7 @@ bignum_maybe_new_sign(bignum_type bignum, int negative_p) else { bignum_type result = - (bignum_allocate ((BIGNUM_LENGTH (bignum)), negative_p)); + (allot_bignum ((BIGNUM_LENGTH (bignum)), negative_p)); bignum_destructive_copy (bignum, result); return (result); } @@ -1439,28 +1456,18 @@ bignum_destructive_copy(bignum_type source, bignum_type target) return; } -/* Unused -void -bignum_destructive_zero(bignum_type bignum) -{ - bignum_digit_type * scan = (BIGNUM_START_PTR (bignum)); - bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum))); - while (scan < end) - (*scan++) = 0; - return; -} -*/ - /* * Added bitwise operations (and oddp). */ +/* allocates memory */ bignum_type s48_bignum_bitwise_not(bignum_type x) { return s48_bignum_subtract(BIGNUM_ONE(1), x); } +/* allocates memory */ bignum_type s48_bignum_arithmetic_shift(bignum_type arg1, long n) { @@ -1476,6 +1483,7 @@ s48_bignum_arithmetic_shift(bignum_type arg1, long n) #define IOR_OP 1 #define XOR_OP 2 +/* allocates memory */ bignum_type s48_bignum_bitwise_and(bignum_type arg1, bignum_type arg2) { @@ -1490,6 +1498,7 @@ s48_bignum_bitwise_and(bignum_type arg1, bignum_type arg2) ); } +/* allocates memory */ bignum_type s48_bignum_bitwise_ior(bignum_type arg1, bignum_type arg2) { @@ -1504,6 +1513,7 @@ s48_bignum_bitwise_ior(bignum_type arg1, bignum_type arg2) ); } +/* allocates memory */ bignum_type s48_bignum_bitwise_xor(bignum_type arg1, bignum_type arg2) { @@ -1518,6 +1528,7 @@ s48_bignum_bitwise_xor(bignum_type arg1, bignum_type arg2) ); } +/* allocates memory */ /* ash for the magnitude */ /* assume arg1 is a big number, n is a long */ bignum_type @@ -1537,7 +1548,7 @@ bignum_magnitude_ash(bignum_type arg1, long n) bit_offset = n % BIGNUM_DIGIT_LENGTH; REGISTER_BIGNUM(arg1); - result = bignum_allocate_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1, + result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1, BIGNUM_NEGATIVE_P(arg1)); UNREGISTER_BIGNUM(arg1); @@ -1562,7 +1573,7 @@ bignum_magnitude_ash(bignum_type arg1, long n) bit_offset = -n % BIGNUM_DIGIT_LENGTH; REGISTER_BIGNUM(arg1); - result = bignum_allocate_zeroed (BIGNUM_LENGTH (arg1) - digit_offset, + result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset, BIGNUM_NEGATIVE_P(arg1)); UNREGISTER_BIGNUM(arg1); @@ -1583,6 +1594,7 @@ bignum_magnitude_ash(bignum_type arg1, long n) return (bignum_trim (result)); } +/* allocates memory */ bignum_type bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2) { @@ -1598,7 +1610,7 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2) REGISTER_BIGNUM(arg1); REGISTER_BIGNUM(arg2); - result = bignum_allocate(max_length, 0); + result = allot_bignum(max_length, 0); UNREGISTER_BIGNUM(arg2); UNREGISTER_BIGNUM(arg1); @@ -1623,6 +1635,7 @@ bignum_pospos_bitwise_op(int op, bignum_type arg1, bignum_type arg2) return bignum_trim(result); } +/* allocates memory */ bignum_type bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) { @@ -1640,7 +1653,7 @@ bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) REGISTER_BIGNUM(arg1); REGISTER_BIGNUM(arg2); - result = bignum_allocate(max_length, neg_p); + result = allot_bignum(max_length, neg_p); UNREGISTER_BIGNUM(arg2); UNREGISTER_BIGNUM(arg1); @@ -1677,6 +1690,7 @@ bignum_posneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) return bignum_trim(result); } +/* allocates memory */ bignum_type bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) { @@ -1694,7 +1708,7 @@ bignum_negneg_bitwise_op(int op, bignum_type arg1, bignum_type arg2) UNREGISTER_BIGNUM(arg1); UNREGISTER_BIGNUM(arg2); - result = bignum_allocate(max_length, neg_p); + result = allot_bignum(max_length, neg_p); UNREGISTER_BIGNUM(arg2); UNREGISTER_BIGNUM(arg1); diff --git a/vm/bignum.h b/vm/bignum.h index 5048ff75ab..4e9009eb43 100644 --- a/vm/bignum.h +++ b/vm/bignum.h @@ -118,8 +118,8 @@ bignum_digit_type bignum_destructive_scale_down bignum_type bignum_remainder_unsigned_small_denominator (bignum_type, bignum_digit_type, int); bignum_type bignum_digit_to_bignum(bignum_digit_type, int); -bignum_type bignum_allocate(bignum_length_type, int); -bignum_type bignum_allocate_zeroed(bignum_length_type, int); +bignum_type allot_bignum(bignum_length_type, int); +bignum_type allot_bignum_zeroed(bignum_length_type, int); bignum_type bignum_shorten_length(bignum_type, bignum_length_type); bignum_type bignum_trim(bignum_type); bignum_type bignum_new_sign(bignum_type, int); diff --git a/vm/bignumint.h b/vm/bignumint.h index a8e2a5a999..51c8956034 100644 --- a/vm/bignumint.h +++ b/vm/bignumint.h @@ -45,20 +45,9 @@ MIT in each case. */ typedef F_FIXNUM bignum_digit_type; typedef F_FIXNUM bignum_length_type; -/* BIGNUM_ALLOCATE allocates a (length + 1)-element array of - `bignum_digit_type'; deallocation is the responsibility of the - user (in Factor, the garbage collector handles this). */ -#define BIGNUM_ALLOCATE(length_in_digits) \ - allot_array_internal(BIGNUM_TYPE,length_in_digits + 1) - /* BIGNUM_TO_POINTER casts a bignum object to a digit array pointer. */ #define BIGNUM_TO_POINTER(bignum) ((CELL*)AREF(bignum,0)) -/* BIGNUM_REDUCE_LENGTH allows the memory system to reclaim some - space when a bignum's length is reduced from its original value. */ -#define BIGNUM_REDUCE_LENGTH(source, length) \ - source = reallot_array(source,length + 1,69) - /* BIGNUM_EXCEPTION is invoked to handle assertion violations. */ #define BIGNUM_EXCEPTION abort diff --git a/vm/code_gc.c b/vm/code_gc.c index a18e2329c8..8dae12ffde 100644 --- a/vm/code_gc.c +++ b/vm/code_gc.c @@ -5,7 +5,7 @@ will be used for the data heap too, if we ever get incremental mark/sweep/compact GC. */ void new_heap(F_HEAP *heap, CELL size) { - heap->base = (CELL)(alloc_bounded_block(size)->start); + heap->base = (CELL)(alloc_segment(size)->start); if(heap->base == 0) fatal_error("Cannot allocate code heap",size); heap->limit = heap->base + size; diff --git a/vm/compiler.c b/vm/compiler.c index 84044d576d..2a35631054 100644 --- a/vm/compiler.c +++ b/vm/compiler.c @@ -19,7 +19,7 @@ CELL get_rel_symbol(F_REL *rel, CELL literal_start) { CELL arg = REL_ARGUMENT(rel); F_ARRAY *pair = untag_array(get_literal(literal_start,arg)); - F_STRING *symbol = untag_string(get(AREF(pair,0))); + char *symbol = alien_offset(get(AREF(pair,0))); CELL library = get(AREF(pair,1)); F_DLL *dll = (library == F ? NULL : untag_dll(library)); @@ -150,12 +150,8 @@ void finalize_code_block(F_COMPILED *relocating, CELL code_start, /* Write a sequence of integers to memory, with 'format' bytes per integer */ void deposit_integers(CELL here, F_VECTOR *vector, CELL format) { - if(vector->header != tag_header(VECTOR_TYPE)) - critical_error("FUCKUP 2",0); CELL count = untag_fixnum_fast(vector->top); F_ARRAY *array = untag_array_fast(vector->array); - if(array->header != tag_header(ARRAY_TYPE)) - critical_error("FUCKUP 3",0); CELL i; for(i = 0; i < count; i++) @@ -222,9 +218,6 @@ void primitive_add_compiled_block(void) GC above in which case the data heap semi-spaces will have switched */ FROB - if(code->header != tag_header(VECTOR_TYPE)) - critical_error("FUCKUP",0); - /* now we can pop the parameters from the stack */ ds -= CELLS * 5; @@ -268,6 +261,7 @@ void primitive_add_compiled_block(void) executable */ void primitive_finalize_compile(void) { + gc_off = true; F_ARRAY *array = untag_array(dpop()); /* set word XT's */ @@ -288,4 +282,5 @@ void primitive_finalize_compile(void) CELL xt = to_cell(get(AREF(pair,1))); iterate_code_heap_step(xt_to_compiled(xt),finalize_code_block); } + gc_off = false; } diff --git a/vm/data_gc.c b/vm/data_gc.c index 01d3e410e6..10dbcb27b9 100644 --- a/vm/data_gc.c +++ b/vm/data_gc.c @@ -243,7 +243,7 @@ void init_data_heap(CELL gens, gen_count = gens; generations = safe_malloc(sizeof(F_ZONE) * gen_count); - data_heap_start = (CELL)(alloc_bounded_block(total_size)->start); + data_heap_start = (CELL)(alloc_segment(total_size)->start); data_heap_end = data_heap_start + total_size; cards = safe_malloc(cards_size); @@ -271,8 +271,8 @@ void init_data_heap(CELL gens, data_heap_end = data_heap_start + total_size; - extra_roots_region = alloc_bounded_block(getpagesize()); - extra_roots = (CELL *)extra_roots_region->start; + extra_roots_region = alloc_segment(getpagesize()); + extra_roots = extra_roots_region->start - CELLS; } void collect_callframe_triple(CELL *callframe, @@ -286,7 +286,7 @@ void collect_callframe_triple(CELL *callframe, } /* Copy all tagged pointers in a range of memory */ -void collect_stack(F_BOUNDED_BLOCK *region, CELL top) +void collect_stack(F_SEGMENT *region, CELL top) { CELL bottom = region->start; CELL ptr; @@ -296,7 +296,7 @@ void collect_stack(F_BOUNDED_BLOCK *region, CELL top) } /* The callstack has a special format */ -void collect_callstack(F_BOUNDED_BLOCK *region, CELL top) +void collect_callstack(F_SEGMENT *region, CELL top) { CELL bottom = region->start; CELL ptr; @@ -319,7 +319,7 @@ void collect_roots(void) copy_handle(&bignum_neg_one); collect_callframe_triple(&callframe,&callframe_scan,&callframe_end); - collect_stack(extra_roots_region,(CELL)(extra_roots - 1)); + collect_stack(extra_roots_region,extra_roots); save_stacks(); stacks = stack_chain; diff --git a/vm/data_gc.h b/vm/data_gc.h index 7159a6fdda..e97a38ccf1 100644 --- a/vm/data_gc.h +++ b/vm/data_gc.h @@ -8,12 +8,12 @@ void *safe_malloc(size_t size); typedef struct { CELL start; CELL size; -} F_BOUNDED_BLOCK; +} F_SEGMENT; /* set up guard pages to check for under/overflow. size must be a multiple of the page size */ -F_BOUNDED_BLOCK *alloc_bounded_block(CELL size); -void dealloc_bounded_block(F_BOUNDED_BLOCK *block); +F_SEGMENT *alloc_segment(CELL size); +void dealloc_segment(F_SEGMENT *block); CELL untagged_object_size(CELL pointer); CELL unaligned_object_size(CELL pointer); @@ -194,33 +194,25 @@ void garbage_collection(CELL gen, bool code_gc); /* If a runtime function needs to call another function which potentially allocates memory, it must store any local variable references to Factor objects on the root stack */ -F_BOUNDED_BLOCK *extra_roots_region; -CELL *extra_roots; +F_SEGMENT *extra_roots_region; +CELL extra_roots; -INLINE void push_root(CELL tagged) -{ - *(extra_roots++) = tagged; -} +DEFPUSHPOP(root_,extra_roots) -INLINE CELL pop_root(void) -{ - return *(--extra_roots); -} +#define REGISTER_ROOT(obj) root_push(obj) +#define UNREGISTER_ROOT(obj) obj = root_pop() -#define REGISTER_ROOT(obj) push_root(obj) -#define UNREGISTER_ROOT(obj) obj = pop_root() +#define REGISTER_ARRAY(obj) root_push(tag_object(obj)) +#define UNREGISTER_ARRAY(obj) obj = untag_array_fast(root_pop()) -#define REGISTER_ARRAY(obj) push_root(tag_object(obj)) -#define UNREGISTER_ARRAY(obj) obj = untag_array_fast(pop_root()) +#define REGISTER_STRING(obj) root_push(tag_object(obj)) +#define UNREGISTER_STRING(obj) obj = untag_string_fast(root_pop()) -#define REGISTER_STRING(obj) push_root(tag_object(obj)) -#define UNREGISTER_STRING(obj) obj = untag_string_fast(pop_root()) +#define REGISTER_C_STRING(obj) root_push(tag_object(((F_ARRAY *)obj) - 1)) +#define UNREGISTER_C_STRING(obj) obj = ((char*)(untag_array_fast(root_pop()) + 1)) -#define REGISTER_C_STRING(obj) push_root(tag_object(((F_ARRAY *)obj) - 1)) -#define UNREGISTER_C_STRING(obj) obj = ((char*)(untag_array_fast(pop_root()) + 1)) - -#define REGISTER_BIGNUM(obj) push_root(tag_bignum(obj)) -#define UNREGISTER_BIGNUM(obj) obj = (untag_bignum_fast(pop_root())) +#define REGISTER_BIGNUM(obj) root_push(tag_bignum(obj)) +#define UNREGISTER_BIGNUM(obj) obj = (untag_bignum_fast(root_pop())) INLINE void *allot_zone(F_ZONE *z, CELL a) { diff --git a/vm/io.c b/vm/io.c index 8f2e15d07d..ddf8104a83 100644 --- a/vm/io.c +++ b/vm/io.c @@ -33,12 +33,12 @@ void primitive_fopen(void) FILE *file = fopen(path,mode); if(file == NULL) io_error(); - box_alien((CELL)file); + box_alien(file); } void primitive_fgetc(void) { - FILE* file = (FILE*)unbox_alien(); + FILE* file = unbox_alien(); int c = fgetc(file); if(c == EOF) dpush(F); @@ -48,7 +48,7 @@ void primitive_fgetc(void) void primitive_fwrite(void) { - FILE* file = (FILE*)unbox_alien(); + FILE* file = unbox_alien(); F_STRING* text = untag_string(dpop()); F_FIXNUM length = untag_fixnum_fast(text->length); @@ -61,10 +61,10 @@ void primitive_fwrite(void) void primitive_fflush(void) { - fflush((FILE*)unbox_alien()); + fflush(unbox_alien()); } void primitive_fclose(void) { - fclose((FILE*)unbox_alien()); + fclose(unbox_alien()); } diff --git a/vm/layouts.h b/vm/layouts.h index 7b8496bbcf..28fa5a7c82 100644 --- a/vm/layouts.h +++ b/vm/layouts.h @@ -169,7 +169,7 @@ typedef struct { typedef struct { CELL header; - /* tagged string */ + /* tagged byte array holding a C string */ CELL path; /* OS-specific handle */ void* dll; diff --git a/vm/os-unix.c b/vm/os-unix.c index d9e9a6efd9..5f15c897d3 100644 --- a/vm/os-unix.c +++ b/vm/os-unix.c @@ -16,7 +16,7 @@ void init_ffi(void) void ffi_dlopen(F_DLL *dll, bool error) { - void *dllptr = dlopen(to_char_string(untag_string(dll->path),true), RTLD_LAZY); + void *dllptr = dlopen(alien_offset(dll->path), RTLD_LAZY); if(dllptr == NULL) { @@ -34,10 +34,10 @@ void ffi_dlopen(F_DLL *dll, bool error) dll->dll = dllptr; } -void *ffi_dlsym(F_DLL *dll, F_STRING *symbol, bool error) +void *ffi_dlsym(F_DLL *dll, char *symbol, bool error) { void *handle = (dll == NULL ? null_dll : dll->dll); - void *sym = dlsym(handle,to_char_string(symbol,true)); + void *sym = dlsym(handle,symbol); if(sym == NULL) { if(error) @@ -128,7 +128,7 @@ void primitive_cd(void) chdir(unbox_char_string()); } -F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) +F_SEGMENT *alloc_segment(CELL size) { int pagesize = getpagesize(); @@ -145,7 +145,7 @@ F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1) fatal_error("Cannot protect high guard page",(CELL)array); - F_BOUNDED_BLOCK *retval = safe_malloc(sizeof(F_BOUNDED_BLOCK)); + F_SEGMENT *retval = safe_malloc(sizeof(F_SEGMENT)); retval->start = (CELL)(array + pagesize); retval->size = size; @@ -153,7 +153,7 @@ F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) return retval; } -void dealloc_bounded_block(F_BOUNDED_BLOCK *block) +void dealloc_segment(F_SEGMENT *block) { int pagesize = getpagesize(); diff --git a/vm/os-unix.h b/vm/os-unix.h index 24e7b2c4f8..1196e1de59 100644 --- a/vm/os-unix.h +++ b/vm/os-unix.h @@ -13,7 +13,7 @@ void init_ffi(void); void ffi_dlopen(F_DLL *dll, bool error); -void *ffi_dlsym(F_DLL *dll, F_STRING *symbol, bool error); +void *ffi_dlsym(F_DLL *dll, char *symbol, bool error); void ffi_dlclose(F_DLL *dll); void unix_init_signals(void); diff --git a/vm/os-windows.c b/vm/os-windows.c index 45fa3c0e82..2120baca18 100644 --- a/vm/os-windows.c +++ b/vm/os-windows.c @@ -49,10 +49,7 @@ s64 current_millis(void) void ffi_dlopen (DLL *dll, bool error) { - HMODULE module; - char *path = to_char_string(untag_string(dll->path),true); - - module = LoadLibrary(path); + HMODULE module = LoadLibrary(alien_offset(dll->path)); if (!module) { @@ -66,10 +63,11 @@ void ffi_dlopen (DLL *dll, bool error) dll->dll = module; } -void *ffi_dlsym (DLL *dll, F_STRING *symbol, bool error) +void *ffi_dlsym (DLL *dll, char *symbol, bool error) { - void *sym = GetProcAddress(dll ? (HMODULE)dll->dll : GetModuleHandle(NULL), - to_char_string(symbol,true)); + void *sym = GetProcAddress( + dll ? (HMODULE)dll->dll : GetModuleHandle(NULL), + symbol); if (!sym) { @@ -167,7 +165,7 @@ void primitive_cd(void) SetCurrentDirectory(unbox_char_string()); } -F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) +F_SEGMENT *alloc_segment(CELL size) { SYSTEM_INFO si; char *mem; @@ -175,7 +173,7 @@ F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) GetSystemInfo(&si); if((mem = (char *)VirtualAlloc(NULL, si.dwPageSize*2 + size, MEM_COMMIT, PAGE_EXECUTE_READWRITE)) == 0) - fatal_error("VirtualAlloc() failed in alloc_bounded_block()",0); + fatal_error("VirtualAlloc() failed in alloc_segment()",0); if (!VirtualProtect(mem, si.dwPageSize, PAGE_NOACCESS, &ignore)) fatal_error("Cannot allocate low guard page", (CELL)mem); @@ -183,7 +181,7 @@ F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) if (!VirtualProtect(mem+size+si.dwPageSize, si.dwPageSize, PAGE_NOACCESS, &ignore)) fatal_error("Cannot allocate high guard page", (CELL)mem); - F_BOUNDED_BLOCK *block = safe_malloc(sizeof(F_BOUNDED_BLOCK)); + F_SEGMENT *block = safe_malloc(sizeof(F_SEGMENT)); block->start = (int)mem + si.dwPageSize; block->size = size; @@ -191,7 +189,7 @@ F_BOUNDED_BLOCK *alloc_bounded_block(CELL size) return block; } -void dealloc_bounded_block(F_BOUNDED_BLOCK *block) +void dealloc_segment(F_SEGMENT *block) { SYSTEM_INFO si; GetSystemInfo(&si); diff --git a/vm/os-windows.h b/vm/os-windows.h index 8a30e1e091..d5a36ceabb 100644 --- a/vm/os-windows.h +++ b/vm/os-windows.h @@ -17,7 +17,7 @@ DLLEXPORT char *error_message(DWORD id); INLINE void init_ffi(void) {} void ffi_dlopen(F_DLL *dll, bool error); -void *ffi_dlsym(F_DLL *dll, F_STRING *symbol, bool error); +void *ffi_dlsym(F_DLL *dll, char *symbol, bool error); void ffi_dlclose(F_DLL *dll); void primitive_open_file(void); diff --git a/vm/run.c b/vm/run.c index c6eaff1683..33f2b992d3 100644 --- a/vm/run.c +++ b/vm/run.c @@ -39,6 +39,8 @@ void handle_error(void) { if(throwing) { + extra_roots = stack_chain->extra_roots; + if(thrown_keep_stacks) { ds = thrown_ds; diff --git a/vm/run.h b/vm/run.h index 605c670f4e..250f9aead3 100644 --- a/vm/run.h +++ b/vm/run.h @@ -95,6 +95,31 @@ INLINE CELL type_of(CELL tagged) return object_type(tagged); } +#define DEFPUSHPOP(prefix,ptr) \ + INLINE CELL prefix##pop(void) \ + { \ + CELL value = get(ptr); \ + ptr -= CELLS; \ + return value; \ + } \ + INLINE void prefix##push(CELL tagged) \ + { \ + ptr += CELLS; \ + put(ptr,tagged); \ + } \ + INLINE void prefix##repl(CELL tagged) \ + { \ + put(ptr,tagged); \ + } \ + INLINE CELL prefix##peek() \ + { \ + return get(ptr); \ + } + +DEFPUSHPOP(d,ds) +DEFPUSHPOP(r,rs) +DEFPUSHPOP(c,cs) + void call(CELL quot); void handle_error(); diff --git a/vm/stack.c b/vm/stack.c index 08b622c255..62160dd227 100644 --- a/vm/stack.c +++ b/vm/stack.c @@ -65,9 +65,11 @@ void nest_stacks(void) new_stacks->callframe_end = callframe_end; new_stacks->catch_save = userenv[CATCHSTACK_ENV]; - new_stacks->data_region = alloc_bounded_block(ds_size); - new_stacks->retain_region = alloc_bounded_block(rs_size); - new_stacks->call_region = alloc_bounded_block(cs_size); + new_stacks->data_region = alloc_segment(ds_size); + new_stacks->retain_region = alloc_segment(rs_size); + new_stacks->call_region = alloc_segment(cs_size); + + new_stacks->extra_roots = extra_roots; new_stacks->next = stack_chain; stack_chain = new_stacks; @@ -83,24 +85,24 @@ void nest_stacks(void) /* called when leaving a compiled callback */ void unnest_stacks(void) { + dealloc_segment(stack_chain->data_region); + dealloc_segment(stack_chain->retain_region); + dealloc_segment(stack_chain->call_region); + + ds = stack_chain->data_save; + rs = stack_chain->retain_save; + cs = stack_chain->call_save; + cards_offset = stack_chain->cards_offset; + + callframe = stack_chain->callframe; + callframe_scan = stack_chain->callframe_scan; + callframe_end = stack_chain->callframe_end; + userenv[CATCHSTACK_ENV] = stack_chain->catch_save; + + extra_roots = stack_chain->extra_roots; + F_STACKS *old_stacks = stack_chain; - - dealloc_bounded_block(stack_chain->data_region); - dealloc_bounded_block(stack_chain->retain_region); - dealloc_bounded_block(stack_chain->call_region); - - ds = old_stacks->data_save; - rs = old_stacks->retain_save; - cs = old_stacks->call_save; - cards_offset = old_stacks->cards_offset; - - callframe = old_stacks->callframe; - callframe_scan = old_stacks->callframe_scan; - callframe_end = old_stacks->callframe_end; - userenv[CATCHSTACK_ENV] = old_stacks->catch_save; - stack_chain = old_stacks->next; - free(old_stacks); } diff --git a/vm/stack.h b/vm/stack.h index 111bd792a6..2ad3257cc4 100644 --- a/vm/stack.h +++ b/vm/stack.h @@ -1,79 +1,39 @@ -INLINE CELL dpop(void) -{ - CELL value = get(ds); - ds -= CELLS; - return value; -} - -INLINE void drepl(CELL top) -{ - put(ds,top); -} - -INLINE void dpush(CELL top) -{ - ds += CELLS; - put(ds,top); -} - -INLINE CELL dpeek(void) -{ - return get(ds); -} - -INLINE CELL cpop(void) -{ - CELL value = get(cs); - cs -= CELLS; - return value; -} - -INLINE void cpush(CELL top) -{ - cs += CELLS; - put(cs,top); -} - -INLINE CELL rpop(void) -{ - CELL value = get(rs); - rs -= CELLS; - return value; -} - -INLINE void rpush(CELL top) -{ - rs += CELLS; - put(rs,top); -} - typedef struct _F_STACKS { /* current datastack top pointer */ CELL data; /* saved contents of ds register on entry to callback */ CELL data_save; /* memory region holding current datastack */ - F_BOUNDED_BLOCK *data_region; + F_SEGMENT *data_region; + /* current retain stack top pointer */ CELL retain; /* saved contents of rs register on entry to callback */ CELL retain_save; /* memory region holding current retain stack */ - F_BOUNDED_BLOCK *retain_region; + F_SEGMENT *retain_region; + /* current callstack top pointer */ CELL call; /* saved contents of cs register on entry to callback */ CELL call_save; /* memory region holding current callstack */ - F_BOUNDED_BLOCK *call_region; + F_SEGMENT *call_region; + /* saved callframe on entry to callback */ CELL callframe; CELL callframe_scan; CELL callframe_end; + /* saved catchstack on entry to callback */ CELL catch_save; + /* saved cards_offset register on entry to callback */ CELL cards_offset; + + /* saved extra_roots pointer on entry to callback */ + CELL extra_roots; + /* error handler longjmp buffer */ JMP_BUF toplevel; diff --git a/vm/types.h b/vm/types.h index 81598f63c1..65ef0b9b23 100644 --- a/vm/types.h +++ b/vm/types.h @@ -17,11 +17,6 @@ INLINE F_ARRAY* untag_array(CELL tagged) return untag_array_fast(tagged); } -INLINE F_ARRAY* untag_byte_array_fast(CELL tagged) -{ - return (F_ARRAY*)UNTAG(tagged); -} - INLINE CELL array_size(CELL size) { return sizeof(F_ARRAY) + size * CELLS;