Skip to content

Commit

Permalink
Disable stack allocation when nan tagging enabled (bootstrap)
Browse files Browse the repository at this point in the history
  • Loading branch information
@manuel-serrano
manuel-serrano committed Nov 9, 2024
1 parent 7af8bc0 commit f6b8711
Show file tree
Hide file tree
Showing 4 changed files with 111 additions and 106 deletions.
13 changes: 9 additions & 4 deletions runtime/Include/bigloo.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 */
/*=====================================================================*/
Expand Down Expand Up @@ -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 */
Expand Down
4 changes: 2 additions & 2 deletions runtime/Include/bigloo_cell.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 */
Expand Down Expand Up @@ -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); \
Expand Down
186 changes: 93 additions & 93 deletions runtime/Include/bigloo_pair.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 */
/*=====================================================================*/
Expand All @@ -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
Expand All @@ -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++ */
Expand Down
14 changes: 7 additions & 7 deletions runtime/Include/bigloo_vector.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 */
Expand Down Expand Up @@ -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) */
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -108,15 +108,15 @@ 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)
#endif

#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)), \
Expand All @@ -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)
Expand Down Expand Up @@ -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) \
({ \
Expand Down

0 comments on commit f6b8711

Please sign in to comment.