diff --git a/runtime/Include/bigloo.h b/runtime/Include/bigloo.h index 4f73428c..c8851f21 100644 --- a/runtime/Include/bigloo.h +++ b/runtime/Include/bigloo.h @@ -3,7 +3,7 @@ /* ------------------------------------------------------------- */ /* Author : Manuel Serrano */ /* Creation : Thu Mar 16 18:48:21 1995 */ -/* Last change : Fri Nov 8 07:31:16 2024 (serrano) */ +/* Last change : Sat Nov 9 09:22:32 2024 (serrano) */ /* ------------------------------------------------------------- */ /* Bigloo's stuff */ /*=====================================================================*/ @@ -1502,9 +1502,14 @@ BGL_RUNTIME_DECL obj_t bgl_init_fx_procedure(obj_t, function_t, int, int); #define BGL_PROCEDURE_BYTE_SIZE(size) \ (PROCEDURE_SIZE + ((size-1) * OBJ_SIZE)) - -#define BGL_ALLOC_STACK_FX_PROCEDURE(size) \ - char[ PROCEDURE_SIZE + ((size-1) * OBJ_SIZE) ] + +#if !BGL_NAN_TAGGING +# define BGL_ALLOC_STACK_FX_PROCEDURE(size) \ + char[ PROCEDURE_SIZE + ((size-1) * OBJ_SIZE) ] +#else +# define BGL_ALLOC_STACK_FX_PROCEDURE(size) \ + GC_MALLOC(PROCEDURE_SIZE + ((size-1) * OBJ_SIZE)) +#endif /*---------------------------------------------------------------------*/ /* Light procedures */ diff --git a/runtime/Include/bigloo_cell.h b/runtime/Include/bigloo_cell.h index a3ce249f..4ed7e675 100644 --- a/runtime/Include/bigloo_cell.h +++ b/runtime/Include/bigloo_cell.h @@ -3,7 +3,7 @@ /* ------------------------------------------------------------- */ /* Author : Manuel Serrano */ /* Creation : Sat Mar 5 08:05:01 2016 */ -/* Last change : Fri Nov 8 07:37:38 2024 (serrano) */ +/* Last change : Sat Nov 9 09:19:39 2024 (serrano) */ /* Copyright : 2016-24 Manuel Serrano */ /* ------------------------------------------------------------- */ /* Bigloo CELLs */ @@ -48,7 +48,7 @@ struct bgl_unsafe_cell { #define BGL_UNSAFE_CELL_SET(_c, _v) BASSIGN(BGL_UNSAFE_CELL_REF(_c), _v, _c) /* stack allocation */ -#if (BGL_HAVE_ALLOCA && defined(__GNUC__)) +#if (BGL_HAVE_ALLOCA && !BGL_NAN_TAGGING && defined(__GNUC__)) # define BGL_MAKE_STACK_UNSAFE_CELL(v) \ ({ obj_t an_object; \ an_object = alloca(UNSAFE_CELL_SIZE); \ diff --git a/runtime/Include/bigloo_pair.h b/runtime/Include/bigloo_pair.h index b19d1765..da1bee16 100644 --- a/runtime/Include/bigloo_pair.h +++ b/runtime/Include/bigloo_pair.h @@ -3,8 +3,8 @@ /* ------------------------------------------------------------- */ /* Author : Manuel Serrano */ /* Creation : Sat Mar 5 08:05:01 2016 */ -/* Last change : Sat Dec 7 18:56:17 2019 (serrano) */ -/* Copyright : 2016-21 Manuel Serrano */ +/* Last change : Sat Nov 9 09:19:54 2024 (serrano) */ +/* Copyright : 2016-24 Manuel Serrano */ /* ------------------------------------------------------------- */ /* Bigloo PAIRs */ /*=====================================================================*/ @@ -24,28 +24,28 @@ extern "C" { /*---------------------------------------------------------------------*/ /* extern */ /*---------------------------------------------------------------------*/ -BGL_RUNTIME_DECL obj_t make_pair( obj_t , obj_t ); -BGL_RUNTIME_DECL obj_t make_epair( obj_t , obj_t, obj_t ); +BGL_RUNTIME_DECL obj_t make_pair(obj_t , obj_t); +BGL_RUNTIME_DECL obj_t make_epair(obj_t , obj_t, obj_t); -BGL_RUNTIME_DECL obj_t bgl_reverse( obj_t ); -BGL_RUNTIME_DECL obj_t bgl_reverse_bang( obj_t ); +BGL_RUNTIME_DECL obj_t bgl_reverse(obj_t); +BGL_RUNTIME_DECL obj_t bgl_reverse_bang(obj_t); -BGL_RUNTIME_DECL long bgl_list_length( obj_t ); -BGL_RUNTIME_DECL obj_t bgl_remq( obj_t, obj_t ); -BGL_RUNTIME_DECL obj_t bgl_remq_bang( obj_t, obj_t ); - -#if( BGL_SAW == 1 ) -BGL_RUNTIME_DECL obj_t bgl_saw_make_pair( obj_t, obj_t ); -BGL_RUNTIME_DECL obj_t bgl_saw_make_old_pair( obj_t, obj_t ); -BGL_RUNTIME_DECL obj_t bgl_saw_make_epair( obj_t, obj_t , obj_t ); -BGL_RUNTIME_DECL obj_t bgl_saw_make_old_epair( obj_t, obj_t, obj_t ); +BGL_RUNTIME_DECL long bgl_list_length(obj_t); +BGL_RUNTIME_DECL obj_t bgl_remq(obj_t, obj_t); +BGL_RUNTIME_DECL obj_t bgl_remq_bang(obj_t, obj_t); + +#if (BGL_SAW == 1) +BGL_RUNTIME_DECL obj_t bgl_saw_make_pair(obj_t, obj_t); +BGL_RUNTIME_DECL obj_t bgl_saw_make_old_pair(obj_t, obj_t); +BGL_RUNTIME_DECL obj_t bgl_saw_make_epair(obj_t, obj_t , obj_t); +BGL_RUNTIME_DECL obj_t bgl_saw_make_old_epair(obj_t, obj_t, obj_t); #endif /*---------------------------------------------------------------------*/ /* bgl_pair ... */ /*---------------------------------------------------------------------*/ struct bgl_pair { -#if( !TAG_PAIR ) +#if (!TAG_PAIR) /* the header, unless pairs are tagged */ header_t header; #endif @@ -54,140 +54,140 @@ struct bgl_pair { }; struct bgl_epair { -#if( !TAG_PAIR ) +#if (!TAG_PAIR) header_t header; #endif obj_t car; obj_t cdr; /* extended header type */ -#if( (BGL_GC == BGL_BOEHM_GC) && TAG_PAIR ) +#if ((BGL_GC == BGL_BOEHM_GC) && TAG_PAIR) obj_t eheader; #endif /* extended slot */ obj_t cer; }; -#define PAIR_SIZE (sizeof( struct bgl_pair )) -#define EPAIR_SIZE (sizeof( struct bgl_epair )) +#define PAIR_SIZE (sizeof(struct bgl_pair)) +#define EPAIR_SIZE (sizeof(struct bgl_epair)) -#define PAIR( o ) (CPAIR( o )->pair) -#define EPAIR( o ) (CPAIR( o )->epair) +#define PAIR(o) (CPAIR(o)->pair) +#define EPAIR(o) (CPAIR(o)->epair) /*---------------------------------------------------------------------*/ /* tagging ... */ /*---------------------------------------------------------------------*/ -#if( defined( TAG_PAIR ) ) -# define BPAIR( p ) BGL_BPTR( (long)p + TAG_PAIR ) -# define CPAIR( p ) ((union scmobj *)(((long)BGL_CPTR( p )) - TAG_PAIR)) -# if( TAG_PAIR != 0 ) -# define PAIRP( c ) ((((long)c) & TAG_MASK) == TAG_PAIR) +#if (defined(TAG_PAIR)) +# define BPAIR(p) BGL_BPTR((long)p + TAG_PAIR) +# define CPAIR(p) ((union scmobj *)(((long)BGL_CPTR(p)) - TAG_PAIR)) +# if (TAG_PAIR != 0) +# define PAIRP(c) ((((long)c) & TAG_MASK) == TAG_PAIR) # else -# define PAIRP( c ) ((c && ((((long)c) & TAG_MASK) == TAG_PAIR))) +# define PAIRP(c) ((c && ((((long)c) & TAG_MASK) == TAG_PAIR))) # endif #else -# define BPAIR( p ) BREF( p ) -# define CPAIR( p ) CREF( p ) -# define PAIRP( c ) (POINTERP( c ) && (TYPE( c ) == PAIR_TYPE)) +# define BPAIR(p) BREF(p) +# define CPAIR(p) CREF(p) +# define PAIRP(c) (POINTERP(c) && (TYPE(c) == PAIR_TYPE)) #endif -#if( BGL_GC == BGL_BOEHM_GC && TAG_PAIR ) -# define EPAIRP( c ) \ - (PAIRP( c ) && \ - (((long)GC_size( CPAIR( c ) )) >= EPAIR_SIZE) && \ - (EPAIR( c ).eheader == BINT( EPAIR_TYPE ))) +#if (BGL_GC == BGL_BOEHM_GC && TAG_PAIR) +# define EPAIRP(c) \ + (PAIRP(c) && \ + (((long)GC_size(CPAIR(c))) >= EPAIR_SIZE) && \ + (EPAIR(c).eheader == BINT(EPAIR_TYPE))) #else -# define EPAIRP( c ) \ - (PAIRP( c ) && (HEADER_SIZE( CREF( c )->header) == EPAIR_SIZE)) +# define EPAIRP(c) \ + (PAIRP(c) && (HEADER_SIZE(CREF(c )->header) == EPAIR_SIZE)) #endif /*---------------------------------------------------------------------*/ /* alloc ... */ /*---------------------------------------------------------------------*/ -#if( !TAG_PAIR ) -# define IFN_PAIR_TAG( expr ) expr +#if (!TAG_PAIR) +# define IFN_PAIR_TAG(expr) expr #else -# define IFN_PAIR_TAG( expr ) 0 +# define IFN_PAIR_TAG(expr) 0 #endif -#if( TAG_PAIR && ( BGL_GC == BGL_BOEHM_GC) ) -# define IF_EPAIR_TAG( expr ) expr +#if (TAG_PAIR && (BGL_GC == BGL_BOEHM_GC)) +# define IF_EPAIR_TAG(expr) expr #else -# define IF_EPAIR_TAG( expr ) +# define IF_EPAIR_TAG(expr) #endif -#define BGL_INIT_PAIR( an_object, a, d ) \ - (IFN_PAIR_TAG( BGL_CPTR( an_object )->pair.header = \ - MAKE_HEADER( PAIR_TYPE, PAIR_SIZE ) ), \ - BGL_CPTR( an_object )->pair.car = a, \ - BGL_CPTR( an_object )->pair.cdr = d) +#define BGL_INIT_PAIR(an_object, a, d) \ + (IFN_PAIR_TAG(BGL_CPTR(an_object)->pair.header = \ + MAKE_HEADER(PAIR_TYPE, PAIR_SIZE)), \ + BGL_CPTR(an_object)->pair.car = a, \ + BGL_CPTR(an_object)->pair.cdr = d) -#define BGL_INIT_EPAIR( an_object, a, d, e ) \ - (IFN_PAIR_TAG( BGL_CPTR( an_object )->pair.header = \ - MAKE_HEADER( PAIR_TYPE, EPAIR_SIZE ) ), \ - BGL_CPTR( an_object )->pair.car = a, \ - BGL_CPTR( an_object )->pair.cdr = d, \ - BGL_CPTR( an_object )->epair.cer = e, \ - IF_EPAIR_TAG( BGL_CPTR( an_object )->epair.eheader = BINT( EPAIR_TYPE ) )) +#define BGL_INIT_EPAIR(an_object, a, d, e) \ + (IFN_PAIR_TAG(BGL_CPTR(an_object)->pair.header = \ + MAKE_HEADER(PAIR_TYPE, EPAIR_SIZE)), \ + BGL_CPTR(an_object)->pair.car = a, \ + BGL_CPTR(an_object)->pair.cdr = d, \ + BGL_CPTR(an_object)->epair.cer = e, \ + IF_EPAIR_TAG(BGL_CPTR(an_object)->epair.eheader = BINT(EPAIR_TYPE))) /* boehm allocation */ -#if( BGL_GC == BGL_BOEHM_GC ) -# if( BGL_GC_CUSTOM || !defined( __GNUC__ ) ) -# define MAKE_PAIR( a, d ) make_pair( a, d ) -# define MAKE_EPAIR( a, d, e ) make_epair( a, d, e ) +#if (BGL_GC == BGL_BOEHM_GC) +# if (BGL_GC_CUSTOM || !defined(__GNUC__)) +# define MAKE_PAIR(a, d) make_pair(a, d) +# define MAKE_EPAIR(a, d, e) make_epair(a, d, e) # else -# define MAKE_PAIR( a, d ) \ - ({ obj_t an_object = GC_MALLOC( PAIR_SIZE ); \ - BGL_INIT_PAIR( an_object, a, d ); \ - BPAIR( an_object ); }) -# define MAKE_EPAIR( a, d, e ) \ - ({ obj_t an_object = GC_MALLOC( EPAIR_SIZE ); \ - BGL_INIT_EPAIR( an_object, a, d, e ); \ - BPAIR( an_object ); }) +# define MAKE_PAIR(a, d) \ + ({ obj_t an_object = GC_MALLOC(PAIR_SIZE); \ + BGL_INIT_PAIR(an_object, a, d); \ + BPAIR(an_object); }) +# define MAKE_EPAIR(a, d, e) \ + ({ obj_t an_object = GC_MALLOC(EPAIR_SIZE); \ + BGL_INIT_EPAIR(an_object, a, d, e); \ + BPAIR(an_object); }) # endif -# define MAKE_YOUNG_PAIR( a, d ) MAKE_PAIR( a, d ) -# define MAKE_YOUNG_EPAIR( a, d, e ) MAKE_EPAIR( a, d, e ) +# define MAKE_YOUNG_PAIR(a, d) MAKE_PAIR(a, d) +# define MAKE_YOUNG_EPAIR(a, d, e) MAKE_EPAIR(a, d, e) #endif /* saw allocation */ -#if( BGL_GC == BGL_SAW_GC ) -# define MAKE_YOUNG_PAIR( a, d ) bgl_saw_make_pair( a, d ) -# define MAKE_YOUNG_EPAIR( a, d, e ) bgl_saw_make_epair( a, d, e ) -# define MAKE_PAIR( a, d ) bgl_saw_make_old_pair( a, d ) -# define MAKE_EPAIR( a, d, e ) bgl_saw_make_old_epair( a, d, e ) +#if (BGL_GC == BGL_SAW_GC) +# define MAKE_YOUNG_PAIR(a, d) bgl_saw_make_pair(a, d) +# define MAKE_YOUNG_EPAIR(a, d, e) bgl_saw_make_epair(a, d, e) +# define MAKE_PAIR(a, d) bgl_saw_make_old_pair(a, d) +# define MAKE_EPAIR(a, d, e) bgl_saw_make_old_epair(a, d, e) #endif /* stack allocation (see BGL_EXITD_PUSH_PROTECT) */ -#if( BGL_HAVE_ALLOCA ) -# define MAKE_STACK_PAIR_TMP( a, d, __t ) \ - (__t = alloca( PAIR_SIZE ), BGL_INIT_PAIR( __t, a, d ), BPAIR( __t )) -# if( BGL_HAVE_ALLOCA && defined( __GNUC__ ) ) -# define MAKE_STACK_PAIR( a, d ) \ - ({ obj_t an_object; MAKE_STACK_PAIR_TMP( a, d, an_object); }) +#if (BGL_HAVE_ALLOCA && !BGL_NAN_TAGGING) +# define MAKE_STACK_PAIR_TMP(a, d, __t) \ + (__t = alloca(PAIR_SIZE), BGL_INIT_PAIR(__t, a, d), BPAIR(__t)) +# if (BGL_HAVE_ALLOCA && defined(__GNUC__)) +# define MAKE_STACK_PAIR(a, d) \ + ({ obj_t an_object; MAKE_STACK_PAIR_TMP(a, d, an_object); }) # else -# define MAKE_STACK_PAIR( a, d ) MAKE_PAIR( a, d ) +# define MAKE_STACK_PAIR(a, d) MAKE_PAIR(a, d) # endif #else -# define MAKE_STACK_PAIR_TMP( a, d, __t ) __t = MAKE_PAIR( a, d ) -# define MAKE_STACK_PAIR( a, d ) MAKE_PAIR( a, d ) +# define MAKE_STACK_PAIR_TMP(a, d, __t) __t = MAKE_PAIR(a, d) +# define MAKE_STACK_PAIR(a, d) MAKE_PAIR(a, d) #endif /* pair stack allocation for -fstackable optimization */ -#define BGL_MAKE_PAIR_STACK( tmp, a, d ) \ - (BGL_INIT_PAIR( &tmp, a, d ), BPAIR( &tmp )) +#define BGL_MAKE_PAIR_STACK(tmp, a, d) \ + (BGL_INIT_PAIR(&tmp, a, d), BPAIR(&tmp)) /*---------------------------------------------------------------------*/ /* api */ /*---------------------------------------------------------------------*/ -#define NULLP( c ) ((long)(c) == (long)BNIL) +#define NULLP(c) ((long)(c) == (long)BNIL) -#define CAR( c ) (PAIR( c ).car) -#define CDR( c ) (PAIR( c ).cdr) -#define CER( c ) (EPAIR( c ).cer) +#define CAR(c) (PAIR(c).car) +#define CDR(c) (PAIR(c).cdr) +#define CER(c) (EPAIR(c).cer) -#define SET_CAR( c, v ) BASSIGN( CAR( c ), v, c ) -#define SET_CDR( c, v ) BASSIGN( CDR( c ), v, c ) -#define SET_CER( c, v ) BASSIGN( CER( c ), v, c ) +#define SET_CAR(c, v) BASSIGN(CAR(c), v, c) +#define SET_CDR(c, v) BASSIGN(CDR(c), v, c) +#define SET_CER(c, v) BASSIGN(CER(c), v, c) /*---------------------------------------------------------------------*/ /* C++ */ diff --git a/runtime/Include/bigloo_vector.h b/runtime/Include/bigloo_vector.h index 22265ec5..5b1e6965 100644 --- a/runtime/Include/bigloo_vector.h +++ b/runtime/Include/bigloo_vector.h @@ -3,7 +3,7 @@ /* ------------------------------------------------------------- */ /* Author : Manuel Serrano */ /* Creation : Sat Mar 5 08:05:01 2016 */ -/* Last change : Mon May 6 16:05:05 2024 (serrano) */ +/* Last change : Sat Nov 9 09:20:40 2024 (serrano) */ /* Copyright : 2016-24 Manuel Serrano */ /* ------------------------------------------------------------- */ /* Bigloo VECTORs */ @@ -36,7 +36,7 @@ BGL_RUNTIME_DECL obj_t bgl_saw_vector_copy(obj_t); /* bgl_vector ... */ /*---------------------------------------------------------------------*/ struct bgl_vector { -#if(!defined(TAG_VECTOR)) +#if (!defined(TAG_VECTOR)) header_t header; #endif /* XXX-VECTOR_SIZE_TAG_NB_BIT bit long length (see VECTOR_LENGTH) */ @@ -66,7 +66,7 @@ struct bgl_hvector { /*---------------------------------------------------------------------*/ /* tagging */ /*---------------------------------------------------------------------*/ -#if(defined(TAG_VECTOR)) +#if (defined(TAG_VECTOR)) # define BVECTOR(p) BGL_BPTR((obj_t)((long)p + TAG_VECTOR)) # define CVECTOR(p) BGL_CPTR((obj_t)((unsigned long)p - TAG_VECTOR)) # if(TAG_VECTOR != 0) @@ -108,7 +108,7 @@ struct bgl_hvector { #define VECTOR_REF(v, i) ((&(VECTOR(v).obj0))[i]) #define VECTOR_SET(v, i, o) BASSIGN(VECTOR_REF(v, i), o, v) -#if(VECTOR_SIZE_TAG_NB_BIT != 0) +#if (VECTOR_SIZE_TAG_NB_BIT != 0) # define BGL_VLENGTH(v) (VECTOR(v).length & VECTOR_LENGTH_MASK) #else # define BGL_VLENGTH(v) (VECTOR(v).length) @@ -116,7 +116,7 @@ struct bgl_hvector { #define VECTOR_LENGTH(v) BGL_VLENGTH(v) -#if(VECTOR_SIZE_TAG_NB_BIT != 0) +#if (VECTOR_SIZE_TAG_NB_BIT != 0) # define VECTOR_TAG_SET(v, tag) \ (VECTOR(v).length = \ (BGL_VLENGTH(v) | (((unsigned long) tag) << VECTOR_LENGTH_SHIFT)), \ @@ -128,7 +128,7 @@ struct bgl_hvector { # define VECTOR_TAG(v) (0) #endif -#if(VECTOR_SIZE_TAG_NB_BIT != 0) +#if (VECTOR_SIZE_TAG_NB_BIT != 0) # define BGL_VECTOR_SHRINK(v, l) \ ((l >= 0 && l < BGL_VLENGTH(v)) ? \ VECTOR(v).length = (l & ~VECTOR_LENGTH_MASK)), v : v) @@ -333,7 +333,7 @@ BGL_RUNTIME_DECL obj_t alloc_hvector(int, int, int); /*---------------------------------------------------------------------*/ /* Vector stack allocation */ /*---------------------------------------------------------------------*/ -#if(BGL_HAVE_ALLOCA && defined(__GNUC__)) +#if (BGL_HAVE_ALLOCA && !BGL_NAN_TAGGING && defined(__GNUC__)) # if(!defined(TAG_VECTOR)) # define BGL_CREATE_STACK_VECTOR(len) \ ({ \