From 719829f055efb47f9480ffc277f9a7303446c163 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Thu, 26 Apr 2018 13:20:59 +0200 Subject: [PATCH 01/12] lib: define POS_{FAMILY,FLAGS}_TYPE constants Also move the POS_*_TYPE constants into the kernel, as their values are also used there. Moreover, this allows the GAP compiler to produce optimized code when these constants are used. --- hpcgap/src/c_type1.c | 255 ++++++++++++++++++------------------------- lib/type.g | 26 +---- lib/type.gi | 10 +- lib/type1.g | 34 +++--- src/c_type1.c | 250 +++++++++++++++++------------------------- src/objects.c | 7 ++ src/objects.h | 27 ++++- 7 files changed, 258 insertions(+), 351 deletions(-) diff --git a/hpcgap/src/c_type1.c b/hpcgap/src/c_type1.c index 109fb1410f5..45cf728ab96 100644 --- a/hpcgap/src/c_type1.c +++ b/hpcgap/src/c_type1.c @@ -1,7 +1,7 @@ #ifndef AVOID_PRECOMPILED /* C file produced by GAC */ #include -#define FILE_CRC "-95946497" +#define FILE_CRC "132228056" /* global variables used in handlers */ static GVar G_NAME__FUNC; @@ -150,16 +150,10 @@ static GVar G_NEW__TYPE__CACHE__MISS; static Obj GC_NEW__TYPE__CACHE__MISS; static GVar G_NEW__TYPE__CACHE__HIT; static Obj GC_NEW__TYPE__CACHE__HIT; -static GVar G_POS__DATA__TYPE; -static Obj GC_POS__DATA__TYPE; -static GVar G_POS__FIRST__FREE__TYPE; -static Obj GC_POS__FIRST__FREE__TYPE; static GVar G_NEW__TYPE__NEXT__ID; static Obj GC_NEW__TYPE__NEXT__ID; static GVar G_NEW__TYPE__ID__LIMIT; static Obj GC_NEW__TYPE__ID__LIMIT; -static GVar G_POS__NUMB__TYPE; -static Obj GC_POS__NUMB__TYPE; static GVar G_NEW__TYPE; static Obj GF_NEW__TYPE; static GVar G_IsFamily; @@ -1015,7 +1009,6 @@ static Obj HdlrFunc11 ( Obj t_8 = 0; Obj t_9 = 0; Obj t_10 = 0; - Obj t_11 = 0; (void)l_lock; (void)l_hash; (void)l_cache; @@ -1096,12 +1089,9 @@ static Obj HdlrFunc11 ( C_ELM_POSOBJ_NLE( t_1, l_cached, 2 ); a_flags = t_1; - /* if IS_IDENTICAL_OBJ( data, cached![POS_DATA_TYPE] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then */ + /* if IS_IDENTICAL_OBJ( data, cached![3] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then */ t_4 = GF_IS__IDENTICAL__OBJ; - t_6 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_6, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_6 ) - C_ELM_POSOBJ_NLE( t_5, l_cached, INT_INTOBJ(t_6) ); + C_ELM_POSOBJ_NLE( t_5, l_cached, 3 ); t_3 = CALL_2ARGS( t_4, a_data, t_5 ); CHECK_FUNC_RESULT( t_3 ) CHECK_BOOL( t_3 ) @@ -1134,38 +1124,34 @@ static Obj HdlrFunc11 ( t_1 = True; l_match = t_1; - /* for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( cached ) ] do */ - t_2 = GC_POS__FIRST__FREE__TYPE; - CHECK_BOUND( t_2, "POS_FIRST_FREE_TYPE" ) + /* for i in [ 5 .. LEN_POSOBJ( cached ) ] do */ + t_3 = GF_LEN__POSOBJ; + t_2 = CALL_1ARGS( t_3, l_cached ); + CHECK_FUNC_RESULT( t_2 ) CHECK_INT_SMALL( t_2 ) - t_4 = GF_LEN__POSOBJ; - t_3 = CALL_1ARGS( t_4, l_cached ); - CHECK_FUNC_RESULT( t_3 ) - CHECK_INT_SMALL( t_3 ) - for ( t_1 = t_2; - ((Int)t_1) <= ((Int)t_3); + for ( t_1 = INTOBJ_INT(5); + ((Int)t_1) <= ((Int)t_2); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* if IsBound( cached![i] ) then */ - CHECK_INT_SMALL_POS( l_i ) if ( TNUM_OBJ(l_cached) == T_POSOBJ ) { - t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 + t_4 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 && ELM_PLIST(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(l_cached) == T_APOSOBJ ) { - t_5 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; + t_4 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_5 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); + t_4 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); } - t_4 = (Obj)(UInt)(t_5 != False); - if ( t_4 ) { + t_3 = (Obj)(UInt)(t_4 != False); + if ( t_3 ) { /* match := false; */ - t_4 = False; - l_match = t_4; + t_3 = False; + l_match = t_3; /* break; */ break; @@ -1215,49 +1201,45 @@ static Obj HdlrFunc11 ( t_1 = True; l_match = t_1; - /* for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do */ - t_2 = GC_POS__FIRST__FREE__TYPE; - CHECK_BOUND( t_2, "POS_FIRST_FREE_TYPE" ) + /* for i in [ 5 .. LEN_POSOBJ( parent ) ] do */ + t_3 = GF_LEN__POSOBJ; + t_2 = CALL_1ARGS( t_3, a_parent ); + CHECK_FUNC_RESULT( t_2 ) CHECK_INT_SMALL( t_2 ) - t_4 = GF_LEN__POSOBJ; - t_3 = CALL_1ARGS( t_4, a_parent ); - CHECK_FUNC_RESULT( t_3 ) - CHECK_INT_SMALL( t_3 ) - for ( t_1 = t_2; - ((Int)t_1) <= ((Int)t_3); + for ( t_1 = INTOBJ_INT(5); + ((Int)t_1) <= ((Int)t_2); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* if IsBound( parent![i] ) <> IsBound( cached![i] ) then */ - CHECK_INT_SMALL_POS( l_i ) if ( TNUM_OBJ(a_parent) == T_POSOBJ ) { - t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 + t_4 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 && ELM_PLIST(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(a_parent) == T_APOSOBJ ) { - t_5 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; + t_4 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_5 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); + t_4 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); } if ( TNUM_OBJ(l_cached) == T_POSOBJ ) { - t_6 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 + t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 && ELM_PLIST(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(l_cached) == T_APOSOBJ ) { - t_6 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; + t_5 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_6 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); + t_5 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); } - t_4 = (Obj)(UInt)( ! EQ( t_5, t_6 )); - if ( t_4 ) { + t_3 = (Obj)(UInt)( ! EQ( t_4, t_5 )); + if ( t_3 ) { /* match := false; */ - t_4 = False; - l_match = t_4; + t_3 = False; + l_match = t_3; /* break; */ break; @@ -1267,50 +1249,50 @@ static Obj HdlrFunc11 ( /* if IsBound( parent![i] ) and IsBound( cached![i] ) and not IS_IDENTICAL_OBJ( parent![i], cached![i] ) then */ if ( TNUM_OBJ(a_parent) == T_POSOBJ ) { - t_7 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 + t_6 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 && ELM_PLIST(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(a_parent) == T_APOSOBJ ) { - t_7 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; + t_6 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_7 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); + t_6 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); } - t_6 = (Obj)(UInt)(t_7 != False); - t_5 = t_6; - if ( t_5 ) { + t_5 = (Obj)(UInt)(t_6 != False); + t_4 = t_5; + if ( t_4 ) { if ( TNUM_OBJ(l_cached) == T_POSOBJ ) { - t_8 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 + t_7 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 && ELM_PLIST(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(l_cached) == T_APOSOBJ ) { - t_8 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; + t_7 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_8 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); + t_7 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); } - t_7 = (Obj)(UInt)(t_8 != False); - t_5 = t_7; - } - t_4 = t_5; - if ( t_4 ) { - t_9 = GF_IS__IDENTICAL__OBJ; - C_ELM_POSOBJ_NLE( t_10, a_parent, INT_INTOBJ(l_i) ); - C_ELM_POSOBJ_NLE( t_11, l_cached, INT_INTOBJ(l_i) ); - t_8 = CALL_2ARGS( t_9, t_10, t_11 ); - CHECK_FUNC_RESULT( t_8 ) - CHECK_BOOL( t_8 ) - t_7 = (Obj)(UInt)(t_8 != False); - t_6 = (Obj)(UInt)( ! ((Int)t_7) ); + t_6 = (Obj)(UInt)(t_7 != False); t_4 = t_6; } - if ( t_4 ) { + t_3 = t_4; + if ( t_3 ) { + t_8 = GF_IS__IDENTICAL__OBJ; + C_ELM_POSOBJ_NLE( t_9, a_parent, INT_INTOBJ(l_i) ); + C_ELM_POSOBJ_NLE( t_10, l_cached, INT_INTOBJ(l_i) ); + t_7 = CALL_2ARGS( t_8, t_9, t_10 ); + CHECK_FUNC_RESULT( t_7 ) + CHECK_BOOL( t_7 ) + t_6 = (Obj)(UInt)(t_7 != False); + t_5 = (Obj)(UInt)( ! ((Int)t_6) ); + t_3 = t_5; + } + if ( t_3 ) { /* match := false; */ - t_4 = False; - l_match = t_4; + t_3 = False; + l_match = t_3; /* break; */ break; @@ -1398,19 +1380,13 @@ static Obj HdlrFunc11 ( CHECK_FUNC_RESULT( t_1 ) a_data = t_1; - /* type[POS_DATA_TYPE] := data; */ - t_1 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_1, "POS_DATA_TYPE" ) - CHECK_INT_POS( t_1 ) - C_ASS_LIST_FPL( l_type, t_1, a_data ) + /* type[3] := data; */ + C_ASS_LIST_FPL( l_type, INTOBJ_INT(3), a_data ) - /* type[POS_NUMB_TYPE] := NEW_TYPE_NEXT_ID; */ - t_1 = GC_POS__NUMB__TYPE; - CHECK_BOUND( t_1, "POS_NUMB_TYPE" ) - CHECK_INT_POS( t_1 ) - t_2 = GC_NEW__TYPE__NEXT__ID; - CHECK_BOUND( t_2, "NEW_TYPE_NEXT_ID" ) - C_ASS_LIST_FPL( l_type, t_1, t_2 ) + /* type[4] := NEW_TYPE_NEXT_ID; */ + t_1 = GC_NEW__TYPE__NEXT__ID; + CHECK_BOUND( t_1, "NEW_TYPE_NEXT_ID" ) + C_ASS_LIST_FPL( l_type, INTOBJ_INT(4), t_1 ) /* if not IS_IDENTICAL_OBJ( parent, fail ) then */ t_4 = GF_IS__IDENTICAL__OBJ; @@ -1423,45 +1399,41 @@ static Obj HdlrFunc11 ( t_1 = (Obj)(UInt)( ! ((Int)t_2) ); if ( t_1 ) { - /* for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do */ - t_2 = GC_POS__FIRST__FREE__TYPE; - CHECK_BOUND( t_2, "POS_FIRST_FREE_TYPE" ) + /* for i in [ 5 .. LEN_POSOBJ( parent ) ] do */ + t_3 = GF_LEN__POSOBJ; + t_2 = CALL_1ARGS( t_3, a_parent ); + CHECK_FUNC_RESULT( t_2 ) CHECK_INT_SMALL( t_2 ) - t_4 = GF_LEN__POSOBJ; - t_3 = CALL_1ARGS( t_4, a_parent ); - CHECK_FUNC_RESULT( t_3 ) - CHECK_INT_SMALL( t_3 ) - for ( t_1 = t_2; - ((Int)t_1) <= ((Int)t_3); + for ( t_1 = INTOBJ_INT(5); + ((Int)t_1) <= ((Int)t_2); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* if IsBound( parent![i] ) and not IsBound( type[i] ) then */ - CHECK_INT_SMALL_POS( l_i ) if ( TNUM_OBJ(a_parent) == T_POSOBJ ) { - t_6 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 + t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 && ELM_PLIST(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(a_parent) == T_APOSOBJ ) { - t_6 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; + t_5 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_6 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); + t_5 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); } - t_5 = (Obj)(UInt)(t_6 != False); - t_4 = t_5; - if ( t_4 ) { - t_8 = C_ISB_LIST( l_type, l_i ); - t_7 = (Obj)(UInt)(t_8 != False); - t_6 = (Obj)(UInt)( ! ((Int)t_7) ); - t_4 = t_6; + t_4 = (Obj)(UInt)(t_5 != False); + t_3 = t_4; + if ( t_3 ) { + t_7 = C_ISB_LIST( l_type, l_i ); + t_6 = (Obj)(UInt)(t_7 != False); + t_5 = (Obj)(UInt)( ! ((Int)t_6) ); + t_3 = t_5; } - if ( t_4 ) { + if ( t_3 ) { /* type[i] := parent![i]; */ - C_ELM_POSOBJ_NLE( t_4, a_parent, INT_INTOBJ(l_i) ); - C_ASS_LIST_FPL( l_type, l_i, t_4 ) + C_ELM_POSOBJ_NLE( t_3, a_parent, INT_INTOBJ(l_i) ); + C_ASS_LIST_FPL( l_type, l_i, t_3 ) } /* fi */ @@ -1898,7 +1870,7 @@ static Obj HdlrFunc15 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![POS_DATA_TYPE], type ); */ + /* return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![3], type ); */ t_2 = GF_NEW__TYPE; t_3 = GC_TypeOfTypes; CHECK_BOUND( t_3, "TypeOfTypes" ) @@ -1913,10 +1885,7 @@ static Obj HdlrFunc15 ( CHECK_FUNC_RESULT( t_7 ) t_5 = CALL_1ARGS( t_6, t_7 ); CHECK_FUNC_RESULT( t_5 ) - t_7 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_7, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_7 ) - C_ELM_POSOBJ_NLE( t_6, a_type, INT_INTOBJ(t_7) ); + C_ELM_POSOBJ_NLE( t_6, a_type, 3 ); t_1 = CALL_5ARGS( t_2, t_3, t_4, t_5, t_6, a_type ); CHECK_FUNC_RESULT( t_1 ) RES_BRK_CURR_STAT(); @@ -2098,7 +2067,7 @@ static Obj HdlrFunc18 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![POS_DATA_TYPE], type ); */ + /* return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![3], type ); */ t_2 = GF_NEW__TYPE; t_3 = GC_TypeOfTypes; CHECK_BOUND( t_3, "TypeOfTypes" ) @@ -2110,10 +2079,7 @@ static Obj HdlrFunc18 ( CHECK_FUNC_RESULT( t_8 ) t_5 = CALL_2ARGS( t_6, t_7, t_8 ); CHECK_FUNC_RESULT( t_5 ) - t_7 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_7, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_7 ) - C_ELM_POSOBJ_NLE( t_6, a_type, INT_INTOBJ(t_7) ); + C_ELM_POSOBJ_NLE( t_6, a_type, 3 ); t_1 = CALL_5ARGS( t_2, t_3, t_4, t_5, t_6, a_type ); CHECK_FUNC_RESULT( t_1 ) RES_BRK_CURR_STAT(); @@ -2315,7 +2281,6 @@ static Obj HdlrFunc23 ( Obj a_K ) { Obj t_1 = 0; - Obj t_2 = 0; Bag oldFrame; OLD_BRK_CURR_STAT @@ -2324,11 +2289,8 @@ static Obj HdlrFunc23 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* return K![POS_DATA_TYPE]; */ - t_2 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_2, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_2 ) - C_ELM_POSOBJ_NLE( t_1, a_K, INT_INTOBJ(t_2) ); + /* return K![3]; */ + C_ELM_POSOBJ_NLE( t_1, a_K, 3 ); RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return t_1; @@ -2348,7 +2310,6 @@ static Obj HdlrFunc24 ( Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; - Obj t_4 = 0; Bag oldFrame; OLD_BRK_CURR_STAT @@ -2357,14 +2318,12 @@ static Obj HdlrFunc24 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* StrictBindOnce( K, POS_DATA_TYPE, MakeImmutable( data ) ); */ + /* StrictBindOnce( K, 3, MakeImmutable( data ) ); */ t_1 = GF_StrictBindOnce; - t_2 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_2, "POS_DATA_TYPE" ) - t_4 = GF_MakeImmutable; - t_3 = CALL_1ARGS( t_4, a_data ); - CHECK_FUNC_RESULT( t_3 ) - CALL_3ARGS( t_1, a_K, t_2, t_3 ); + t_3 = GF_MakeImmutable; + t_2 = CALL_1ARGS( t_3, a_data ); + CHECK_FUNC_RESULT( t_2 ) + CALL_3ARGS( t_1, a_K, INTOBJ_INT(3), t_2 ); /* return; */ RES_BRK_CURR_STAT(); @@ -3754,10 +3713,10 @@ static Obj HdlrFunc1 ( cached := cache[hash]; if IS_EQUAL_FLAGS( flags, cached![2] ) then flags := cached![2]; - if IS_IDENTICAL_OBJ( data, cached![POS_DATA_TYPE] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then + if IS_IDENTICAL_OBJ( data, cached![3] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then if IS_IDENTICAL_OBJ( parent, fail ) then match := true; - for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( cached ) ] do + for i in [ 5 .. LEN_POSOBJ( cached ) ] do if IsBound( cached![i] ) then match := false; break; @@ -3771,7 +3730,7 @@ static Obj HdlrFunc1 ( fi; if LEN_POSOBJ( parent ) = LEN_POSOBJ( cached ) then match := true; - for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do + for i in [ 5 .. LEN_POSOBJ( parent ) ] do if IsBound( parent![i] ) <> IsBound( cached![i] ) then match := false; break; @@ -3797,10 +3756,10 @@ static Obj HdlrFunc1 ( fi; type := [ family, flags ]; data := MakeReadOnlyObj( data ); - type[POS_DATA_TYPE] := data; - type[POS_NUMB_TYPE] := NEW_TYPE_NEXT_ID; + type[3] := data; + type[4] := NEW_TYPE_NEXT_ID; if not IS_IDENTICAL_OBJ( parent, fail ) then - for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do + for i in [ 5 .. LEN_POSOBJ( parent ) ] do if IsBound( parent![i] ) and not IsBound( type[i] ) then type[i] := parent![i]; fi; @@ -3894,7 +3853,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "Subtype2", function ( type, filter ) - return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![POS_DATA_TYPE], type ); + return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![3], type ); end ); */ t_1 = GF_BIND__GLOBAL; t_2 = MakeString( "Subtype2" ); @@ -3953,7 +3912,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "SupType2", function ( type, filter ) - return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![POS_DATA_TYPE], type ); + return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![3], type ); end ); */ t_1 = GF_BIND__GLOBAL; t_2 = MakeString( "SupType2" ); @@ -4036,7 +3995,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "DataType", function ( K ) - return K![POS_DATA_TYPE]; + return K![3]; end ); */ t_1 = GF_BIND__GLOBAL; t_2 = MakeString( "DataType" ); @@ -4051,7 +4010,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "SetDataType", function ( K, data ) - StrictBindOnce( K, POS_DATA_TYPE, MakeImmutable( data ) ); + StrictBindOnce( K, 3, MakeImmutable( data ) ); return; end ); */ t_1 = GF_BIND__GLOBAL; @@ -4471,11 +4430,8 @@ static Int PostRestore ( StructInitInfo * module ) G_NewFamily5 = GVarName( "NewFamily5" ); G_NEW__TYPE__CACHE__MISS = GVarName( "NEW_TYPE_CACHE_MISS" ); G_NEW__TYPE__CACHE__HIT = GVarName( "NEW_TYPE_CACHE_HIT" ); - G_POS__DATA__TYPE = GVarName( "POS_DATA_TYPE" ); - G_POS__FIRST__FREE__TYPE = GVarName( "POS_FIRST_FREE_TYPE" ); G_NEW__TYPE__NEXT__ID = GVarName( "NEW_TYPE_NEXT_ID" ); G_NEW__TYPE__ID__LIMIT = GVarName( "NEW_TYPE_ID_LIMIT" ); - G_POS__NUMB__TYPE = GVarName( "POS_NUMB_TYPE" ); G_NEW__TYPE = GVarName( "NEW_TYPE" ); G_IsFamily = GVarName( "IsFamily" ); G_NewType3 = GVarName( "NewType3" ); @@ -4634,11 +4590,8 @@ static Int InitKernel ( StructInitInfo * module ) InitFopyGVar( "NewFamily5", &GF_NewFamily5 ); InitCopyGVar( "NEW_TYPE_CACHE_MISS", &GC_NEW__TYPE__CACHE__MISS ); InitCopyGVar( "NEW_TYPE_CACHE_HIT", &GC_NEW__TYPE__CACHE__HIT ); - InitCopyGVar( "POS_DATA_TYPE", &GC_POS__DATA__TYPE ); - InitCopyGVar( "POS_FIRST_FREE_TYPE", &GC_POS__FIRST__FREE__TYPE ); InitCopyGVar( "NEW_TYPE_NEXT_ID", &GC_NEW__TYPE__NEXT__ID ); InitCopyGVar( "NEW_TYPE_ID_LIMIT", &GC_NEW__TYPE__ID__LIMIT ); - InitCopyGVar( "POS_NUMB_TYPE", &GC_POS__NUMB__TYPE ); InitFopyGVar( "NEW_TYPE", &GF_NEW__TYPE ); InitFopyGVar( "IsFamily", &GF_IsFamily ); InitFopyGVar( "NewType3", &GF_NewType3 ); @@ -4771,7 +4724,7 @@ static Int InitLibrary ( StructInitInfo * module ) static StructInitInfo module = { .type = MODULE_STATIC, .name = "GAPROOT/lib/type1.g", - .crc = -95946497, + .crc = 132228056, .initKernel = InitKernel, .initLibrary = InitLibrary, .postRestore = PostRestore, diff --git a/lib/type.g b/lib/type.g index 208bc42e2f1..3b4fc0c02dd 100644 --- a/lib/type.g +++ b/lib/type.g @@ -12,28 +12,6 @@ ## -############################################################################# -## -#V POS_DATA_TYPE . . . . . . . . position where the data of a type is stored -#V POS_NUMB_TYPE . . . . . . . position where the number of a type is stored -#V POS_FIRST_FREE_TYPE . . . . . first position that has no overall meaning -## -## -## -## -## -## -## -## Note that the family and the flags list are stored at positions 1 and 2, -## respectively. -## -## -## -BIND_CONSTANT( "POS_DATA_TYPE", 3 ); -BIND_CONSTANT( "POS_NUMB_TYPE", 4 ); -BIND_CONSTANT( "POS_FIRST_FREE_TYPE", 5 ); - - ############################################################################# ## #F NEW_TYPE_NEXT_ID . . . . . . . . . . . . GAP integer numbering the types @@ -600,8 +578,8 @@ InstallOtherMethod( PRINT_OBJ, function ( type ) local family, flags, data; - family := type![1]; - flags := type![2]; + family := type![ POS_FAMILY_TYPE ]; + flags := type![ POS_FLAGS_TYPE ]; data := type![ POS_DATA_TYPE ]; Print( "NewType( ", family ); if flags <> [] or data <> false then diff --git a/lib/type.gi b/lib/type.gi index 935b0b6b188..c093eb5dafa 100644 --- a/lib/type.gi +++ b/lib/type.gi @@ -16,7 +16,7 @@ ## Return list of filters set in the given type. ## InstallMethod(FiltersType, "for a type", [ IsType ], - type -> FILTERS{ TRUES_FLAGS(type![2]) }); + type -> FILTERS{ TRUES_FLAGS(type![POS_FLAGS_TYPE]) }); ############################################################################# ## @@ -101,11 +101,11 @@ function ( type ) local res, family, flags, data, fnams; res := " ## ## -BIND_GLOBAL( "FamilyType", K -> K![1] ); +BIND_GLOBAL( "FamilyType", K -> K![POS_FAMILY_TYPE] ); ############################################################################# @@ -530,7 +530,7 @@ BIND_GLOBAL( "FamilyType", K -> K![1] ); ## ## ## -BIND_GLOBAL( "FlagsType", K -> K![2] ); +BIND_GLOBAL( "FlagsType", K -> K![POS_FLAGS_TYPE] ); ############################################################################# @@ -715,7 +715,7 @@ BIND_GLOBAL( "Objectify", function ( type, obj ) SET_TYPE_COMOBJ( obj, type ); fi; if not IsNoImmediateMethodsObject(obj) then - RunImmediateMethods( obj, type![2] ); + RunImmediateMethods( obj, type![POS_FLAGS_TYPE] ); fi; if IsHPCGAP then if IsReadOnlyPositionalObjectRep(obj) then @@ -754,7 +754,7 @@ local type, newtype; SET_TYPE_POSOBJ( obj, newtype ); if not ( IGNORE_IMMEDIATE_METHODS or IsNoImmediateMethodsObject(obj) ) then - RunImmediateMethods( obj, SUB_FLAGS( newtype![2], type![2] ) ); + RunImmediateMethods( obj, SUB_FLAGS( newtype![POS_FLAGS_TYPE], type![POS_FLAGS_TYPE] ) ); fi; elif IS_COMOBJ( obj ) then type:= TYPE_OBJ( obj ); @@ -762,7 +762,7 @@ local type, newtype; SET_TYPE_COMOBJ( obj, newtype ); if not ( IGNORE_IMMEDIATE_METHODS or IsNoImmediateMethodsObject(obj) ) then - RunImmediateMethods( obj, SUB_FLAGS( newtype![2], type![2] ) ); + RunImmediateMethods( obj, SUB_FLAGS( newtype![POS_FLAGS_TYPE], type![POS_FLAGS_TYPE] ) ); fi; elif IS_DATOBJ( obj ) then type:= TYPE_OBJ( obj ); @@ -770,7 +770,7 @@ local type, newtype; SET_TYPE_DATOBJ( obj, newtype ); if not ( IGNORE_IMMEDIATE_METHODS or IsNoImmediateMethodsObject(obj) ) then - RunImmediateMethods( obj, SUB_FLAGS( newtype![2], type![2] ) ); + RunImmediateMethods( obj, SUB_FLAGS( newtype![POS_FLAGS_TYPE], type![POS_FLAGS_TYPE] ) ); fi; elif IS_PLIST_REP( obj ) then SET_FILTER_LIST( obj, filter ); diff --git a/src/c_type1.c b/src/c_type1.c index 90a33bf8e13..2259f30b162 100644 --- a/src/c_type1.c +++ b/src/c_type1.c @@ -1,7 +1,7 @@ #ifndef AVOID_PRECOMPILED /* C file produced by GAC */ #include -#define FILE_CRC "-95946497" +#define FILE_CRC "132228056" /* global variables used in handlers */ static GVar G_NAME__FUNC; @@ -124,16 +124,10 @@ static GVar G_NEW__TYPE__CACHE__MISS; static Obj GC_NEW__TYPE__CACHE__MISS; static GVar G_NEW__TYPE__CACHE__HIT; static Obj GC_NEW__TYPE__CACHE__HIT; -static GVar G_POS__DATA__TYPE; -static Obj GC_POS__DATA__TYPE; -static GVar G_POS__FIRST__FREE__TYPE; -static Obj GC_POS__FIRST__FREE__TYPE; static GVar G_NEW__TYPE__NEXT__ID; static Obj GC_NEW__TYPE__NEXT__ID; static GVar G_NEW__TYPE__ID__LIMIT; static Obj GC_NEW__TYPE__ID__LIMIT; -static GVar G_POS__NUMB__TYPE; -static Obj GC_POS__NUMB__TYPE; static GVar G_NEW__TYPE; static Obj GF_NEW__TYPE; static GVar G_IsFamily; @@ -962,7 +956,6 @@ static Obj HdlrFunc11 ( Obj t_8 = 0; Obj t_9 = 0; Obj t_10 = 0; - Obj t_11 = 0; (void)l_lock; (void)l_hash; (void)l_cache; @@ -1035,12 +1028,9 @@ static Obj HdlrFunc11 ( C_ELM_POSOBJ_NLE( t_1, l_cached, 2 ); a_flags = t_1; - /* if IS_IDENTICAL_OBJ( data, cached![POS_DATA_TYPE] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then */ + /* if IS_IDENTICAL_OBJ( data, cached![3] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then */ t_4 = GF_IS__IDENTICAL__OBJ; - t_6 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_6, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_6 ) - C_ELM_POSOBJ_NLE( t_5, l_cached, INT_INTOBJ(t_6) ); + C_ELM_POSOBJ_NLE( t_5, l_cached, 3 ); t_3 = CALL_2ARGS( t_4, a_data, t_5 ); CHECK_FUNC_RESULT( t_3 ) CHECK_BOOL( t_3 ) @@ -1073,38 +1063,34 @@ static Obj HdlrFunc11 ( t_1 = True; l_match = t_1; - /* for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( cached ) ] do */ - t_2 = GC_POS__FIRST__FREE__TYPE; - CHECK_BOUND( t_2, "POS_FIRST_FREE_TYPE" ) + /* for i in [ 5 .. LEN_POSOBJ( cached ) ] do */ + t_3 = GF_LEN__POSOBJ; + t_2 = CALL_1ARGS( t_3, l_cached ); + CHECK_FUNC_RESULT( t_2 ) CHECK_INT_SMALL( t_2 ) - t_4 = GF_LEN__POSOBJ; - t_3 = CALL_1ARGS( t_4, l_cached ); - CHECK_FUNC_RESULT( t_3 ) - CHECK_INT_SMALL( t_3 ) - for ( t_1 = t_2; - ((Int)t_1) <= ((Int)t_3); + for ( t_1 = INTOBJ_INT(5); + ((Int)t_1) <= ((Int)t_2); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* if IsBound( cached![i] ) then */ - CHECK_INT_SMALL_POS( l_i ) if ( TNUM_OBJ(l_cached) == T_POSOBJ ) { - t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 + t_4 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 && ELM_PLIST(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(l_cached) == T_APOSOBJ ) { - t_5 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; + t_4 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_5 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); + t_4 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); } - t_4 = (Obj)(UInt)(t_5 != False); - if ( t_4 ) { + t_3 = (Obj)(UInt)(t_4 != False); + if ( t_3 ) { /* match := false; */ - t_4 = False; - l_match = t_4; + t_3 = False; + l_match = t_3; /* break; */ break; @@ -1150,49 +1136,45 @@ static Obj HdlrFunc11 ( t_1 = True; l_match = t_1; - /* for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do */ - t_2 = GC_POS__FIRST__FREE__TYPE; - CHECK_BOUND( t_2, "POS_FIRST_FREE_TYPE" ) + /* for i in [ 5 .. LEN_POSOBJ( parent ) ] do */ + t_3 = GF_LEN__POSOBJ; + t_2 = CALL_1ARGS( t_3, a_parent ); + CHECK_FUNC_RESULT( t_2 ) CHECK_INT_SMALL( t_2 ) - t_4 = GF_LEN__POSOBJ; - t_3 = CALL_1ARGS( t_4, a_parent ); - CHECK_FUNC_RESULT( t_3 ) - CHECK_INT_SMALL( t_3 ) - for ( t_1 = t_2; - ((Int)t_1) <= ((Int)t_3); + for ( t_1 = INTOBJ_INT(5); + ((Int)t_1) <= ((Int)t_2); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* if IsBound( parent![i] ) <> IsBound( cached![i] ) then */ - CHECK_INT_SMALL_POS( l_i ) if ( TNUM_OBJ(a_parent) == T_POSOBJ ) { - t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 + t_4 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 && ELM_PLIST(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(a_parent) == T_APOSOBJ ) { - t_5 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; + t_4 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_5 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); + t_4 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); } if ( TNUM_OBJ(l_cached) == T_POSOBJ ) { - t_6 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 + t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 && ELM_PLIST(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(l_cached) == T_APOSOBJ ) { - t_6 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; + t_5 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_6 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); + t_5 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); } - t_4 = (Obj)(UInt)( ! EQ( t_5, t_6 )); - if ( t_4 ) { + t_3 = (Obj)(UInt)( ! EQ( t_4, t_5 )); + if ( t_3 ) { /* match := false; */ - t_4 = False; - l_match = t_4; + t_3 = False; + l_match = t_3; /* break; */ break; @@ -1202,50 +1184,50 @@ static Obj HdlrFunc11 ( /* if IsBound( parent![i] ) and IsBound( cached![i] ) and not IS_IDENTICAL_OBJ( parent![i], cached![i] ) then */ if ( TNUM_OBJ(a_parent) == T_POSOBJ ) { - t_7 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 + t_6 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 && ELM_PLIST(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(a_parent) == T_APOSOBJ ) { - t_7 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; + t_6 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_7 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); + t_6 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); } - t_6 = (Obj)(UInt)(t_7 != False); - t_5 = t_6; - if ( t_5 ) { + t_5 = (Obj)(UInt)(t_6 != False); + t_4 = t_5; + if ( t_4 ) { if ( TNUM_OBJ(l_cached) == T_POSOBJ ) { - t_8 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 + t_7 = (INT_INTOBJ(l_i) <= SIZE_OBJ(l_cached)/sizeof(Obj)-1 && ELM_PLIST(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(l_cached) == T_APOSOBJ ) { - t_8 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; + t_7 = Elm0AList(l_cached,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_8 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); + t_7 = (ISB_LIST( l_cached, INT_INTOBJ(l_i) ) ? True : False); } - t_7 = (Obj)(UInt)(t_8 != False); - t_5 = t_7; - } - t_4 = t_5; - if ( t_4 ) { - t_9 = GF_IS__IDENTICAL__OBJ; - C_ELM_POSOBJ_NLE( t_10, a_parent, INT_INTOBJ(l_i) ); - C_ELM_POSOBJ_NLE( t_11, l_cached, INT_INTOBJ(l_i) ); - t_8 = CALL_2ARGS( t_9, t_10, t_11 ); - CHECK_FUNC_RESULT( t_8 ) - CHECK_BOOL( t_8 ) - t_7 = (Obj)(UInt)(t_8 != False); - t_6 = (Obj)(UInt)( ! ((Int)t_7) ); + t_6 = (Obj)(UInt)(t_7 != False); t_4 = t_6; } - if ( t_4 ) { + t_3 = t_4; + if ( t_3 ) { + t_8 = GF_IS__IDENTICAL__OBJ; + C_ELM_POSOBJ_NLE( t_9, a_parent, INT_INTOBJ(l_i) ); + C_ELM_POSOBJ_NLE( t_10, l_cached, INT_INTOBJ(l_i) ); + t_7 = CALL_2ARGS( t_8, t_9, t_10 ); + CHECK_FUNC_RESULT( t_7 ) + CHECK_BOOL( t_7 ) + t_6 = (Obj)(UInt)(t_7 != False); + t_5 = (Obj)(UInt)( ! ((Int)t_6) ); + t_3 = t_5; + } + if ( t_3 ) { /* match := false; */ - t_4 = False; - l_match = t_4; + t_3 = False; + l_match = t_3; /* break; */ break; @@ -1333,19 +1315,13 @@ static Obj HdlrFunc11 ( CHANGED_BAG( t_1 ); l_type = t_1; - /* type[POS_DATA_TYPE] := data; */ - t_1 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_1, "POS_DATA_TYPE" ) - CHECK_INT_POS( t_1 ) - C_ASS_LIST_FPL( l_type, t_1, a_data ) + /* type[3] := data; */ + C_ASS_LIST_FPL( l_type, INTOBJ_INT(3), a_data ) - /* type[POS_NUMB_TYPE] := NEW_TYPE_NEXT_ID; */ - t_1 = GC_POS__NUMB__TYPE; - CHECK_BOUND( t_1, "POS_NUMB_TYPE" ) - CHECK_INT_POS( t_1 ) - t_2 = GC_NEW__TYPE__NEXT__ID; - CHECK_BOUND( t_2, "NEW_TYPE_NEXT_ID" ) - C_ASS_LIST_FPL( l_type, t_1, t_2 ) + /* type[4] := NEW_TYPE_NEXT_ID; */ + t_1 = GC_NEW__TYPE__NEXT__ID; + CHECK_BOUND( t_1, "NEW_TYPE_NEXT_ID" ) + C_ASS_LIST_FPL( l_type, INTOBJ_INT(4), t_1 ) /* if not IS_IDENTICAL_OBJ( parent, fail ) then */ t_4 = GF_IS__IDENTICAL__OBJ; @@ -1358,45 +1334,41 @@ static Obj HdlrFunc11 ( t_1 = (Obj)(UInt)( ! ((Int)t_2) ); if ( t_1 ) { - /* for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do */ - t_2 = GC_POS__FIRST__FREE__TYPE; - CHECK_BOUND( t_2, "POS_FIRST_FREE_TYPE" ) + /* for i in [ 5 .. LEN_POSOBJ( parent ) ] do */ + t_3 = GF_LEN__POSOBJ; + t_2 = CALL_1ARGS( t_3, a_parent ); + CHECK_FUNC_RESULT( t_2 ) CHECK_INT_SMALL( t_2 ) - t_4 = GF_LEN__POSOBJ; - t_3 = CALL_1ARGS( t_4, a_parent ); - CHECK_FUNC_RESULT( t_3 ) - CHECK_INT_SMALL( t_3 ) - for ( t_1 = t_2; - ((Int)t_1) <= ((Int)t_3); + for ( t_1 = INTOBJ_INT(5); + ((Int)t_1) <= ((Int)t_2); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* if IsBound( parent![i] ) and not IsBound( type[i] ) then */ - CHECK_INT_SMALL_POS( l_i ) if ( TNUM_OBJ(a_parent) == T_POSOBJ ) { - t_6 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 + t_5 = (INT_INTOBJ(l_i) <= SIZE_OBJ(a_parent)/sizeof(Obj)-1 && ELM_PLIST(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False); #ifdef HPCGAP } else if ( TNUM_OBJ(a_parent) == T_APOSOBJ ) { - t_6 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; + t_5 = Elm0AList(a_parent,INT_INTOBJ(l_i)) != 0 ? True : False; #endif } else { - t_6 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); + t_5 = (ISB_LIST( a_parent, INT_INTOBJ(l_i) ) ? True : False); } - t_5 = (Obj)(UInt)(t_6 != False); - t_4 = t_5; - if ( t_4 ) { - t_8 = C_ISB_LIST( l_type, l_i ); - t_7 = (Obj)(UInt)(t_8 != False); - t_6 = (Obj)(UInt)( ! ((Int)t_7) ); - t_4 = t_6; + t_4 = (Obj)(UInt)(t_5 != False); + t_3 = t_4; + if ( t_3 ) { + t_7 = C_ISB_LIST( l_type, l_i ); + t_6 = (Obj)(UInt)(t_7 != False); + t_5 = (Obj)(UInt)( ! ((Int)t_6) ); + t_3 = t_5; } - if ( t_4 ) { + if ( t_3 ) { /* type[i] := parent![i]; */ - C_ELM_POSOBJ_NLE( t_4, a_parent, INT_INTOBJ(l_i) ); - C_ASS_LIST_FPL( l_type, l_i, t_4 ) + C_ELM_POSOBJ_NLE( t_3, a_parent, INT_INTOBJ(l_i) ); + C_ASS_LIST_FPL( l_type, l_i, t_3 ) } /* fi */ @@ -1819,7 +1791,7 @@ static Obj HdlrFunc15 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![POS_DATA_TYPE], type ); */ + /* return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![3], type ); */ t_2 = GF_NEW__TYPE; t_3 = GC_TypeOfTypes; CHECK_BOUND( t_3, "TypeOfTypes" ) @@ -1834,10 +1806,7 @@ static Obj HdlrFunc15 ( CHECK_FUNC_RESULT( t_7 ) t_5 = CALL_1ARGS( t_6, t_7 ); CHECK_FUNC_RESULT( t_5 ) - t_7 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_7, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_7 ) - C_ELM_POSOBJ_NLE( t_6, a_type, INT_INTOBJ(t_7) ); + C_ELM_POSOBJ_NLE( t_6, a_type, 3 ); t_1 = CALL_5ARGS( t_2, t_3, t_4, t_5, t_6, a_type ); CHECK_FUNC_RESULT( t_1 ) RES_BRK_CURR_STAT(); @@ -2009,7 +1978,7 @@ static Obj HdlrFunc18 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![POS_DATA_TYPE], type ); */ + /* return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![3], type ); */ t_2 = GF_NEW__TYPE; t_3 = GC_TypeOfTypes; CHECK_BOUND( t_3, "TypeOfTypes" ) @@ -2021,10 +1990,7 @@ static Obj HdlrFunc18 ( CHECK_FUNC_RESULT( t_8 ) t_5 = CALL_2ARGS( t_6, t_7, t_8 ); CHECK_FUNC_RESULT( t_5 ) - t_7 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_7, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_7 ) - C_ELM_POSOBJ_NLE( t_6, a_type, INT_INTOBJ(t_7) ); + C_ELM_POSOBJ_NLE( t_6, a_type, 3 ); t_1 = CALL_5ARGS( t_2, t_3, t_4, t_5, t_6, a_type ); CHECK_FUNC_RESULT( t_1 ) RES_BRK_CURR_STAT(); @@ -2226,7 +2192,6 @@ static Obj HdlrFunc23 ( Obj a_K ) { Obj t_1 = 0; - Obj t_2 = 0; Bag oldFrame; OLD_BRK_CURR_STAT @@ -2235,11 +2200,8 @@ static Obj HdlrFunc23 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* return K![POS_DATA_TYPE]; */ - t_2 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_2, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_2 ) - C_ELM_POSOBJ_NLE( t_1, a_K, INT_INTOBJ(t_2) ); + /* return K![3]; */ + C_ELM_POSOBJ_NLE( t_1, a_K, 3 ); RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return t_1; @@ -2256,7 +2218,6 @@ static Obj HdlrFunc24 ( Obj a_K, Obj a_data ) { - Obj t_1 = 0; Bag oldFrame; OLD_BRK_CURR_STAT @@ -2265,11 +2226,8 @@ static Obj HdlrFunc24 ( REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); - /* K![POS_DATA_TYPE] := data; */ - t_1 = GC_POS__DATA__TYPE; - CHECK_BOUND( t_1, "POS_DATA_TYPE" ) - CHECK_INT_SMALL_POS( t_1 ) - C_ASS_POSOBJ( a_K, INT_INTOBJ(t_1), a_data ) + /* K![3] := data; */ + C_ASS_POSOBJ( a_K, 3, a_data ) /* return; */ RES_BRK_CURR_STAT(); @@ -3533,10 +3491,10 @@ static Obj HdlrFunc1 ( cached := cache[hash]; if IS_EQUAL_FLAGS( flags, cached![2] ) then flags := cached![2]; - if IS_IDENTICAL_OBJ( data, cached![POS_DATA_TYPE] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then + if IS_IDENTICAL_OBJ( data, cached![3] ) and IS_IDENTICAL_OBJ( typeOfTypes, TYPE_OBJ( cached ) ) then if IS_IDENTICAL_OBJ( parent, fail ) then match := true; - for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( cached ) ] do + for i in [ 5 .. LEN_POSOBJ( cached ) ] do if IsBound( cached![i] ) then match := false; break; @@ -3550,7 +3508,7 @@ static Obj HdlrFunc1 ( fi; if LEN_POSOBJ( parent ) = LEN_POSOBJ( cached ) then match := true; - for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do + for i in [ 5 .. LEN_POSOBJ( parent ) ] do if IsBound( parent![i] ) <> IsBound( cached![i] ) then match := false; break; @@ -3578,10 +3536,10 @@ static Obj HdlrFunc1 ( fi; type := [ family, flags ]; ; - type[POS_DATA_TYPE] := data; - type[POS_NUMB_TYPE] := NEW_TYPE_NEXT_ID; + type[3] := data; + type[4] := NEW_TYPE_NEXT_ID; if not IS_IDENTICAL_OBJ( parent, fail ) then - for i in [ POS_FIRST_FREE_TYPE .. LEN_POSOBJ( parent ) ] do + for i in [ 5 .. LEN_POSOBJ( parent ) ] do if IsBound( parent![i] ) and not IsBound( type[i] ) then type[i] := parent![i]; fi; @@ -3674,7 +3632,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "Subtype2", function ( type, filter ) - return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![POS_DATA_TYPE], type ); + return NEW_TYPE( TypeOfTypes, type![1], WITH_IMPS_FLAGS( AND_FLAGS( type![2], FLAGS_FILTER( filter ) ) ), type![3], type ); end ); */ t_1 = GF_BIND__GLOBAL; t_2 = MakeString( "Subtype2" ); @@ -3733,7 +3691,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "SupType2", function ( type, filter ) - return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![POS_DATA_TYPE], type ); + return NEW_TYPE( TypeOfTypes, type![1], SUB_FLAGS( type![2], FLAGS_FILTER( filter ) ), type![3], type ); end ); */ t_1 = GF_BIND__GLOBAL; t_2 = MakeString( "SupType2" ); @@ -3816,7 +3774,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "DataType", function ( K ) - return K![POS_DATA_TYPE]; + return K![3]; end ); */ t_1 = GF_BIND__GLOBAL; t_2 = MakeString( "DataType" ); @@ -3831,7 +3789,7 @@ static Obj HdlrFunc1 ( CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "SetDataType", function ( K, data ) - K![POS_DATA_TYPE] := data; + K![3] := data; return; end ); */ t_1 = GF_BIND__GLOBAL; @@ -4223,11 +4181,8 @@ static Int PostRestore ( StructInitInfo * module ) G_NewFamily5 = GVarName( "NewFamily5" ); G_NEW__TYPE__CACHE__MISS = GVarName( "NEW_TYPE_CACHE_MISS" ); G_NEW__TYPE__CACHE__HIT = GVarName( "NEW_TYPE_CACHE_HIT" ); - G_POS__DATA__TYPE = GVarName( "POS_DATA_TYPE" ); - G_POS__FIRST__FREE__TYPE = GVarName( "POS_FIRST_FREE_TYPE" ); G_NEW__TYPE__NEXT__ID = GVarName( "NEW_TYPE_NEXT_ID" ); G_NEW__TYPE__ID__LIMIT = GVarName( "NEW_TYPE_ID_LIMIT" ); - G_POS__NUMB__TYPE = GVarName( "POS_NUMB_TYPE" ); G_NEW__TYPE = GVarName( "NEW_TYPE" ); G_IsFamily = GVarName( "IsFamily" ); G_NewType3 = GVarName( "NewType3" ); @@ -4370,11 +4325,8 @@ static Int InitKernel ( StructInitInfo * module ) InitFopyGVar( "NewFamily5", &GF_NewFamily5 ); InitCopyGVar( "NEW_TYPE_CACHE_MISS", &GC_NEW__TYPE__CACHE__MISS ); InitCopyGVar( "NEW_TYPE_CACHE_HIT", &GC_NEW__TYPE__CACHE__HIT ); - InitCopyGVar( "POS_DATA_TYPE", &GC_POS__DATA__TYPE ); - InitCopyGVar( "POS_FIRST_FREE_TYPE", &GC_POS__FIRST__FREE__TYPE ); InitCopyGVar( "NEW_TYPE_NEXT_ID", &GC_NEW__TYPE__NEXT__ID ); InitCopyGVar( "NEW_TYPE_ID_LIMIT", &GC_NEW__TYPE__ID__LIMIT ); - InitCopyGVar( "POS_NUMB_TYPE", &GC_POS__NUMB__TYPE ); InitFopyGVar( "NEW_TYPE", &GF_NEW__TYPE ); InitFopyGVar( "IsFamily", &GF_IsFamily ); InitFopyGVar( "NewType3", &GF_NewType3 ); @@ -4503,7 +4455,7 @@ static Int InitLibrary ( StructInitInfo * module ) static StructInitInfo module = { .type = MODULE_STATIC, .name = "GAPROOT/lib/type1.g", - .crc = -95946497, + .crc = 132228056, .initKernel = InitKernel, .initLibrary = InitLibrary, .postRestore = PostRestore, diff --git a/src/objects.c b/src/objects.c index c6b4e00bd62..8463ead5141 100644 --- a/src/objects.c +++ b/src/objects.c @@ -2292,6 +2292,13 @@ static Int InitLibrary ( ExportAsConstantGVar(T_TLREC_INNER); #endif + // export positions of data in type objects + ExportAsConstantGVar(POS_FAMILY_TYPE); + ExportAsConstantGVar(POS_FLAGS_TYPE); + ExportAsConstantGVar(POS_DATA_TYPE); + ExportAsConstantGVar(POS_NUMB_TYPE); + ExportAsConstantGVar(POS_FIRST_FREE_TYPE); + /* return success */ return 0; } diff --git a/src/objects.h b/src/objects.h index 8e775a88209..41f0c124b84 100644 --- a/src/objects.h +++ b/src/objects.h @@ -404,13 +404,30 @@ static inline const Obj *CONST_ADDR_OBJ(Obj obj) } +/**************************************************************************** +** +*S POS_FAMILY_TYPE . . . . . . position where the family of a type is stored +*S POS_FLAGS_TYPE . . . . . . position where the flags of a type are stored +*S POS_DATA_TYPE . . . . . . . . position where the data of a type is stored +*S POS_NUMB_TYPE . . . . . . . position where the number of a type is stored +*S POS_FIRST_FREE_TYPE . . . . . first position that has no overall meaning +*/ +enum { + POS_FAMILY_TYPE = 1, + POS_FLAGS_TYPE = 2, + POS_DATA_TYPE = 3, + POS_NUMB_TYPE = 4, + POS_FIRST_FREE_TYPE = 5, +}; + + /**************************************************************************** ** *F FAMILY_TYPE( ) . . . . . . . . . . . . . . . . . family of a type ** ** 'FAMILY_TYPE' returns the family of the type . */ -#define FAMILY_TYPE(type) ELM_PLIST( type, 1 ) +#define FAMILY_TYPE(type) ELM_PLIST( type, POS_FAMILY_TYPE ) /**************************************************************************** @@ -426,7 +443,7 @@ static inline const Obj *CONST_ADDR_OBJ(Obj obj) ** ** 'FLAGS_TYPE' returns the flags boolean list of the type . */ -#define FLAGS_TYPE(type) ELM_PLIST( type, 2 ) +#define FLAGS_TYPE(type) ELM_PLIST( type, POS_FLAGS_TYPE ) /**************************************************************************** @@ -436,7 +453,7 @@ static inline const Obj *CONST_ADDR_OBJ(Obj obj) ** 'DATA_TYPE' returns the shared data of the type . ** Not used by the GAP kernel right now, but useful for kernel extensions. */ -#define DATA_TYPE(type) ELM_PLIST( type, 3 ) +#define DATA_TYPE(type) ELM_PLIST( type, POS_DATA_TYPE ) /**************************************************************************** @@ -447,8 +464,8 @@ static inline const Obj *CONST_ADDR_OBJ(Obj obj) ** will renumber all IDs. Therefore the corresponding routine must excatly ** know where such numbers are stored. */ -#define ID_TYPE(type) ELM_PLIST(type, 4) -#define SET_ID_TYPE(type, val) SET_ELM_PLIST(type, 4, val) +#define ID_TYPE(type) ELM_PLIST(type, POS_NUMB_TYPE) +#define SET_ID_TYPE(type, val) SET_ELM_PLIST(type, POS_NUMB_TYPE, val) /**************************************************************************** From cad8530f981456c398c89f145f079a5cc32ceb10 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Wed, 25 Apr 2018 20:55:39 +0200 Subject: [PATCH 02/12] kernel: test 'return obj' in break loop --- tst/test-error/error-return.g | 19 +++++++++++ tst/test-error/error-return.g.out | 52 +++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+) create mode 100644 tst/test-error/error-return.g create mode 100644 tst/test-error/error-return.g.out diff --git a/tst/test-error/error-return.g b/tst/test-error/error-return.g new file mode 100644 index 00000000000..90bc0d2df09 --- /dev/null +++ b/tst/test-error/error-return.g @@ -0,0 +1,19 @@ +# test returning a replacement value in response to an error +f:={x}->x;; +f(); +return [42]; +f:={}->1;; +f(1); +return []; +f(1,2); +return []; +f(1,2,3); +return []; +f(1,2,3,4); +return []; +f(1,2,3,4,5); +return []; +f(1,2,3,4,5,6); +return []; +f(1,2,3,4,5,6,7); +return []; diff --git a/tst/test-error/error-return.g.out b/tst/test-error/error-return.g.out new file mode 100644 index 00000000000..f79f0809335 --- /dev/null +++ b/tst/test-error/error-return.g.out @@ -0,0 +1,52 @@ +gap> # test returning a replacement value in response to an error +gap> f:={x}->x;; +gap> f(); +Error, Function: number of arguments must be 1 (not 0) +not in any function at *stdin*:4 +you can replace the argument list via 'return ;' +brk> return [42]; +42 +gap> f:={}->1;; +gap> f(1); +Error, Function: number of arguments must be 0 (not 1) +not in any function at *stdin*:6 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> f(1,2); +Error, Function: number of arguments must be 0 (not 2) +not in any function at *stdin*:7 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> f(1,2,3); +Error, Function: number of arguments must be 0 (not 3) +not in any function at *stdin*:8 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> f(1,2,3,4); +Error, Function: number of arguments must be 0 (not 4) +not in any function at *stdin*:9 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> f(1,2,3,4,5); +Error, Function: number of arguments must be 0 (not 5) +not in any function at *stdin*:10 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> f(1,2,3,4,5,6); +Error, Function: number of arguments must be 0 (not 6) +not in any function at *stdin*:11 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> f(1,2,3,4,5,6,7); +Error, Function: number of arguments must be 0 (not 7) +not in any function at *stdin*:12 +you can replace the argument list via 'return ;' +brk> return []; +1 +gap> QUIT; From 8ffd5199388e961b1eab6e4c11a3ad4b0c49ff55 Mon Sep 17 00:00:00 2001 From: Chris Jefferson Date: Fri, 27 Apr 2018 21:11:52 +0100 Subject: [PATCH 03/12] Add missing InitGlobalBag calls --- src/gap.c | 3 +++ src/intrprtr.c | 2 ++ src/scanner.c | 2 ++ 3 files changed, 7 insertions(+) diff --git a/src/gap.c b/src/gap.c index 7a14e97f404..029bf6b7856 100644 --- a/src/gap.c +++ b/src/gap.c @@ -1597,6 +1597,9 @@ static Int InitKernel ( /* list of exit functions */ InitGlobalBag( &WindowCmdString, "src/gap.c:WindowCmdString" ); + InitGlobalBag( &STATE(ShellContext), "STATE(ShellContext)" ); + InitGlobalBag( &STATE(BaseShellContext), "STATE(BaseShellContext)" ); + /* init filters and functions */ InitHdlrFuncsFromTable( GVarFuncs ); diff --git a/src/intrprtr.c b/src/intrprtr.c index 92b872026d4..dc8b055e55c 100644 --- a/src/intrprtr.c +++ b/src/intrprtr.c @@ -4606,6 +4606,8 @@ static Int InitKernel ( InitGlobalBag( &STATE(IntrResult), "src/intrprtr.c:IntrResult" ); InitGlobalBag( &STATE(IntrState), "src/intrprtr.c:IntrState" ); InitGlobalBag( &STATE(StackObj), "src/intrprtr.c:StackObj" ); + InitGlobalBag( &STATE(ErrorLVars), "STATE(ErrorLVars)" ); + /* Ensure that the value in '~' does not get garbage collected */ InitGlobalBag( &STATE(Tilde), "STATE(Tilde)" ); diff --git a/src/scanner.c b/src/scanner.c index 669ed6ae658..6d1cee07731 100644 --- a/src/scanner.c +++ b/src/scanner.c @@ -1084,6 +1084,8 @@ static Int InitKernel ( StructInitInfo * module ) { InitHdlrFuncsFromTable( GVarFuncs ); + + InitGlobalBag( &STATE(ValueObj), "STATE(ValueObj)"); return 0; } From 557a10b91e5d1e2b9039fafc72b3daf54c972104 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:41:03 +0200 Subject: [PATCH 04/12] Add some more tests for src/calls.c --- tst/testinstall/kernel/calls.tst | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tst/testinstall/kernel/calls.tst b/tst/testinstall/kernel/calls.tst index 9d865de7301..09deba08826 100644 --- a/tst/testinstall/kernel/calls.tst +++ b/tst/testinstall/kernel/calls.tst @@ -44,6 +44,12 @@ Error, Function: number of arguments must be 1 (not 0) gap> f:={x,y,z...}->x;; gap> f(); Error, Function: number of arguments must be at least 2 (not 0) +gap> f:={a1,a2,a3,a4,a5,a6,a7,a8}->a1;; +gap> f(); +Error, Function: number of arguments must be 8 (not 0) +gap> f:={a1,a2,a3,a4,a5,a6,a7,a8,rest...}->a1;; +gap> f(); +Error, Function: number of arguments must be at least 8 (not 0) # test DoProf0args, DoProf1args, ... gap> o:={l...} -> l;; @@ -83,18 +89,30 @@ false # gap> f:=x->x;; +gap> FILENAME_FUNC(fail); +Error, must be a function +gap> FILENAME_FUNC(f); +"stream" +gap> FILENAME_FUNC(IS_OBJECT); +fail gap> STARTLINE_FUNC(fail); Error, must be a function gap> STARTLINE_FUNC(f); 1 +gap> STARTLINE_FUNC(IS_OBJECT); +fail gap> ENDLINE_FUNC(fail); Error, must be a function gap> ENDLINE_FUNC(f); 1 +gap> ENDLINE_FUNC(IS_OBJECT); +fail gap> LOCATION_FUNC(fail); Error, must be a function gap> LOCATION_FUNC(f); fail +gap> LOCATION_FUNC(IS_OBJECT); +fail # gap> UNPROFILE_FUNC(fail); From ca11ea0a2cf683e9f84badfe1cf188f292205a74 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:25 +0200 Subject: [PATCH 05/12] kernel: add code to debug subbag marking in GASMAN If DEBUG_GASMAN_MARKING is #defined, then we increment a counter whenever `MarkBag` is called on something that isn't either zero, or a valid bag ref, or an immediate integer or FFE. By setting a break point on the line incrementing BadMarksCounter, one can quickly find out which bags are affected. --- src/gasman.c | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/src/gasman.c b/src/gasman.c index 3dc4d492e61..ebc6bb87add 100644 --- a/src/gasman.c +++ b/src/gasman.c @@ -660,6 +660,12 @@ void MarkAllSubBagsDefault(Bag bag) MarkArrayOfBags(CONST_PTR_BAG(bag), SIZE_BAG(bag) / sizeof(Bag)); } +#ifdef DEBUG_GASMAN_MARKING +UInt BadMarksCounter = 0; +Int DisableMarkBagValidation = 0; +#endif + + // We define MarkBag as a inline function here so that // the compiler can optimize the marking functions using it in the // "current translation unit", i.e. inside gasman.c. @@ -676,6 +682,13 @@ inline void MarkBag(Bag bag) LINK_BAG(bag) = MarkedBags; MarkedBags = bag; } +#ifdef DEBUG_GASMAN_MARKING + else if (!DisableMarkBagValidation) { + if (bag != 0 && !((UInt)bag & 3) && !IS_BAG_ID(bag)) { + BadMarksCounter++; + } + } +#endif } void MarkBagWeakly(Bag bag) @@ -1755,6 +1768,10 @@ void GenStackFuncBags ( void ) Bag * p; /* loop variable */ UInt i; /* loop variable */ +#ifdef DEBUG_GASMAN_MARKING + DisableMarkBagValidation = 1; +#endif + top = (Bag*)((void*)&top); if ( StackBottomBags < top ) { for ( i = 0; i < sizeof(Bag*); i += StackAlignBags ) { @@ -1775,6 +1792,9 @@ void GenStackFuncBags ( void ) p++ ) MarkBag( *p ); +#ifdef DEBUG_GASMAN_MARKING + DisableMarkBagValidation = 0; +#endif } UInt FullBags; From f2c53b5b213cc5db8477664188ed7992851221e5 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:28 +0200 Subject: [PATCH 06/12] kernel: use custom GC marking for T_FUNCTION Not all slots of a T_FUNCTION bag are filled with bag refs, yet when marking the slots of such a bag during garbage collection, we still used MarkAllSubBags. This is usually no problem with GASMAN, as it detects if a pointer isn't a master pointer, and can then simply ignore it. But other garbage collections can't as easily verify master pointers. So let's try to be accurate about what we mark as a bag and what not: skip the first eight slots of every T_FUNCTION bag for marking (they contain pointers to C functions), and also ensure that the rest of any T_FUNCTION bag only contains bag refs. Also fix a bug in saving/restoring operations, where the 'enabled' field was stored as an UInt, even though it now is an Obj (though we currently only store immediate ints in it, hence there was no functional problem). --- src/calls.c | 29 +++++++++++++++++++++++------ src/calls.h | 12 ++++++------ src/opers.c | 49 ++++++++++++++++++++++++------------------------- 3 files changed, 53 insertions(+), 37 deletions(-) diff --git a/src/calls.c b/src/calls.c index 830f2ba28a3..be94820394e 100644 --- a/src/calls.c +++ b/src/calls.c @@ -957,6 +957,7 @@ Obj NewFunctionT ( SET_NAME_FUNC(func, ConvImmString(name)); SET_NARG_FUNC(func, narg); SET_NAMS_FUNC(func, nams); + SET_NLOC_FUNC(func, 0); if (nams) MakeBagPublic(nams); CHANGED_BAG(func); @@ -1547,6 +1548,7 @@ Obj FuncPROFILE_FUNC( SET_NARG_FUNC(copy, NARG_FUNC(func)); SET_NAMS_FUNC(copy, NAMS_FUNC(func)); SET_PROF_FUNC(copy, PROF_FUNC(func)); + SET_NLOC_FUNC(copy, NLOC_FUNC(func)); SET_HDLR_FUNC(func,0, DoProf0args); SET_HDLR_FUNC(func,1, DoProf1args); SET_HDLR_FUNC(func,2, DoProf2args); @@ -1730,14 +1732,14 @@ static ObjFunc LoadHandler( void ) */ void SaveFunction ( Obj func ) { - FuncBag * header = FUNC(func); + const FuncBag * header = CONST_FUNC(func); for (UInt i = 0; i <= 7; i++) SaveHandler(header->handlers[i]); SaveSubObj(header->name); - SaveUInt(header->nargs); + SaveSubObj(header->nargs); SaveSubObj(header->namesOfLocals); SaveSubObj(header->prof); - SaveUInt(header->nloc); + SaveSubObj(header->nloc); SaveSubObj(header->body); SaveSubObj(header->envi); SaveSubObj(header->fexs); @@ -1756,10 +1758,10 @@ void LoadFunction ( Obj func ) for (UInt i = 0; i <= 7; i++) header->handlers[i] = LoadHandler(); header->name = LoadSubObj(); - header->nargs = LoadUInt(); + header->nargs = LoadSubObj(); header->namesOfLocals = LoadSubObj(); header->prof = LoadSubObj(); - header->nloc = LoadUInt(); + header->nloc = LoadSubObj(); header->body = LoadSubObj(); header->envi = LoadSubObj(); header->fexs = LoadSubObj(); @@ -1769,6 +1771,21 @@ void LoadFunction ( Obj func ) #endif +/**************************************************************************** +** +*F MarkFunctionSubBags( ) . . . . . . . marking function for functions +** +** 'MarkFunctionSubBags' is the marking function for bags of type 'T_FUNCTION'. +*/ +void MarkFunctionSubBags(Obj func) +{ + // the first eight slots are pointers to C functions, so we need + // to skip those for marking + UInt size = SIZE_BAG(func) / sizeof(Obj) - 8; + const Bag * data = CONST_PTR_BAG(func) + 8; + MarkArrayOfBags(data, size); +} + /**************************************************************************** ** @@ -1836,7 +1853,7 @@ static Int InitKernel ( /* install the marking functions */ InfoBags[ T_FUNCTION ].name = "function"; - InitMarkFuncBags( T_FUNCTION , MarkAllSubBags ); + InitMarkFuncBags(T_FUNCTION, MarkFunctionSubBags); /* Allocate functions in the public region */ MakeBagTypePublic(T_FUNCTION); diff --git a/src/calls.h b/src/calls.h index 593f0488773..1b44eeed2dd 100644 --- a/src/calls.h +++ b/src/calls.h @@ -107,10 +107,10 @@ typedef Obj (* ObjFunc_6ARGS) (Obj self, Obj a1, Obj a2, Obj a3, Obj a4, Obj a5, typedef struct { ObjFunc handlers[8]; Obj name; - Int nargs; + Obj nargs; Obj namesOfLocals; Obj prof; - UInt nloc; + Obj nloc; Obj body; Obj envi; Obj fexs; @@ -146,7 +146,7 @@ static inline Obj NAME_FUNC(Obj func) static inline Int NARG_FUNC(Obj func) { - return CONST_FUNC(func)->nargs; + return INT_INTOBJ(CONST_FUNC(func)->nargs); } static inline Obj NAMS_FUNC(Obj func) @@ -163,7 +163,7 @@ static inline Obj PROF_FUNC(Obj func) static inline UInt NLOC_FUNC(Obj func) { - return CONST_FUNC(func)->nloc; + return INT_INTOBJ(CONST_FUNC(func)->nloc); } static inline Obj BODY_FUNC(Obj func) @@ -199,7 +199,7 @@ extern void SET_NAME_FUNC(Obj func, Obj name); static inline void SET_NARG_FUNC(Obj func, Int nargs) { - FUNC(func)->nargs = nargs; + FUNC(func)->nargs = INTOBJ_INT(nargs); } static inline void SET_NAMS_FUNC(Obj func, Obj namesOfLocals) @@ -214,7 +214,7 @@ static inline void SET_PROF_FUNC(Obj func, Obj prof) static inline void SET_NLOC_FUNC(Obj func, UInt nloc) { - FUNC(func)->nloc = nloc; + FUNC(func)->nloc = INTOBJ_INT(nloc); } static inline void SET_BODY_FUNC(Obj func, Obj body) diff --git a/src/opers.c b/src/opers.c index 9470c70d64e..e9acf8429fc 100644 --- a/src/opers.c +++ b/src/opers.c @@ -3313,22 +3313,22 @@ void InstallGlobalFunction ( void SaveOperationExtras ( Obj oper ) { - UInt i; - - SaveSubObj(FLAG1_FILT(oper)); - SaveSubObj(FLAG2_FILT(oper)); - SaveSubObj(FLAGS_FILT(oper)); - SaveSubObj(SETTR_FILT(oper)); - SaveSubObj(TESTR_FILT(oper)); - SaveUInt(ENABLED_ATTR(oper)); - for (i = 0; i <= 7; i++) - SaveSubObj(METHS_OPER(oper,i)); + const OperBag * header = CONST_OPER(oper); + + SaveSubObj(header->flag1); + SaveSubObj(header->flag2); + SaveSubObj(header->flags); + SaveSubObj(header->setter); + SaveSubObj(header->tester); + SaveSubObj(header->enabled); + for (UInt i = 0; i <= 7; i++) + SaveSubObj(header->methods[i]); #ifdef HPCGAP // FIXME: We probably don't want to save/restore the cache? // (and that would include "normal" GAP, too...) #else - for (i = 0; i <= 7; i++) - SaveSubObj(CACHE_OPER(oper,i)); + for (UInt i = 0; i <= 7; i++) + SaveSubObj(header->cache[i]); #endif } @@ -3344,23 +3344,22 @@ void SaveOperationExtras ( void LoadOperationExtras ( Obj oper ) { - UInt i; - - SET_FLAG1_FILT(oper, LoadSubObj()); - SET_FLAG2_FILT(oper, LoadSubObj()); - SET_FLAGS_FILT(oper, LoadSubObj()); - SET_SETTR_FILT(oper, LoadSubObj()); - SET_TESTR_FILT(oper, LoadSubObj()); - i = LoadUInt(); - SET_ENABLED_ATTR(oper,i); - for (i = 0; i <= 7; i++) - SET_METHS_OPER(oper, i, LoadSubObj()); + OperBag * header = OPER(oper); + + header->flag1 = LoadSubObj(); + header->flag2 = LoadSubObj(); + header->flags = LoadSubObj(); + header->setter = LoadSubObj(); + header->tester = LoadSubObj(); + header->enabled = LoadSubObj(); + for (UInt i = 0; i <= 7; i++) + header->methods[i] = LoadSubObj(); #ifdef HPCGAP // FIXME: We probably don't want to save/restore the cache? // (and that would include "normal" GAP, too...) #else - for (i = 0; i <= 7; i++) - SET_CACHE_OPER(oper, i, LoadSubObj()); + for (UInt i = 0; i <= 7; i++) + header->cache[i] = LoadSubObj(); #endif } From a57f557a44ad527581cdf8b6156b398780965862 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:30 +0200 Subject: [PATCH 07/12] kernel: unify implementation of MarkNNNSubBags They now all call MarkArrayOfBags, but thanks to inlining, this produces identical machine code. --- src/gasman.c | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/src/gasman.c b/src/gasman.c index ebc6bb87add..abe09cb1ec2 100644 --- a/src/gasman.c +++ b/src/gasman.c @@ -613,41 +613,35 @@ static inline Bag UNMARKED_HALFDEAD(Bag x) } +inline void MarkArrayOfBags(const Bag array[], UInt count) +{ + for (UInt i = 0; i < count; i++) { + MarkBag(array[i]); + } +} + void MarkNoSubBags(Bag bag) { } void MarkOneSubBags(Bag bag) { - MarkBag(CONST_PTR_BAG(bag)[0]); + MarkArrayOfBags(CONST_PTR_BAG(bag), 1); } void MarkTwoSubBags(Bag bag) { - MarkBag(CONST_PTR_BAG(bag)[0]); - MarkBag(CONST_PTR_BAG(bag)[1]); + MarkArrayOfBags(CONST_PTR_BAG(bag), 2); } void MarkThreeSubBags(Bag bag) { - MarkBag(CONST_PTR_BAG(bag)[0]); - MarkBag(CONST_PTR_BAG(bag)[1]); - MarkBag(CONST_PTR_BAG(bag)[2]); + MarkArrayOfBags(CONST_PTR_BAG(bag), 3); } void MarkFourSubBags(Bag bag) { - MarkBag(CONST_PTR_BAG(bag)[0]); - MarkBag(CONST_PTR_BAG(bag)[1]); - MarkBag(CONST_PTR_BAG(bag)[2]); - MarkBag(CONST_PTR_BAG(bag)[3]); -} - -inline void MarkArrayOfBags(const Bag array[], UInt count) -{ - for (UInt i = 0; i < count; i++) { - MarkBag(array[i]); - } + MarkArrayOfBags(CONST_PTR_BAG(bag), 4); } void MarkAllSubBags(Bag bag) From 7b9dfe1b9bc70ab82ea5a28af84b4d4a4b3df9a9 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:31 +0200 Subject: [PATCH 08/12] kernel: refactor StatStack/ExprStack code --- src/code.c | 57 +++++++++++++++++++++++++++++------------------------- 1 file changed, 31 insertions(+), 26 deletions(-) diff --git a/src/code.c b/src/code.c index 0b04352fc2f..ea77bdac6f2 100644 --- a/src/code.c +++ b/src/code.c @@ -294,9 +294,10 @@ Expr NewExpr ( ** 'PopStat' returns the top statement from the statements stack and pops ** it. It is an error if the stack is empty. */ -/* TL: Bag StackStat; */ - -/* TL: Int CountStat; */ +static inline UInt CapacityStatStack(void) +{ + return SIZE_BAG(STATE(StackStat))/sizeof(Stat); +} static void PushStat ( Stat stat ) @@ -304,14 +305,17 @@ static void PushStat ( /* there must be a stack, it must not be underfull or overfull */ assert( STATE(StackStat) != 0 ); assert( 0 <= STATE(CountStat) ); - assert( STATE(CountStat) <= SIZE_BAG(STATE(StackStat))/sizeof(Stat) ); + assert( STATE(CountStat) <= CapacityStatStack() ); assert( stat != 0 ); - /* count up and put the statement onto the stack */ - if ( STATE(CountStat) == SIZE_BAG(STATE(StackStat))/sizeof(Stat) ) { + // count up and put the statement onto the stack + if ( STATE(CountStat) == CapacityStatStack() ) { ResizeBag( STATE(StackStat), 2*STATE(CountStat)*sizeof(Stat) ); } - ((Stat*)PTR_BAG(STATE(StackStat)))[STATE(CountStat)] = stat; + + // put + Stat * data = (Stat *)PTR_BAG(STATE(StackStat)); + data[STATE(CountStat)] = stat; STATE(CountStat)++; } @@ -322,11 +326,12 @@ static Stat PopStat ( void ) /* there must be a stack, it must not be underfull/empty or overfull */ assert( STATE(StackStat) != 0 ); assert( 1 <= STATE(CountStat) ); - assert( STATE(CountStat) <= SIZE_BAG(STATE(StackStat))/sizeof(Stat) ); + assert( STATE(CountStat) <= CapacityStatStack() ); /* get the top statement from the stack, and count down */ STATE(CountStat)--; - stat = ((Stat*)PTR_BAG(STATE(StackStat)))[STATE(CountStat)]; + Stat * data = (Stat *)PTR_BAG(STATE(StackStat)); + stat = data[STATE(CountStat)]; /* return the popped statement */ return stat; @@ -415,39 +420,42 @@ static inline Stat PopLoopStat(UInt baseType, UInt extra, UInt nr) ** 'PopExpr' returns the top expressions from the expressions stack and pops ** it. It is an error if the stack is empty. */ -/* TL: Bag StackExpr; */ - -/* TL: Int CountExpr; */ +static inline UInt CapacityStackExpr(void) +{ + return SIZE_BAG(STATE(StackExpr))/sizeof(Expr); +} -void PushExpr ( - Expr expr ) +static void PushExpr(Expr expr) { /* there must be a stack, it must not be underfull or overfull */ assert( STATE(StackExpr) != 0 ); assert( 0 <= STATE(CountExpr) ); - assert( STATE(CountExpr) <= SIZE_BAG(STATE(StackExpr))/sizeof(Expr) ); + assert( STATE(CountExpr) <= CapacityStackExpr() ); assert( expr != 0 ); /* count up and put the expression onto the stack */ - if ( STATE(CountExpr) == SIZE_BAG(STATE(StackExpr))/sizeof(Expr) ) { + if ( STATE(CountExpr) == CapacityStackExpr() ) { ResizeBag( STATE(StackExpr), 2*STATE(CountExpr)*sizeof(Expr) ); } - ((Expr*)PTR_BAG(STATE(StackExpr)))[STATE(CountExpr)] = expr; + + Expr * data = (Expr *)PTR_BAG(STATE(StackExpr)); + data[STATE(CountExpr)] = expr; STATE(CountExpr)++; } -Expr PopExpr ( void ) +static Expr PopExpr(void) { Expr expr; /* there must be a stack, it must not be underfull/empty or overfull */ assert( STATE(StackExpr) != 0 ); assert( 1 <= STATE(CountExpr) ); - assert( STATE(CountExpr) <= SIZE_BAG(STATE(StackExpr))/sizeof(Expr) ); + assert( STATE(CountExpr) <= CapacityStackExpr() ); /* get the top expression from the stack, and count down */ STATE(CountExpr)--; - expr = ((Expr*)PTR_BAG(STATE(StackExpr)))[STATE(CountExpr)]; + Expr * data = (Expr *)PTR_BAG(STATE(StackExpr)); + expr = data[STATE(CountExpr)]; /* return the popped expression */ return expr; @@ -3401,8 +3409,6 @@ static Int PostRestore ( static Int PreSave ( StructInitInfo * module ) { - UInt i; - /* Can't save in mid-parsing */ if (STATE(CountExpr) || STATE(CountStat)) return 1; @@ -3411,10 +3417,9 @@ static Int PreSave ( AssGVar(GVarName("SavedFloatIndex"), INTOBJ_INT(NextFloatExprNumber)); /* clean any old data out of the statement and expression stacks */ - for (i = 0; i < SIZE_BAG(STATE(StackStat))/sizeof(UInt); i++) - ADDR_OBJ(STATE(StackStat))[i] = (Obj)0; - for (i = 0; i < SIZE_BAG(STATE(StackExpr))/sizeof(UInt); i++) - ADDR_OBJ(STATE(StackExpr))[i] = (Obj)0; + memset(ADDR_OBJ(STATE(StackStat)), 0, SIZE_BAG(STATE(StackStat))); + memset(ADDR_OBJ(STATE(StackExpr)), 0, SIZE_BAG(STATE(StackExpr))); + /* return success */ return 0; } From 31698fb9b1a8003da809c4d9a2e281aced9a336c Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:32 +0200 Subject: [PATCH 09/12] kernel: use T_DATOBJ for StackStat and StackExpr ... instead of a T_BODY, as we don't really create a T_BODY here. (and this can lead to confusion in GC marking) --- src/code.c | 37 +++++++++++++++++++++++-------------- 1 file changed, 23 insertions(+), 14 deletions(-) diff --git a/src/code.c b/src/code.c index ea77bdac6f2..ddc4cd8fe36 100644 --- a/src/code.c +++ b/src/code.c @@ -43,6 +43,10 @@ GAP_STATIC_ASSERT(sizeof(StatHeader) == 8, "StatHeader has wrong size"); + +static Obj TYPE_KERNEL_OBJECT; + + /**************************************************************************** ** *V PtrBody . . . . . . . . . . . . . . . . . . . . . pointer to current body @@ -296,7 +300,7 @@ Expr NewExpr ( */ static inline UInt CapacityStatStack(void) { - return SIZE_BAG(STATE(StackStat))/sizeof(Stat); + return SIZE_BAG(STATE(StackStat))/sizeof(Stat) - 1; } static void PushStat ( @@ -310,11 +314,11 @@ static void PushStat ( // count up and put the statement onto the stack if ( STATE(CountStat) == CapacityStatStack() ) { - ResizeBag( STATE(StackStat), 2*STATE(CountStat)*sizeof(Stat) ); + ResizeBag( STATE(StackStat), (2*STATE(CountStat) + 1)*sizeof(Stat) ); } // put - Stat * data = (Stat *)PTR_BAG(STATE(StackStat)); + Stat * data = (Stat *)PTR_BAG(STATE(StackStat)) + 1; data[STATE(CountStat)] = stat; STATE(CountStat)++; } @@ -330,7 +334,7 @@ static Stat PopStat ( void ) /* get the top statement from the stack, and count down */ STATE(CountStat)--; - Stat * data = (Stat *)PTR_BAG(STATE(StackStat)); + Stat * data = (Stat *)PTR_BAG(STATE(StackStat)) + 1; stat = data[STATE(CountStat)]; /* return the popped statement */ @@ -422,7 +426,7 @@ static inline Stat PopLoopStat(UInt baseType, UInt extra, UInt nr) */ static inline UInt CapacityStackExpr(void) { - return SIZE_BAG(STATE(StackExpr))/sizeof(Expr); + return SIZE_BAG(STATE(StackExpr))/sizeof(Expr) - 1; } static void PushExpr(Expr expr) @@ -435,10 +439,10 @@ static void PushExpr(Expr expr) /* count up and put the expression onto the stack */ if ( STATE(CountExpr) == CapacityStackExpr() ) { - ResizeBag( STATE(StackExpr), 2*STATE(CountExpr)*sizeof(Expr) ); + ResizeBag( STATE(StackExpr), (2*STATE(CountExpr) + 1)*sizeof(Expr) ); } - Expr * data = (Expr *)PTR_BAG(STATE(StackExpr)); + Expr * data = (Expr *)PTR_BAG(STATE(StackExpr)) + 1; data[STATE(CountExpr)] = expr; STATE(CountExpr)++; } @@ -454,7 +458,7 @@ static Expr PopExpr(void) /* get the top expression from the stack, and count down */ STATE(CountExpr)--; - Expr * data = (Expr *)PTR_BAG(STATE(StackExpr)); + Expr * data = (Expr *)PTR_BAG(STATE(StackExpr)) + 1; expr = data[STATE(CountExpr)]; /* return the popped expression */ @@ -3355,6 +3359,8 @@ static Int InitKernel ( InitHdlrFuncsFromTable( GVarFuncs ); + ImportGVarFromLibrary( "TYPE_KERNEL_OBJECT", &TYPE_KERNEL_OBJECT ); + /* return success */ return 0; } @@ -3416,9 +3422,10 @@ static Int PreSave ( /* push the FP cache index out into a GAP Variable */ AssGVar(GVarName("SavedFloatIndex"), INTOBJ_INT(NextFloatExprNumber)); - /* clean any old data out of the statement and expression stacks */ - memset(ADDR_OBJ(STATE(StackStat)), 0, SIZE_BAG(STATE(StackStat))); - memset(ADDR_OBJ(STATE(StackExpr)), 0, SIZE_BAG(STATE(StackExpr))); + // clean any old data out of the statement and expression stacks, + // but leave the type field alone + memset(ADDR_OBJ(STATE(StackStat)) + 1, 0, SIZE_BAG(STATE(StackStat)) - sizeof(Obj)); + memset(ADDR_OBJ(STATE(StackExpr)) + 1, 0, SIZE_BAG(STATE(StackExpr)) - sizeof(Obj)); /* return success */ return 0; @@ -3430,9 +3437,11 @@ static void InitModuleState(ModuleStateOffset offset) STATE(LoopNesting) = 0; STATE(LoopStackCount) = 0; - /* allocate the statements and expressions stacks */ - STATE(StackStat) = NewBag( T_BODY, 64*sizeof(Stat) ); - STATE(StackExpr) = NewBag( T_BODY, 64*sizeof(Expr) ); + // allocate the statements and expressions stacks + STATE(StackStat) = NewBag(T_DATOBJ, sizeof(Obj) + 64*sizeof(Stat)); + STATE(StackExpr) = NewBag(T_DATOBJ, sizeof(Obj) + 64*sizeof(Expr)); + SET_TYPE_DATOBJ(STATE(StackStat), TYPE_KERNEL_OBJECT); + SET_TYPE_DATOBJ(STATE(StackExpr), TYPE_KERNEL_OBJECT); #ifdef HPCGAP STATE(OffsBodyStack) = AllocateMemoryBlock(MAX_FUNC_EXPR_NESTING*sizeof(Stat)); From 0591d21d3773236b1744381c3b4e72109c4f7091 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:34 +0200 Subject: [PATCH 10/12] kernel: fix GC marking of plists --- src/boehm_gc.c | 4 ++++ src/gasman.c | 5 +++++ src/gasman.h | 2 ++ src/plist.c | 4 ++-- 4 files changed, 13 insertions(+), 2 deletions(-) diff --git a/src/boehm_gc.c b/src/boehm_gc.c index 0b651cef81b..aedbbc9d206 100644 --- a/src/boehm_gc.c +++ b/src/boehm_gc.c @@ -625,6 +625,10 @@ void MarkAllSubBags(Bag bag) { } +void MarkAllButFirstSubBags(Bag bag) +{ +} + void MarkArrayOfBags(const Bag array[], UInt count) { } diff --git a/src/gasman.c b/src/gasman.c index abe09cb1ec2..ea9460b5180 100644 --- a/src/gasman.c +++ b/src/gasman.c @@ -649,6 +649,11 @@ void MarkAllSubBags(Bag bag) MarkArrayOfBags(CONST_PTR_BAG(bag), SIZE_BAG(bag) / sizeof(Bag)); } +void MarkAllButFirstSubBags(Bag bag) +{ + MarkArrayOfBags(CONST_PTR_BAG(bag) + 1, SIZE_BAG(bag) / sizeof(Bag) - 1); +} + void MarkAllSubBagsDefault(Bag bag) { MarkArrayOfBags(CONST_PTR_BAG(bag), SIZE_BAG(bag) / sizeof(Bag)); diff --git a/src/gasman.h b/src/gasman.h index 712f83be02c..1eb8a69773c 100644 --- a/src/gasman.h +++ b/src/gasman.h @@ -806,6 +806,8 @@ extern void MarkAllSubBags( Bag bag ); extern void MarkAllSubBagsDefault ( Bag ); +extern void MarkAllButFirstSubBags( Bag bag ); + /**************************************************************************** ** *F MarkBag() . . . . . . . . . . . . . . . . . . . mark a bag as live diff --git a/src/plist.c b/src/plist.c index 97df1b8eec0..abc894cfcb9 100644 --- a/src/plist.c +++ b/src/plist.c @@ -3644,8 +3644,8 @@ static Int InitKernel ( InitBagNamesFromTable( BagNames ); for ( t1 = T_PLIST; t1 < T_PLIST_FFE ; t1 += 2 ) { - InitMarkFuncBags( t1 , MarkAllSubBags ); - InitMarkFuncBags( t1 +IMMUTABLE , MarkAllSubBags ); + InitMarkFuncBags( t1 , MarkAllButFirstSubBags ); + InitMarkFuncBags( t1 +IMMUTABLE , MarkAllButFirstSubBags ); #if !defined(USE_THREADSAFE_COPYING) InitMarkFuncBags( t1 +COPYING , MarkAllSubBags ); InitMarkFuncBags( t1 +IMMUTABLE +COPYING , MarkAllSubBags ); From 4489660aa2efc909cc134f66a58609592a33ab87 Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:35 +0200 Subject: [PATCH 11/12] kernel: fix marking of precords and component objects --- src/objects.c | 4 ++-- src/precord.c | 31 +++++++++++++++++++++++++++---- src/precord.h | 4 ++++ 3 files changed, 33 insertions(+), 6 deletions(-) diff --git a/src/objects.c b/src/objects.c index 8463ead5141..5a5076a0d38 100644 --- a/src/objects.c +++ b/src/objects.c @@ -2009,14 +2009,14 @@ static Int InitKernel ( /* install the marking methods */ InfoBags[ T_COMOBJ ].name = "object (component)"; - InitMarkFuncBags( T_COMOBJ , MarkAllSubBags ); + InitMarkFuncBags( T_COMOBJ , MarkPRecSubBags ); InfoBags[ T_POSOBJ ].name = "object (positional)"; InitMarkFuncBags( T_POSOBJ , MarkAllSubBags ); InfoBags[ T_DATOBJ ].name = "object (data)"; InitMarkFuncBags( T_DATOBJ , MarkOneSubBags ); #if !defined(USE_THREADSAFE_COPYING) InfoBags[ T_COMOBJ +COPYING ].name = "object (component,copied)"; - InitMarkFuncBags( T_COMOBJ +COPYING , MarkAllSubBags ); + InitMarkFuncBags( T_COMOBJ +COPYING , MarkPRecSubBags ); InfoBags[ T_POSOBJ +COPYING ].name = "object (positional,copied)"; InitMarkFuncBags( T_POSOBJ +COPYING , MarkAllSubBags ); InfoBags[ T_DATOBJ +COPYING ].name = "object (data,copied)"; diff --git a/src/precord.c b/src/precord.c index c10c42ce247..ee3558a57e9 100644 --- a/src/precord.c +++ b/src/precord.c @@ -821,6 +821,29 @@ void LoadPRec( Obj prec ) } } +/**************************************************************************** +** +*F MarkPRecSubBags( ) . . . . marking function for precs and com. objs +** +** 'MarkPRecSubBags' is the marking function for bags of type 'T_PREC' or +** 'T_COMOBJ'. +*/ +void MarkPRecSubBags(Obj bag) +{ + const Bag * data = CONST_PTR_BAG(bag); + const UInt count = SIZE_BAG(bag) / sizeof(Bag); + + // while data[0] is unused for regular precords, it used during copying + // to store a pointer to the copy; moreover, this mark function is also + // used for component objects, which store their type in slot 0 + MarkBag(data[0]); + + for (UInt i = 3; i < count; i += 2) { + MarkBag(data[i]); + } +} + + /**************************************************************************** ** *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * * @@ -864,11 +887,11 @@ static Int InitKernel ( /* GASMAN marking functions and GASMAN names */ InitBagNamesFromTable( BagNames ); - InitMarkFuncBags( T_PREC , MarkAllSubBags ); - InitMarkFuncBags( T_PREC +IMMUTABLE , MarkAllSubBags ); + InitMarkFuncBags( T_PREC , MarkPRecSubBags ); + InitMarkFuncBags( T_PREC +IMMUTABLE , MarkPRecSubBags ); #if !defined(USE_THREADSAFE_COPYING) - InitMarkFuncBags( T_PREC +COPYING , MarkAllSubBags ); - InitMarkFuncBags( T_PREC +IMMUTABLE +COPYING , MarkAllSubBags ); + InitMarkFuncBags( T_PREC +COPYING , MarkPRecSubBags ); + InitMarkFuncBags( T_PREC +IMMUTABLE +COPYING , MarkPRecSubBags ); #endif /* Immutable records are public */ diff --git a/src/precord.h b/src/precord.h index e753f5c376d..f2d23e97695 100644 --- a/src/precord.h +++ b/src/precord.h @@ -260,6 +260,10 @@ extern void CopyPRecord(Obj copy, Obj original); #endif + +extern void MarkPRecSubBags(Obj bag); + + /**************************************************************************** ** *F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * * From d0693f8252d95322720f1fad53c249565119dfeb Mon Sep 17 00:00:00 2001 From: Max Horn Date: Fri, 27 Apr 2018 00:59:37 +0200 Subject: [PATCH 12/12] kernel: fix marking of LVars/HVars --- src/vars.c | 62 ++++++++++++++++++++++++++++++++++++++---------------- src/vars.h | 2 +- 2 files changed, 45 insertions(+), 19 deletions(-) diff --git a/src/vars.c b/src/vars.c index b45e1886e98..c028fd911f5 100644 --- a/src/vars.c +++ b/src/vars.c @@ -102,25 +102,51 @@ Obj ObjLVar ( return val; } -Bag NewLVarsBag(UInt slots) { - Bag result; - if (slots < ARRAY_SIZE(STATE(LVarsPool))) { - result = STATE(LVarsPool)[slots]; - if (result) { - STATE(LVarsPool)[slots] = CONST_ADDR_OBJ(result)[0]; - return result; + +/**************************************************************************** +** +*F NewLVarsBag() . . . . . . . . . . . . . . allocate a new LVars bag +** +** 'NewLVarsBag' allocates a new 'T_LVAR' bag, with the given number of +** local variable . It tries to satisfy the request from a pool of +** available LVars with up to 16 slots. If the request cannot be satisfied +** from a pool, a new bag is allocated instead. +** +** The pools are stored as single linked lists, for which 'PARENT_LVARS' +** is abused. +*/ +Bag NewLVarsBag(UInt slots) +{ + Bag result; + if (slots < ARRAY_SIZE(STATE(LVarsPool))) { + result = STATE(LVarsPool)[slots]; + if (result) { + STATE(LVarsPool)[slots] = PARENT_LVARS(result); + return result; + } } - } - return NewBag(T_LVARS, sizeof(Obj) * ( 3 + slots ) ); + return NewBag(T_LVARS, sizeof(LVarsHeader) + sizeof(Obj) * slots); } -void FreeLVarsBag(Bag bag) { - UInt slots = SIZE_BAG(bag) / sizeof(Obj) - 3; - if (slots < ARRAY_SIZE(STATE(LVarsPool))) { - memset(PTR_BAG(bag), 0, SIZE_BAG(bag)); - ADDR_OBJ(bag)[0] = STATE(LVarsPool)[slots]; - STATE(LVarsPool)[slots] = bag; - } + +/**************************************************************************** +** +*F FreeLVarsBag() . . . . . . . . . . . . . . . . . free an LVars bag +** +** 'FreeLVarsBag' returns an unused 'T_LVAR' bag to one of the 'LVarsPool', +** assuming its size (resp. number of local variable slots) is not too big. +*/ +void FreeLVarsBag(Bag bag) +{ + GAP_ASSERT(TNUM_OBJ(STATE(CurrLVars)) == T_LVARS); + UInt slots = (SIZE_BAG(bag) - sizeof(LVarsHeader)) / sizeof(Obj); + if (slots < ARRAY_SIZE(STATE(LVarsPool))) { + // clean the bag + memset(PTR_BAG(bag), 0, SIZE_BAG(bag)); + // put it into the linked list of available LVars bags + PARENT_LVARS(bag) = STATE(LVarsPool)[slots]; + STATE(LVarsPool)[slots] = bag; + } } @@ -2590,9 +2616,9 @@ static Int InitKernel ( /* install the marking functions for local variables bag */ InfoBags[ T_LVARS ].name = "values bag"; - InitMarkFuncBags( T_LVARS, MarkAllSubBags ); + InitMarkFuncBags( T_LVARS, MarkAllButFirstSubBags ); InfoBags[ T_HVARS ].name = "high variables bag"; - InitMarkFuncBags( T_HVARS, MarkAllSubBags ); + InitMarkFuncBags( T_HVARS, MarkAllButFirstSubBags ); #ifdef HPCGAP /* Make T_LVARS bags public */ diff --git a/src/vars.h b/src/vars.h index 5067e3eada9..1d79b784e30 100644 --- a/src/vars.h +++ b/src/vars.h @@ -77,8 +77,8 @@ static inline int IS_LVARS_OR_HVARS(Obj obj) typedef struct { - Obj func; Expr stat; + Obj func; Obj parent; } LVarsHeader;