steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

More allot_* cleanups

slava 2006-11-02 23:29:11 +00:00
parent 372872e41d
commit 56f8f84751
26 changed files with 285 additions and 314 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
TODO.FACTOR.txt
View File

@ -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:

4
library/compiler/generator/xt.factor
View File

@ -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 ;

4
library/compiler/test/alien.factor
View File

@ -78,11 +78,11 @@ cpu "x86" = macosx? and [
: indirect-test-1
"int" { } "cdecl" alien-indirect ;
[ 3 ] [ "ffi_test_1" f dlsym <alien> 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 <alien> indirect-test-2 ]
[ 2 3 "ffi_test_2" f dlsym indirect-test-2 ]
unit-test

8
library/test/kernel.factor
View File

@ -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

4
library/test/math/integer.factor
View File

@ -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

6
library/test/random.factor
View File

@ -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 ;

18
vm/alien.c
View File

@ -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 */

2
vm/alien.h
View File

@ -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);

284
vm/bignum.c
View File

@ -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);

4
vm/bignum.h
View File

@ -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);

11
vm/bignumint.h
View File

@ -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

2
vm/code_gc.c
View File

@ -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;

11
vm/compiler.c
View File

@ -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;
}

12
vm/data_gc.c
View File

@ -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;

40
vm/data_gc.h
View File

@ -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)
{

10
vm/io.c
View File

@ -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());
}

2
vm/layouts.h
View File

@ -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;

12
vm/os-unix.c
View File

@ -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();

2
vm/os-unix.h
View File

@ -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);

20
vm/os-windows.c
View File

@ -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);

2
vm/os-windows.h
View File

@ -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);

2
vm/run.c
View File

@ -39,6 +39,8 @@ void handle_error(void)
{
if(throwing)
{
extra_roots = stack_chain->extra_roots;
if(thrown_keep_stacks)
{
ds = thrown_ds;

25
vm/run.h
View File

@ -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();

40
vm/stack.c
View File

@ -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);
}

64
vm/stack.h
View File

@ -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;

5
vm/types.h
View File

@ -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;