static Int InitModuleState(void) { InitGlobalBag( &CFTLState()->WORD_STACK, "WORD_STACK" ); InitGlobalBag( &CFTLState()->WORD_EXPONENT_STACK, "WORD_EXPONENT_STACK" ); InitGlobalBag( &CFTLState()->SYLLABLE_STACK, "SYLLABLE_STACK" ); InitGlobalBag( &CFTLState()->EXPONENT_STACK, "EXPONENT_STACK" ); CFTLState()->WORD_STACK = NEW_PLIST( T_PLIST, 4096 ); CFTLState()->WORD_EXPONENT_STACK = NEW_PLIST( T_PLIST, 4096 ); CFTLState()->SYLLABLE_STACK = NEW_PLIST( T_PLIST, 4096 ); CFTLState()->EXPONENT_STACK = NEW_PLIST( T_PLIST, 4096 ); // return success return 0; }
/* handler for function 2 */ static Obj HdlrFunc2 ( Obj self ) { Obj t_1 = 0; Bag oldFrame; OLD_BRK_CURR_STAT /* allocate new stack frame */ SWITCH_TO_NEW_FRAME(self,0,0,oldFrame); REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); /* WITH_IMPS_FLAGS_CACHE := [ ]; */ t_1 = NEW_PLIST( T_PLIST, 0 ); SET_LEN_PLIST( t_1, 0 ); AssGVar( G_WITH__IMPS__FLAGS__CACHE, t_1 ); /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
static void InitNativeStringSerializer(Obj string) { TLS(SerializationStack) = NEW_PLIST(T_PLIST, 0); TLS(SerializationRegistry) = NewObjMap(); TLS(SerializationDispatcher) = &NativeStringSerializer; TLS(SerializationObj) = string; TLS(SerializationIndex) = 0; }
/**************************************************************************** ** *F FuncLIST_SORTED_LIST( <self>, <list> ) . . . . . make a set from a list ** ** 'FuncLIST_SORTED_LIST' implements the internal function 'SetList'. ** ** 'SetList( <list> )' ** ** 'SetList' returns a new proper set, which is represented as a sorted list ** without holes or duplicates, containing the elements of the list <list>. ** ** 'SetList' returns a new list even if the list <list> is already a proper ** set, in this case it is equivalent to 'ShallowCopy' (see "ShallowCopy"). */ Obj FuncLIST_SORTED_LIST ( Obj self, Obj list ) { Obj set; /* result */ /* check the argument */ while ( ! IS_SMALL_LIST( list ) ) { list = ErrorReturnObj( "Set: <list> must be a small list (not a %s)", (Int)TNAM_OBJ(list), 0L, "you can replace <list> via 'return <list>;'" ); } /* if the list is empty create a new empty list */ if ( LEN_LIST(list) == 0 ) { set = NEW_PLIST( T_PLIST_EMPTY, 0 ); } /* if <list> is a set just shallow copy it */ else if ( /* IS_HOMOG_LIST(list) && */ IS_SSORT_LIST(list) ) { set = SHALLOW_COPY_OBJ( list ); } /* otherwise let 'SetList' do the work */ else { set = SetList( list ); } /* return the set */ return set; }
static void InitNativeStringDeserializer(Obj string) { MODULE_STATE(Serialize).stack = NEW_PLIST(T_PLIST, 0); MODULE_STATE(Serialize).dispatcher = &NativeStringDeserializer; MODULE_STATE(Serialize).obj = string; MODULE_STATE(Serialize).index = 0; }
Obj FuncFREXP_MACFLOAT( Obj self, Obj f) { int i; Obj d = NEW_MACFLOAT(frexp (VAL_MACFLOAT(f), &i)); Obj l = NEW_PLIST(T_PLIST,2); SET_ELM_PLIST(l,1,d); SET_ELM_PLIST(l,2,INTOBJ_INT(i)); SET_LEN_PLIST(l,2); return l; }
/**************************************************************************** ** *F InitLibrary( <module> ) . . . . . . . initialise library data structures */ static Int InitLibrary ( StructInitInfo * module ) { /* make the list of names of record names */ CountRNam = 0; NamesRNam = NEW_PLIST( T_PLIST, 0 ); SET_LEN_PLIST( NamesRNam, 0 ); /* make the hash list of record names */ SizeRNam = 997; HashRNam = NEW_PLIST( T_PLIST, SizeRNam ); SET_LEN_PLIST( HashRNam, SizeRNam ); /* init filters and functions */ InitGVarFiltsFromTable( GVarFilts ); InitGVarOpersFromTable( GVarOpers ); InitGVarFuncsFromTable( GVarFuncs ); /* return success */ return 0; }
/**************************************************************************** ** *F SetList( <list> ) . . . . . . . . . . . . . . . . make a set from a list ** ** 'SetList' returns a new set that contains the elements of <list>. Note ** that 'SetList' returns a new plain list even if <list> was already a set. ** ** 'SetList' makes a copy of the list <list>, removes the holes, sorts the ** copy and finally removes duplicates, which must appear next to each other ** now that the copy is sorted. */ Obj SetList ( Obj list ) { Obj set; /* result set */ Int lenSet; /* length of <set> */ Int lenList; /* length of <list> */ Obj elm; /* one element of the list */ UInt status; /* the elements are mutable */ UInt i; /* loop variable */ /* make a dense copy */ lenList = LEN_LIST( list ); set = NEW_PLIST( T_PLIST, lenList ); lenSet = 0; for ( i = 1; i <= lenList; i++ ) { elm = ELMV0_LIST( list, i ); if ( elm != 0 ) { lenSet += 1; SET_ELM_PLIST( set, lenSet, elm ); CHANGED_BAG(set); /* in case elm had to be made, not just extracted */ } } SET_LEN_PLIST( set, lenSet ); SET_FILT_LIST( set, FN_IS_DENSE ); /* sort the set (which is a dense plain list) */ SortDensePlist( set ); /* remove duplicates */ status = RemoveDupsDensePlist( set ); /* adjust flags where possible */ switch(status) { case 0: break; case 1: SET_FILT_LIST(set, FN_IS_NHOMOG); SET_FILT_LIST(set, FN_IS_SSORT); break; case 2: SET_FILT_LIST( set, FN_IS_HOMOG ); SET_FILT_LIST( set, FN_IS_SSORT ); break; } /* return set */ return set; }
/**************************************************************************** ** *F DiffVecFFEFFE(<vecL>,<elmR>) difference of a vector and a fin field elm ** ** 'DiffVecFFEFFE' returns the difference of the vector <vecL> and the ** finite field element <elmR>. The difference is a list, where each ** element is the difference of <elmR> and the corresponding element of ** <vecL>. ** ** 'DiffVecFFEFFE' is an improved version of 'DiffListScl', which does not ** call 'DIFF'. */ Obj DiffVecFFEFFE ( Obj vecL, Obj elmR ) { Obj vecD; /* handle of the difference */ Obj * ptrD; /* pointer into the difference */ FFV valD; /* the value of a difference */ Obj * ptrL; /* pointer into the left operand */ FFV valL; /* the value of an element in vecL */ UInt len; /* length */ UInt i; /* loop variable */ FF fld; /* finite field */ FF * succ; /* successor table */ FFV valR; /* the value of elmR */ /* get the field and check that vecL and elmR have the same field */ fld = FLD_FFE(ELM_PLIST(vecL, 1)); if (FLD_FFE(elmR) != fld) { /* check the characteristic */ if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(elmR))) return DiffListScl(vecL, elmR); elmR = ErrorReturnObj( "<vec>-<elm>: <elm> and <vec> must belong to the same finite field", 0L, 0L, "you can replace <elm> via 'return <elm>;'"); return DIFF(vecL, elmR); } /* make the result list */ len = LEN_PLIST(vecL); vecD = NEW_PLIST(IS_MUTABLE_OBJ(vecL) ? T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len); SET_LEN_PLIST(vecD, len); /* to subtract we need the successor table */ succ = SUCC_FF(fld); /* loop over the elements and subtract */ valR = VAL_FFE(elmR); valR = NEG_FFV(valR, succ); ptrL = ADDR_OBJ(vecL); ptrD = ADDR_OBJ(vecD); for (i = 1; i <= len; i++) { valL = VAL_FFE(ptrL[i]); valD = SUM_FFV(valL, valR, succ); ptrD[i] = NEW_FFE(fld, valD); } /* return the result */ return vecD; }
Obj CopyContainerToGap(const T& v) { size_t s = v.size(); if(s == 0) { Obj l = NEW_PLIST(T_PLIST_EMPTY, 0); SET_LEN_PLIST(l, 0); CHANGED_BAG(l); return l; } Obj list = NEW_PLIST(T_PLIST_DENSE, s); SET_LEN_PLIST(list, s); CHANGED_BAG(list); GAP_maker<typename T::value_type> m; int pos = 1; for(typename T::const_iterator it = v.begin(); it != v.end(); ++it, ++pos) { SET_ELM_PLIST(list, pos, m(*it)); CHANGED_BAG(list); } return list; }
/**************************************************************************** ** *F SumFFEVecFFE(<elmL>,<vecR>) . . . . sum of an fin field elm and a vector ** ** 'SumFFEVecFFE' returns the sum of the fin field elm <elmL> and the vector ** <vecR>. The sum is a list, where each element is the sum of <elmL> and ** the corresponding element of <vecR>. ** ** 'SumFFEVecFFE' is an improved version of 'SumSclList', which does not ** call 'SUM'. */ Obj SumFFEVecFFE ( Obj elmL, Obj vecR ) { Obj vecS; /* handle of the sum */ Obj * ptrS; /* pointer into the sum */ FFV valS; /* the value of a sum */ Obj * ptrR; /* pointer into the right operand */ FFV valR; /* the value of an element in vecR */ UInt len; /* length */ UInt i; /* loop variable */ FF fld; /* finite field */ FF * succ; /* successor table */ FFV valL; /* the value of elmL */ /* get the field and check that elmL and vecR have the same field */ fld = FLD_FFE(ELM_PLIST(vecR, 1)); if (FLD_FFE(elmL) != fld) { /* check the characteristic */ if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(elmL))) return SumSclList(elmL, vecR); elmL = ErrorReturnObj( "<elm>+<vec>: <elm> and <vec> must belong to the same finite field", 0L, 0L, "you can replace <elm> via 'return <elm>;'"); return SUM(elmL, vecR); } /* make the result list */ len = LEN_PLIST(vecR); vecS = NEW_PLIST(IS_MUTABLE_OBJ(vecR) ? T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len); SET_LEN_PLIST(vecS, len); /* to add we need the successor table */ succ = SUCC_FF(fld); /* loop over the elements and add */ valL = VAL_FFE(elmL); ptrR = ADDR_OBJ(vecR); ptrS = ADDR_OBJ(vecS); for (i = 1; i <= len; i++) { valR = VAL_FFE(ptrR[i]); valS = SUM_FFV(valL, valR, succ); ptrS[i] = NEW_FFE(fld, valS); } /* return the result */ return vecS; }
/**************************************************************************** ** *F InitLibrary( <module> ) . . . . . . . initialise library data structures */ static Int InitLibrary ( StructInitInfo * module ) { /* make the list of names of record names */ NamesRNam = NEW_PLIST( T_PLIST, 0 ); #ifdef HPCGAP MakeBagPublic(NamesRNam); #endif /* make the hash list of record names */ HashRNam = NEW_PLIST( T_PLIST, 14033 ); SET_LEN_PLIST( HashRNam, 14033 ); #ifdef HPCGAP MakeBagPublic(HashRNam); #endif /* init filters and functions */ InitGVarFiltsFromTable( GVarFilts ); InitGVarOpersFromTable( GVarOpers ); InitGVarFuncsFromTable( GVarFuncs ); /* return success */ return 0; }
Obj operator()(const std::pair<T,U>& v) const { Obj list = NEW_PLIST(T_PLIST_DENSE, 2); SET_LEN_PLIST(list, 2); GAP_maker<T> m_t; SET_ELM_PLIST(list, 1, m_t(v.first)); CHANGED_BAG(list); GAP_maker<U> m_u; SET_ELM_PLIST(list, 2, m_u(v.second)); CHANGED_BAG(list); return list; }
Obj ZeroVecFFE( Obj vec ) { UInt i, len; Obj res; Obj z; assert(TNUM_OBJ(vec) >= T_PLIST_FFE && \ TNUM_OBJ(vec) <= T_PLIST_FFE + IMMUTABLE); len = LEN_PLIST(vec); assert(len); res = NEW_PLIST(TNUM_OBJ(vec), len); SET_LEN_PLIST(res, len); z = ZERO(ELM_PLIST(vec, 1)); for (i = 1; i <= len; i++) SET_ELM_PLIST(res, i, z); return res; }
Obj FuncALL_RNAMES ( Obj self ) { Obj copy, s; UInt i; Char* name; copy = NEW_PLIST( T_PLIST+IMMUTABLE, CountRNam ); for ( i = 1; i <= CountRNam; i++ ) { name = NAME_RNAM( i ); C_NEW_STRING_DYN(s, name); SET_ELM_PLIST( copy, i, s ); } SET_LEN_PLIST( copy, CountRNam ); return copy; }
Obj CopyObjWPObj ( Obj obj, Int mut ) { Obj copy; /* copy, result */ Obj tmp; /* temporary variable */ Obj elm; UInt i; /* loop variable */ /* make a copy */ if ( mut ) { copy = NewBag( T_WPOBJ, SIZE_OBJ(obj) ); ADDR_OBJ(copy)[0] = ADDR_OBJ(obj)[0]; } else { copy = NewBag( T_PLIST+IMMUTABLE, SIZE_OBJ(obj) ); SET_LEN_PLIST(copy,LengthWPObj(obj)); } /* leave a forwarding pointer */ tmp = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( tmp, 2 ); SET_ELM_PLIST( tmp, 1, ADDR_OBJ(obj)[0] ); SET_ELM_PLIST( tmp, 2, copy ); ADDR_OBJ(obj)[0] = tmp; CHANGED_BAG(obj); /* now it is copied */ RetypeBag( obj, T_WPOBJ + COPYING ); /* copy the subvalues */ for ( i = SIZE_OBJ(obj)/sizeof(Obj)-1; i > 0; i-- ) { elm = ADDR_OBJ(obj)[i]; if ( elm != 0 && !IS_WEAK_DEAD_BAG(elm)) { tmp = COPY_OBJ( elm, mut ); ADDR_OBJ(copy)[i] = tmp; CHANGED_BAG( copy ); } } /* return the copy */ return copy; }
/* handler for function 1 */ static Obj HdlrFunc1 ( Obj self ) { Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; Obj t_4 = 0; Bag oldFrame; OLD_BRK_CURR_STAT /* allocate new stack frame */ SWITCH_TO_NEW_FRAME(self,0,0,oldFrame); REM_BRK_CURR_STAT(); SET_BRK_CURR_STAT(0); /* WITH_HIDDEN_IMPS_FLAGS_COUNT := 0; */ AssGVar( G_WITH__HIDDEN__IMPS__FLAGS__COUNT, INTOBJ_INT(0) ); /* WITH_HIDDEN_IMPS_FLAGS_CACHE_MISS := 0; */ AssGVar( G_WITH__HIDDEN__IMPS__FLAGS__CACHE__MISS, INTOBJ_INT(0) ); /* WITH_HIDDEN_IMPS_FLAGS_CACHE_HIT := 0; */ AssGVar( G_WITH__HIDDEN__IMPS__FLAGS__CACHE__HIT, INTOBJ_INT(0) ); /* IMPLICATIONS := [ ]; */ t_1 = NEW_PLIST( T_PLIST, 0 ); SET_LEN_PLIST( t_1, 0 ); AssGVar( G_IMPLICATIONS, t_1 ); /* WITH_IMPS_FLAGS_CACHE := [ ]; */ t_1 = NEW_PLIST( T_PLIST, 0 ); SET_LEN_PLIST( t_1, 0 ); AssGVar( G_WITH__IMPS__FLAGS__CACHE, t_1 ); /* WITH_IMPS_FLAGS_COUNT := 0; */ AssGVar( G_WITH__IMPS__FLAGS__COUNT, INTOBJ_INT(0) ); /* WITH_IMPS_FLAGS_CACHE_HIT := 0; */ AssGVar( G_WITH__IMPS__FLAGS__CACHE__HIT, INTOBJ_INT(0) ); /* WITH_IMPS_FLAGS_CACHE_MISS := 0; */ AssGVar( G_WITH__IMPS__FLAGS__CACHE__MISS, INTOBJ_INT(0) ); /* Unbind( CLEAR_IMP_CACHE ); */ AssGVar( G_CLEAR__IMP__CACHE, 0 ); /* BIND_GLOBAL( "CLEAR_IMP_CACHE", function ( ) WITH_IMPS_FLAGS_CACHE := [ ]; return; end ); */ t_1 = GF_BIND__GLOBAL; C_NEW_STRING( t_2, 15, "CLEAR_IMP_CACHE" ); t_3 = NewFunction( NameFunc[2], NargFunc[2], NamsFunc[2], HdlrFunc2 ); ENVI_FUNC( t_3 ) = TLS(CurrLVars); t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) ); STARTLINE_BODY(t_4) = INTOBJ_INT(39); ENDLINE_BODY(t_4) = INTOBJ_INT(41); FILENAME_BODY(t_4) = FileName; BODY_FUNC(t_3) = t_4; CHANGED_BAG( TLS(CurrLVars) ); CALL_2ARGS( t_1, t_2, t_3 ); /* BIND_GLOBAL( "WITH_IMPS_FLAGS", function ( flags ) local with, changed, imp, hash, hash2, i; hash := HASH_FLAGS( flags ) mod 11001; for i in [ 0 .. 3 ] do hash2 := 2 * ((hash + 31 * i) mod 11001) + 1; if IsBound( WITH_IMPS_FLAGS_CACHE[hash2] ) then if IS_IDENTICAL_OBJ( WITH_IMPS_FLAGS_CACHE[hash2], flags ) then WITH_IMPS_FLAGS_CACHE_HIT := WITH_IMPS_FLAGS_CACHE_HIT + 1; return WITH_IMPS_FLAGS_CACHE[hash2 + 1]; fi; else break; fi; od; if i = 3 then WITH_IMPS_FLAGS_COUNT := (WITH_IMPS_FLAGS_COUNT + 1) mod 4; i := WITH_IMPS_FLAGS_COUNT; hash2 := 2 * ((hash + 31 * i) mod 11001) + 1; fi; WITH_IMPS_FLAGS_CACHE_MISS := WITH_IMPS_FLAGS_CACHE_MISS + 1; with := flags; changed := true; while changed do changed := false; for imp in IMPLICATIONS do if IS_SUBSET_FLAGS( with, imp[2] ) and not IS_SUBSET_FLAGS( with, imp[1] ) then with := AND_FLAGS( with, imp[1] ); changed := true; fi; od; od; WITH_IMPS_FLAGS_CACHE[hash2] := flags; WITH_IMPS_FLAGS_CACHE[hash2 + 1] := with; return with; end ); */ t_1 = GF_BIND__GLOBAL; C_NEW_STRING( t_2, 15, "WITH_IMPS_FLAGS" ); t_3 = NewFunction( NameFunc[3], NargFunc[3], NamsFunc[3], HdlrFunc3 ); ENVI_FUNC( t_3 ) = TLS(CurrLVars); t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) ); STARTLINE_BODY(t_4) = INTOBJ_INT(44); ENDLINE_BODY(t_4) = INTOBJ_INT(83); FILENAME_BODY(t_4) = FileName; BODY_FUNC(t_3) = t_4; CHANGED_BAG( TLS(CurrLVars) ); CALL_2ARGS( t_1, t_2, t_3 ); /* UNBIND_GLOBAL( "RANK_FILTER" ); */ t_1 = GF_UNBIND__GLOBAL; C_NEW_STRING( t_2, 11, "RANK_FILTER" ); CALL_1ARGS( t_1, t_2 ); /* BIND_GLOBAL( "RANK_FILTER", function ( filter ) local rank, flags, i; rank := 0; if IS_FUNCTION( filter ) then flags := FLAGS_FILTER( filter ); else flags := filter; fi; for i in TRUES_FLAGS( WITH_HIDDEN_IMPS_FLAGS( flags ) ) do if IsBound( RANK_FILTERS[i] ) then rank := rank + RANK_FILTERS[i]; else rank := rank + 1; fi; od; return rank; end ); */ t_1 = GF_BIND__GLOBAL; C_NEW_STRING( t_2, 11, "RANK_FILTER" ); t_3 = NewFunction( NameFunc[4], NargFunc[4], NamsFunc[4], HdlrFunc4 ); ENVI_FUNC( t_3 ) = TLS(CurrLVars); t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) ); STARTLINE_BODY(t_4) = INTOBJ_INT(97); ENDLINE_BODY(t_4) = INTOBJ_INT(114); FILENAME_BODY(t_4) = FileName; BODY_FUNC(t_3) = t_4; CHANGED_BAG( TLS(CurrLVars) ); CALL_2ARGS( t_1, t_2, t_3 ); /* RankFilter := RANK_FILTER; */ t_1 = GC_RANK__FILTER; CHECK_BOUND( t_1, "RANK_FILTER" ) AssGVar( G_RankFilter, t_1 ); /* UNBIND_GLOBAL( "RANK_FILTER_STORE" ); */ t_1 = GF_UNBIND__GLOBAL; C_NEW_STRING( t_2, 17, "RANK_FILTER_STORE" ); CALL_1ARGS( t_1, t_2 ); /* BIND_GLOBAL( "RANK_FILTER_STORE", function ( filter ) local hash, rank, flags; if IS_FUNCTION( filter ) then flags := FLAGS_FILTER( filter ); else flags := filter; fi; hash := HASH_FLAGS( flags ); rank := RANK_FILTER( flags ); ADD_LIST( RANK_FILTER_LIST_CURRENT, hash ); ADD_LIST( RANK_FILTER_LIST_CURRENT, rank ); return rank; end ); */ t_1 = GF_BIND__GLOBAL; C_NEW_STRING( t_2, 17, "RANK_FILTER_STORE" ); t_3 = NewFunction( NameFunc[5], NargFunc[5], NamsFunc[5], HdlrFunc5 ); ENVI_FUNC( t_3 ) = TLS(CurrLVars); t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) ); STARTLINE_BODY(t_4) = INTOBJ_INT(119); ENDLINE_BODY(t_4) = INTOBJ_INT(133); FILENAME_BODY(t_4) = FileName; BODY_FUNC(t_3) = t_4; CHANGED_BAG( TLS(CurrLVars) ); CALL_2ARGS( t_1, t_2, t_3 ); /* UNBIND_GLOBAL( "RANK_FILTER_COMPLETION" ); */ t_1 = GF_UNBIND__GLOBAL; C_NEW_STRING( t_2, 22, "RANK_FILTER_COMPLETION" ); CALL_1ARGS( t_1, t_2 ); /* BIND_GLOBAL( "RANK_FILTER_COMPLETION", function ( filter ) local hash, flags; if IS_FUNCTION( filter ) then flags := FLAGS_FILTER( filter ); else flags := filter; fi; hash := HASH_FLAGS( flags ); if hash <> RANK_FILTER_LIST[RANK_FILTER_COUNT] then Error( "corrupted completion file" ); fi; RANK_FILTER_COUNT := RANK_FILTER_COUNT + 2; return RANK_FILTER_LIST[RANK_FILTER_COUNT - 1]; end ); */ t_1 = GF_BIND__GLOBAL; C_NEW_STRING( t_2, 22, "RANK_FILTER_COMPLETION" ); t_3 = NewFunction( NameFunc[6], NargFunc[6], NamsFunc[6], HdlrFunc6 ); ENVI_FUNC( t_3 ) = TLS(CurrLVars); t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) ); STARTLINE_BODY(t_4) = INTOBJ_INT(136); ENDLINE_BODY(t_4) = INTOBJ_INT(151); FILENAME_BODY(t_4) = FileName; BODY_FUNC(t_3) = t_4; CHANGED_BAG( TLS(CurrLVars) ); CALL_2ARGS( t_1, t_2, t_3 ); /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
/**************************************************************************** ** *F DiffVecFFEVecFFE(<vecL>,<vecR>) . . . . . . . . difference of two vectors ** ** 'DiffVecFFEVecFFE' returns the difference of the two vectors <vecL> and ** <vecR>. The difference is a new list, where each element is the ** difference of the corresponding elements of <vecL> and <vecR>. ** ** 'DiffVecFFEVecFFE' is an improved version of 'DiffListList', which does ** not call 'DIFF'. */ Obj DiffVecFFEVecFFE ( Obj vecL, Obj vecR ) { Obj vecD; /* handle of the difference */ Obj * ptrD; /* pointer into the difference */ FFV valD; /* one element of difference list */ Obj * ptrL; /* pointer into the left operand */ FFV valL; /* one element of left operand */ Obj * ptrR; /* pointer into the right operand */ FFV valR; /* one element of right operand */ UInt len, lenL, lenR; /* length */ UInt lenmin; UInt i; /* loop variable */ FF fld; /* finite field */ FF * succ; /* successor table */ /* check the lengths */ lenL = LEN_PLIST(vecL); lenR = LEN_PLIST(vecR); if (lenR > lenL) { len = lenR; lenmin = lenL; } else { len = lenL; lenmin = lenR; } /* check the fields */ fld = FLD_FFE(ELM_PLIST(vecL, 1)); if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) { /* check the characteristic */ if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1)))) return DiffListList(vecL, vecR); vecR = ErrorReturnObj( "Vector -: vectors have different fields", 0L, 0L, "you can replace vector <right> via 'return <right>;'"); return DIFF(vecL, vecR); } /* make the result list */ vecD = NEW_PLIST((IS_MUTABLE_OBJ(vecL) || IS_MUTABLE_OBJ(vecR)) ? T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len); SET_LEN_PLIST(vecD, len); /* to subtract we need the successor table */ succ = SUCC_FF(fld); /* loop over the elements and subtract */ ptrL = ADDR_OBJ(vecL); ptrR = ADDR_OBJ(vecR); ptrD = ADDR_OBJ(vecD); for (i = 1; i <= lenmin; i++) { valL = VAL_FFE(ptrL[i]); valR = VAL_FFE(ptrR[i]); valR = NEG_FFV(valR, succ); valD = SUM_FFV(valL, valR, succ); ptrD[i] = NEW_FFE(fld, valD); } if (lenL < lenR) for (; i <= len; i++) { valR = VAL_FFE(ptrR[i]); valD = NEG_FFV(valR, succ); ptrD[i] = NEW_FFE(fld, valD); } else for (; i <= len; i++) ptrD[i] = ptrL[i]; /* return the result */ return vecD; }
/* handler for function 4 */ static Obj HdlrFunc4 ( Obj self ) { Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; Obj t_4 = 0; Obj t_5 = 0; Bag oldFrame; /* allocate new stack frame */ SWITCH_TO_NEW_FRAME(self,0,0,oldFrame); /* BreakOnError := false; */ t_1 = False; AssGVar( G_BreakOnError, t_1 ); /* CALL_WITH_CATCH( range2, [ 1, 2 ^ 80 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range2; CHECK_BOUND( t_2, "range2" ) t_3 = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( t_3, 2 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(1) ); t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(80) ); SET_ELM_PLIST( t_3, 2, t_4 ); CHANGED_BAG( t_3 ); CALL_2ARGS( t_1, t_2, t_3 ); /* CALL_WITH_CATCH( range2, [ - 2 ^ 80, 0 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range2; CHECK_BOUND( t_2, "range2" ) t_3 = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( t_3, 2 ); t_5 = POW( INTOBJ_INT(2), INTOBJ_INT(80) ); C_AINV_FIA( t_4, t_5 ) SET_ELM_PLIST( t_3, 1, t_4 ); CHANGED_BAG( t_3 ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(0) ); CALL_2ARGS( t_1, t_2, t_3 ); /* CALL_WITH_CATCH( range3, [ 1, 2, 2 ^ 80 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range3; CHECK_BOUND( t_2, "range3" ) t_3 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_3, 3 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(1) ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) ); t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(80) ); SET_ELM_PLIST( t_3, 3, t_4 ); CHANGED_BAG( t_3 ); CALL_2ARGS( t_1, t_2, t_3 ); /* CALL_WITH_CATCH( range3, [ - 2 ^ 80, 0, 1 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range3; CHECK_BOUND( t_2, "range3" ) t_3 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_3, 3 ); t_5 = POW( INTOBJ_INT(2), INTOBJ_INT(80) ); C_AINV_FIA( t_4, t_5 ) SET_ELM_PLIST( t_3, 1, t_4 ); CHANGED_BAG( t_3 ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(0) ); SET_ELM_PLIST( t_3, 3, INTOBJ_INT(1) ); CALL_2ARGS( t_1, t_2, t_3 ); /* CALL_WITH_CATCH( range3, [ 0, 2 ^ 80, 2 ^ 81 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range3; CHECK_BOUND( t_2, "range3" ) t_3 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_3, 3 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(0) ); t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(80) ); SET_ELM_PLIST( t_3, 2, t_4 ); CHANGED_BAG( t_3 ); t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(81) ); SET_ELM_PLIST( t_3, 3, t_4 ); CHANGED_BAG( t_3 ); CALL_2ARGS( t_1, t_2, t_3 ); /* Display( [ 1, 2 .. 2 ] ); */ t_1 = GF_Display; t_2 = Range3Check( INTOBJ_INT(1), INTOBJ_INT(2), INTOBJ_INT(2) ); CALL_1ARGS( t_1, t_2 ); /* CALL_WITH_CATCH( range3, [ 2, 2, 2 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range3; CHECK_BOUND( t_2, "range3" ) t_3 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_3, 3 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(2) ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) ); SET_ELM_PLIST( t_3, 3, INTOBJ_INT(2) ); CALL_2ARGS( t_1, t_2, t_3 ); /* Display( [ 2, 4 .. 6 ] ); */ t_1 = GF_Display; t_2 = Range3Check( INTOBJ_INT(2), INTOBJ_INT(4), INTOBJ_INT(6) ); CALL_1ARGS( t_1, t_2 ); /* CALL_WITH_CATCH( range3, [ 2, 4, 7 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range3; CHECK_BOUND( t_2, "range3" ) t_3 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_3, 3 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(2) ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(4) ); SET_ELM_PLIST( t_3, 3, INTOBJ_INT(7) ); CALL_2ARGS( t_1, t_2, t_3 ); /* Display( [ 2, 4 .. 2 ] ); */ t_1 = GF_Display; t_2 = Range3Check( INTOBJ_INT(2), INTOBJ_INT(4), INTOBJ_INT(2) ); CALL_1ARGS( t_1, t_2 ); /* Display( [ 2, 4 .. 0 ] ); */ t_1 = GF_Display; t_2 = Range3Check( INTOBJ_INT(2), INTOBJ_INT(4), INTOBJ_INT(0) ); CALL_1ARGS( t_1, t_2 ); /* CALL_WITH_CATCH( range3, [ 4, 2, 1 ] ); */ t_1 = GF_CALL__WITH__CATCH; t_2 = GC_range3; CHECK_BOUND( t_2, "range3" ) t_3 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_3, 3 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(4) ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) ); SET_ELM_PLIST( t_3, 3, INTOBJ_INT(1) ); CALL_2ARGS( t_1, t_2, t_3 ); /* Display( [ 4, 2 .. 0 ] ); */ t_1 = GF_Display; t_2 = Range3Check( INTOBJ_INT(4), INTOBJ_INT(2), INTOBJ_INT(0) ); CALL_1ARGS( t_1, t_2 ); /* Display( [ 4, 2 .. 8 ] ); */ t_1 = GF_Display; t_2 = Range3Check( INTOBJ_INT(4), INTOBJ_INT(2), INTOBJ_INT(8) ); CALL_1ARGS( t_1, t_2 ); /* return; */ SWITCH_TO_OLD_FRAME(oldFrame); return 0; /* return; */ SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
UInt RNamName ( const Char * name ) { Obj rnam; /* record name (as imm intobj) */ UInt pos; /* hash position */ UInt len; /* length of name */ Char namx [1024]; /* temporary copy of <name> */ Obj string; /* temporary string object <name> */ Obj table; /* temporary copy of <HashRNam> */ Obj rnam2; /* one element of <table> */ const Char * p; /* loop variable */ UInt i; /* loop variable */ /* start looking in the table at the following hash position */ pos = 0; len = 0; for ( p = name; *p != '\0'; p++ ) { pos = 65599 * pos + *p; len++; } pos = (pos % SizeRNam) + 1; if(len >= 1023) { // Note: We can't pass 'name' here, as it might get moved by garbage collection ErrorQuit("Record names must consist of less than 1023 characters", 0, 0); } /* look through the table until we find a free slot or the global */ while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0 && strncmp( NAME_RNAM( INT_INTOBJ(rnam) ), name, 1023 ) ) { pos = (pos % SizeRNam) + 1; } /* if we did not find the global variable, make a new one and enter it */ /* (copy the name first, to avoid a stale pointer in case of a GC) */ if ( rnam == 0 ) { CountRNam++; rnam = INTOBJ_INT(CountRNam); SET_ELM_PLIST( HashRNam, pos, rnam ); strlcpy( namx, name, sizeof(namx) ); C_NEW_STRING_DYN(string, namx); GROW_PLIST( NamesRNam, CountRNam ); SET_LEN_PLIST( NamesRNam, CountRNam ); SET_ELM_PLIST( NamesRNam, CountRNam, string ); CHANGED_BAG( NamesRNam ); } /* if the table is too crowed, make a larger one, rehash the names */ if ( SizeRNam < 3 * CountRNam / 2 ) { table = HashRNam; SizeRNam = 2 * SizeRNam + 1; HashRNam = NEW_PLIST( T_PLIST, SizeRNam ); SET_LEN_PLIST( HashRNam, SizeRNam ); for ( i = 1; i <= (SizeRNam-1)/2; i++ ) { rnam2 = ELM_PLIST( table, i ); if ( rnam2 == 0 ) continue; pos = 0; for ( p = NAME_RNAM( INT_INTOBJ(rnam2) ); *p != '\0'; p++ ) { pos = 65599 * pos + *p; } pos = (pos % SizeRNam) + 1; while ( ELM_PLIST( HashRNam, pos ) != 0 ) { pos = (pos % SizeRNam) + 1; } SET_ELM_PLIST( HashRNam, pos, rnam2 ); } } /* return the record name */ return INT_INTOBJ(rnam); }
Obj SCTableProductHandler ( Obj self, Obj table, Obj list1, Obj list2 ) { Obj res; /* result list */ Obj row; /* one row of sc table */ Obj zero; /* zero from sc table */ Obj ai, aj; /* elements from list1 */ Obj bi, bj; /* elements from list2 */ Obj c, c1, c2; /* products of above */ Int dim; /* dimension of vectorspace */ Int i, j; /* loop variables */ /* check the arguments a bit */ if ( ! IS_SMALL_LIST(table) ) { table = ErrorReturnObj( "SCTableProduct: <table> must be a list (not a %s)", (Int)TNAM_OBJ(table), 0L, "you can replace <table> via 'return <table>;'" ); return SCTableProductHandler( self, table, list1, list2 ); } dim = LEN_LIST(table) - 2; if ( dim <= 0 ) { table = ErrorReturnObj( "SCTableProduct: <table> must be a list with at least 3 elements", 0L, 0L, "you can replace <table> via 'return <table>;'" ); return SCTableProductHandler( self, table, list1, list2 ); } zero = ELM_LIST( table, dim+2 ); if ( ! IS_SMALL_LIST(list1) || LEN_LIST(list1) != dim ) { list1 = ErrorReturnObj( "SCTableProduct: <list1> must be a list with %d elements", dim, 0L, "you can replace <list1> via 'return <list1>;'" ); return SCTableProductHandler( self, table, list1, list2 ); } if ( ! IS_SMALL_LIST(list2) || LEN_LIST(list2) != dim ) { list2 = ErrorReturnObj( "SCTableProduct: <list2> must be a list with %d elements", dim, 0L, "you can replace <list2> via 'return <list2>;'" ); return SCTableProductHandler( self, table, list1, list2 ); } /* make the result list */ res = NEW_PLIST( T_PLIST, dim ); SET_LEN_PLIST( res, dim ); for ( i = 1; i <= dim; i++ ) { SET_ELM_PLIST( res, i, zero ); } CHANGED_BAG( res ); /* general case */ if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(0) ) ) { for ( i = 1; i <= dim; i++ ) { ai = ELM_LIST( list1, i ); if ( EQ( ai, zero ) ) continue; row = ELM_LIST( table, i ); for ( j = 1; j <= dim; j++ ) { bj = ELM_LIST( list2, j ); if ( EQ( bj, zero ) ) continue; c = PROD( ai, bj ); if ( ! EQ( c, zero ) ) { SCTableProdAdd( res, c, ELM_LIST( row, j ), dim ); } } } } /* commutative case */ else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(1) ) ) { for ( i = 1; i <= dim; i++ ) { ai = ELM_LIST( list1, i ); bi = ELM_LIST( list2, i ); if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue; row = ELM_LIST( table, i ); c = PROD( ai, bi ); if ( ! EQ( c, zero ) ) { SCTableProdAdd( res, c, ELM_LIST( row, i ), dim ); } for ( j = i+1; j <= dim; j++ ) { bj = ELM_LIST( list2, j ); aj = ELM_LIST( list1, j ); if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue; c1 = PROD( ai, bj ); c2 = PROD( aj, bi ); c = SUM( c1, c2 ); if ( ! EQ( c, zero ) ) { SCTableProdAdd( res, c, ELM_LIST( row, j ), dim ); } } } } /* anticommutative case */ else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(-1) ) ) { for ( i = 1; i <= dim; i++ ) { ai = ELM_LIST( list1, i ); bi = ELM_LIST( list2, i ); if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue; row = ELM_LIST( table, i ); for ( j = i+1; j <= dim; j++ ) { bj = ELM_LIST( list2, j ); aj = ELM_LIST( list1, j ); if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue; c1 = PROD( ai, bj ); c2 = PROD( aj, bi ); c = DIFF( c1, c2 ); if ( ! EQ( c, zero ) ) { SCTableProdAdd( res, c, ELM_LIST( row, j ), dim ); } } } } /* return the result */ return res; }
/* handler for function 2 */ static Obj HdlrFunc2 ( Obj self ) { Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; Obj t_4 = 0; Obj t_5 = 0; Obj t_6 = 0; Bag oldFrame; /* allocate new stack frame */ SWITCH_TO_NEW_FRAME(self,0,0,oldFrame); /* Print( 1, "\n" ); */ t_1 = GF_Print; t_2 = MakeString( "\n" ); CALL_2ARGS( t_1, INTOBJ_INT(1), t_2 ); /* Print( "abc", "\n" ); */ t_1 = GF_Print; t_2 = MakeString( "abc" ); t_3 = MakeString( "\n" ); CALL_2ARGS( t_1, t_2, t_3 ); /* Print( (1,2)(5,6), "\n" ); */ t_1 = GF_Print; t_2 = IdentityPerm; t_4 = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( t_4, 2 ); t_3 = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( t_3, 2 ); SET_ELM_PLIST( t_4, 1, t_3 ); CHANGED_BAG( t_4 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(1) ); CHANGED_BAG( t_3 ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) ); CHANGED_BAG( t_3 ); t_3 = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( t_3, 2 ); SET_ELM_PLIST( t_4, 2, t_3 ); CHANGED_BAG( t_4 ); SET_ELM_PLIST( t_3, 1, INTOBJ_INT(5) ); CHANGED_BAG( t_3 ); SET_ELM_PLIST( t_3, 2, INTOBJ_INT(6) ); CHANGED_BAG( t_3 ); t_2 = Array2Perm( t_4 ); t_3 = MakeString( "\n" ); CALL_2ARGS( t_1, t_2, t_3 ); /* Print( [ 1, "abc" ], "\n" ); */ t_1 = GF_Print; t_2 = NEW_PLIST( T_PLIST, 2 ); SET_LEN_PLIST( t_2, 2 ); SET_ELM_PLIST( t_2, 1, INTOBJ_INT(1) ); t_3 = MakeString( "abc" ); SET_ELM_PLIST( t_2, 2, t_3 ); CHANGED_BAG( t_2 ); t_3 = MakeString( "\n" ); CALL_2ARGS( t_1, t_2, t_3 ); /* Print( Group( (1,2,3) ), "\n" ); */ t_1 = GF_Print; t_3 = GF_Group; t_4 = IdentityPerm; t_6 = NEW_PLIST( T_PLIST, 1 ); SET_LEN_PLIST( t_6, 1 ); t_5 = NEW_PLIST( T_PLIST, 3 ); SET_LEN_PLIST( t_5, 3 ); SET_ELM_PLIST( t_6, 1, t_5 ); CHANGED_BAG( t_6 ); SET_ELM_PLIST( t_5, 1, INTOBJ_INT(1) ); CHANGED_BAG( t_5 ); SET_ELM_PLIST( t_5, 2, INTOBJ_INT(2) ); CHANGED_BAG( t_5 ); SET_ELM_PLIST( t_5, 3, INTOBJ_INT(3) ); CHANGED_BAG( t_5 ); t_4 = Array2Perm( t_6 ); t_2 = CALL_1ARGS( t_3, t_4 ); CHECK_FUNC_RESULT( t_2 ) t_3 = MakeString( "\n" ); CALL_2ARGS( t_1, t_2, t_3 ); /* return; */ SWITCH_TO_OLD_FRAME(oldFrame); return 0; /* return; */ SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
// // Returns a new empty plain list // with capacity <capacity> Obj GAP_NewPlist(Int capacity) { return NEW_PLIST(T_PLIST_EMPTY, capacity); }
UInt RNamNameWithLen(const Char * name, UInt len) { Obj rnam; /* record name (as imm intobj) */ UInt pos; /* hash position */ Char namx [1024]; /* temporary copy of <name> */ Obj string; /* temporary string object <name> */ Obj table; /* temporary copy of <HashRNam> */ Obj rnam2; /* one element of <table> */ UInt i; /* loop variable */ UInt sizeRNam; if (len > 1023) { // Note: We can't pass 'name' here, as it might get moved by garbage collection ErrorQuit("Record names must consist of at most 1023 characters", 0, 0); } /* start looking in the table at the following hash position */ const UInt hash = HashString( name, len ); #ifdef HPCGAP HPC_LockNames(0); /* try a read lock first */ #endif /* look through the table until we find a free slot or the global */ sizeRNam = LEN_PLIST(HashRNam); pos = (hash % sizeRNam) + 1; while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0 && !EqString( NAME_RNAM( INT_INTOBJ(rnam) ), name, len ) ) { pos = (pos % sizeRNam) + 1; } if (rnam != 0) { #ifdef HPCGAP HPC_UnlockNames(); #endif return INT_INTOBJ(rnam); } #ifdef HPCGAP if (!PreThreadCreation) { HPC_UnlockNames(); /* switch to a write lock */ HPC_LockNames(1); /* look through the table until we find a free slot or the global */ sizeRNam = LEN_PLIST(HashRNam); pos = (hash % sizeRNam) + 1; while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0 && !EqString( NAME_RNAM( INT_INTOBJ(rnam) ), name, len ) ) { pos = (pos % sizeRNam) + 1; } } if (rnam != 0) { HPC_UnlockNames(); return INT_INTOBJ(rnam); } #endif /* if we did not find the global variable, make a new one and enter it */ /* (copy the name first, to avoid a stale pointer in case of a GC) */ memcpy( namx, name, len ); namx[len] = 0; string = MakeImmString(namx); const UInt countRNam = PushPlist(NamesRNam, string); rnam = INTOBJ_INT(countRNam); SET_ELM_PLIST( HashRNam, pos, rnam ); /* if the table is too crowded, make a larger one, rehash the names */ if ( sizeRNam < 3 * countRNam / 2 ) { table = HashRNam; sizeRNam = 2 * sizeRNam + 1; HashRNam = NEW_PLIST( T_PLIST, sizeRNam ); SET_LEN_PLIST( HashRNam, sizeRNam ); #ifdef HPCGAP /* The list is briefly non-public, but this is safe, because * the mutex protects it from being accessed by other threads. */ MakeBagPublic(HashRNam); #endif for ( i = 1; i <= (sizeRNam-1)/2; i++ ) { rnam2 = ELM_PLIST( table, i ); if ( rnam2 == 0 ) continue; string = NAME_RNAM( INT_INTOBJ(rnam2) ); pos = HashString( CONST_CSTR_STRING( string ), GET_LEN_STRING( string) ); pos = (pos % sizeRNam) + 1; while ( ELM_PLIST( HashRNam, pos ) != 0 ) { pos = (pos % sizeRNam) + 1; } SET_ELM_PLIST( HashRNam, pos, rnam2 ); } } #ifdef HPCGAP HPC_UnlockNames(); #endif /* return the record name */ return INT_INTOBJ(rnam); }
// compatibility with GAP <= 4.9 static inline Obj NEW_PLIST_IMM(UInt type, Int plen) { return NEW_PLIST(type | IMMUTABLE, plen); }
template<class Z> Obj dofplll(Obj gapmat, Obj lllargs, Obj svpargs) { if (!IS_PLIST(gapmat)) return INTOBJ_INT(-1); Int numrows = LEN_PLIST(gapmat), numcols = -1; for (int i = 1; i <= numrows; i++) { Obj row = ELM_PLIST(gapmat,i); if (numcols == -1) numcols = LEN_PLIST(row); if (numcols != LEN_PLIST(row)) return INTOBJ_INT(-1); } if (numcols <= 0) return INTOBJ_INT(-1); ZZ_mat<Z> mat(numrows, numcols); for (int i = 1; i <= numrows; i++) for (int j = 1; j <= numcols; j++) SET_INTOBJ(mat[i-1][j-1], ELM_PLIST(ELM_PLIST(gapmat,i),j)); if (lllargs != Fail) { double delta = 0.99; double eta = 0.51; LLLMethod method = LM_WRAPPER; FloatType floatType = FT_DEFAULT; int precision = 0; int flags = LLL_DEFAULT; if (lllargs != True) { if (!IS_PLIST(lllargs) || LEN_PLIST(lllargs) != 6) return INTOBJ_INT(-20); Obj v = ELM_PLIST(lllargs,1); if (IS_MACFLOAT(v)) delta = VAL_MACFLOAT(v); else if (v != Fail) return INTOBJ_INT(-21); v = ELM_PLIST(lllargs,2); if (IS_MACFLOAT(v)) eta = VAL_MACFLOAT(v); else if (v != Fail) return INTOBJ_INT(-22); v = ELM_PLIST(lllargs,3); if (v == INTOBJ_INT(0)) method = LM_WRAPPER; else if (v == INTOBJ_INT(1)) method = LM_PROVED; else if (v == INTOBJ_INT(2)) method = LM_HEURISTIC; else if (v == INTOBJ_INT(3)) method = LM_FAST; else if (v != Fail) return INTOBJ_INT(-23); v = ELM_PLIST(lllargs,4); if (v == INTOBJ_INT(0)) floatType = FT_DEFAULT; else if (v == INTOBJ_INT(1)) floatType = FT_DOUBLE; else if (v == INTOBJ_INT(2)) floatType = FT_DPE; else if (v == INTOBJ_INT(3)) floatType = FT_MPFR; else if (v != Fail) return INTOBJ_INT(-24); v = ELM_PLIST(lllargs,5); if (IS_INTOBJ(v)) precision = INT_INTOBJ(v); else if (v != Fail) return INTOBJ_INT(-25); v = ELM_PLIST(lllargs,6); if (IS_INTOBJ(v)) flags = INT_INTOBJ(v); else if (v != Fail) return INTOBJ_INT(-26); } int result = lllReduction(mat, delta, eta, method, floatType, precision, flags); if (result != RED_SUCCESS) return INTOBJ_INT(10*result+1); } if (svpargs != Fail) { SVPMethod method = SVPM_PROVED; int flags = SVP_DEFAULT; // __asm__ ("int3"); if (svpargs != True) { if (!IS_PLIST(svpargs) || LEN_PLIST(svpargs) != 2) return INTOBJ_INT(-30); Obj v = ELM_PLIST(svpargs,1); if (v == INTOBJ_INT(0)) method = SVPM_PROVED; else if (v == INTOBJ_INT(1)) method = SVPM_FAST; else if (v != Fail) return INTOBJ_INT(-31); v = ELM_PLIST(svpargs,2); if (IS_INTOBJ(v)) flags = INT_INTOBJ(v); else if (v != Fail) return INTOBJ_INT(-32); } vector<Integer> sol(numrows); IntMatrix svpmat(numrows,numcols); for (int i = 0; i < numrows; i++) for (int j = 0; j < numcols; j++) SET_Z(svpmat[i][j],mat[i][j]); int result = shortestVector(svpmat, sol, method, flags); if (result != RED_SUCCESS) return INTOBJ_INT(10*result+2); Obj gapvec; if (lllargs == Fail) { // return coordinates of shortest vector in mat gapvec = NEW_PLIST(T_PLIST,numrows); SET_LEN_PLIST(gapvec,numrows); for (int i = 1; i <= numrows; i++) { Obj v = GET_INTOBJ(sol[i-1]); SET_ELM_PLIST(gapvec,i,v); } } else { // return shortest vector gapvec = NEW_PLIST(T_PLIST,numcols); SET_LEN_PLIST(gapvec,numcols); for (int i = 1; i <= numcols; i++) { Integer s; s = 0; for (int j = 0; j < numrows; j++) s.addmul(sol[j],svpmat[j][i-1]); Obj v = GET_INTOBJ(s); SET_ELM_PLIST(gapvec,i,v); } } return gapvec; } gapmat = NEW_PLIST(T_PLIST,numrows); SET_LEN_PLIST(gapmat,numrows); for (int i = 1; i <= numrows; i++) { Obj gaprow = NEW_PLIST(T_PLIST,numcols); SET_LEN_PLIST(gaprow,numcols); SET_ELM_PLIST(gapmat,i,gaprow); for (int j = 1; j <= numcols; j++) { Obj v = GET_INTOBJ(mat[i-1][j-1]); SET_ELM_PLIST(gaprow,j,v); } } return gapmat; }