Obj FuncSTRING_DIGITS_MACFLOAT( Obj self, Obj gapprec, Obj f) { Char buf[50]; Obj str; int prec = INT_INTOBJ(gapprec); if (prec > 40) /* too much anyways, and would risk buffer overrun */ prec = 40; snprintf(buf, sizeof(buf), "%.*" PRINTFFORMAT, prec, (TOPRINTFFORMAT)VAL_MACFLOAT(f)); C_NEW_STRING_DYN(str, buf); return str; }
Obj MPIerror_string( Obj self, Obj errorcode ) { int resultlen; Obj str; str = NEW_STRING( 72 ); MPI_Error_string( INT_INTOBJ(errorcode), (char*)CSTR_STRING(str), &resultlen); ((char*)CSTR_STRING(str))[resultlen] = '\0'; SET_LEN_STRING(str, resultlen); ResizeBag( str, SIZEBAG_STRINGLEN( GET_LEN_STRING(str) ) ); return str; }
static Obj FPLLL (Obj self, Obj gapmat, Obj intType, Obj lllargs, Obj svpargs) { if (intType == Fail) intType = INTOBJ_INT(0); if (!IS_INTOBJ(intType)) return INTOBJ_INT(-2); switch (INT_INTOBJ(intType)) { case 0: return dofplll<mpz_t>(gapmat, lllargs, svpargs); case 1: return dofplll<long>(gapmat, lllargs, svpargs); case 2: return dofplll<double>(gapmat, lllargs, svpargs); default: return INTOBJ_INT(-2); } }
Obj FuncSetElmWPObj(Obj self, Obj wp, Obj pos, Obj val) { UInt ipos = INT_INTOBJ(pos); if (LengthWPObj(wp) < ipos) { GROW_WPOBJ(wp, ipos); STORE_LEN_WPOBJ(wp,ipos); } ELM_WPOBJ(wp,ipos) = val; CHANGED_BAG(wp); return 0; }
void SerializeInt(Obj obj) { Int n = INT_INTOBJ(obj); WriteTNum(T_INT); if (n >= -32 && n <= 31) { WriteByte(((n + 32) << 2) + 1); } else if (n >= -8192 && n <= 8191) { n += 8192; WriteByte(((n >> 8) << 2) + 2); WriteByte(n & 0xff); }
Obj FuncCLOSE_PTY_IOSTREAM( Obj self, Obj stream ) { UInt pty = INT_INTOBJ(stream); int status; int retcode; /*UInt count; */ while (!PtyIOStreams[pty].inuse) pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L, "you can replace stream number <num> via 'return <num>;'")); PtyIOStreams[pty].inuse = 0; /* Close down the child */ retcode = close(PtyIOStreams[pty].ptyFD); if (retcode) Pr("Strange close return code %d\n",retcode, 0); kill(PtyIOStreams[pty].childPID, SIGTERM); retcode = waitpid(PtyIOStreams[pty].childPID, &status, 0); FreeStream(pty); return 0; }
int SerializedAlready(Obj obj) { Obj ref = LookupObjMap(TLS(SerializationRegistry), obj); if (ref) { WriteTNum(T_BACKREF); WriteImmediateObj(OBJ_BACKREF(INT_INTOBJ(ref))); return 1; } else { TLS(SerializationIndex)++; AddObjMap(TLS(SerializationRegistry), obj, INTOBJ_INT(TLS(SerializationIndex))); return 0; } }
Obj MPIrecv2( Obj self, Obj args ) { volatile Obj buf, source, tag; /* volatile to satisfy gcc compiler */ int count, sranje; MPI_Comm_rank(MPI_COMM_WORLD, &sranje); MPIARGCHK( 0, 2, MPI_Recv( <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) ); source = ( LEN_LIST(args) > 0 ? ELM_LIST( args, 1 ) : INTOBJ_INT(MPI_ANY_SOURCE) ); tag = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) : INTOBJ_INT(MPI_ANY_TAG) ); MPI_Probe(INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_Get_count(&last_status, MPI_CHAR, &count); buf = NEW_STRING( count); ConvString( buf ); /* Note GET_LEN_STRING() returns GAP string length and strlen(CSTR_STRING()) returns C string length (up to '\0') */ MPI_Recv( CSTR_STRING(buf), GET_LEN_STRING(buf), MPI_CHAR, INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_READ_DONE(); /* if (last_datatype != MPI_CHAR) { MPI_Get_count(&last_status, last_datatype, &count); etc. } */ return buf; }
int SerializedAlready(Obj obj) { Obj ref = LookupObjMap(MODULE_STATE(Serialize).registry, obj); if (ref) { WriteTNum(T_BACKREF); WriteImmediateObj(OBJ_BACKREF(INT_INTOBJ(ref))); return 1; } else { MODULE_STATE(Serialize).index++; AddObjMap(MODULE_STATE(Serialize).registry, obj, INTOBJ_INT(MODULE_STATE(Serialize).index)); return 0; } }
static Obj MPD_INT(Obj self, Obj i) { Obj g; if (IS_INTOBJ(i)) { g = NEW_MPD(8*sizeof(long)); mpd_set_si(MPD_OBJ(g), INT_INTOBJ(i), MPD_RNDNN); } else { Obj f = MPZ_LONGINT(i); g = NEW_MPD(8*sizeof(mp_limb_t)*SIZE_INT(i)); mpfr_set_z(MPD_OBJ(g)->re, mpz_MPZ(f), GMP_RNDN); mpfr_set_ui(MPD_OBJ(g)->im, 0, GMP_RNDN); } return g; }
template<> void SET_INTOBJ(Z_NR<mpz_t> &v, Obj z) { if (IS_INTOBJ(z)) v = INT_INTOBJ(z); else #ifdef FPLLL_VERSION { mpz_t zz; mpz_init(zz); mpz_set(zz, mpz_MPZ(MPZ_LONGINT(z))); v = zz; mpz_clear(zz); } #else mpz_set(v.getData(), mpz_MPZ(MPZ_LONGINT(z))); #endif }
void AddIn( Obj list, Obj w, Obj e ) { Int g, i; Obj r, s, t; for( i = 1; i < LEN_PLIST(w); i += 2 ) { g = INT_INTOBJ( ELM_PLIST( w, i ) ); s = ELM_PLIST( w, i+1 ); C_PROD_FIA( t, s, e ); /* t = s * e */ r = ELM_PLIST( list, g ); C_SUM_FIA( s, t, r ); /* s = r + s * e */ SET_ELM_PLIST( list, g, s ); CHANGED_BAG( list ); } }
/* Changes RSS (Resident Set Size) limit (in bytes) and returns last setting. * Try "ps -elf" or "man ps" for description of RSS. * Try "limit" under csh or "ulimit -a" under bash. */ Obj UNIX_LimitRss( Obj size ) /* size in units of bytes */ { Int oldsize; /* GAP Int is long, and many UNIX's use long */ int success; struct rlimit rlp; #ifdef RLIMIT_RSS getrlimit(RLIMIT_RSS, &rlp); success = getrlimit(RLIMIT_RSS, &rlp); if (success == -1) {perror("UNIX_LimitRss"); return Fail;} oldsize = rlp.rlim_cur; rlp.rlim_cur = INT_INTOBJ(size); success = setrlimit(RLIMIT_RSS, &rlp); if (success == -1) {perror("UNIX_LimitRss"); return Fail;} return INTOBJ_INT(oldsize); #else Pr("WARNING: UNIX_LimitRss: Not supported in this version of UNIX\n", 0L, 0L); return Fail; #endif }
Obj FuncElmWPObj( Obj self, Obj wp, Obj pos) { Obj elm; UInt ipos = INT_INTOBJ(pos); if ( STORED_LEN_WPOBJ(wp) < ipos ) { return Fail; } elm = ELM_WPOBJ(wp,ipos); if (IS_WEAK_DEAD_BAG(elm)) { ELM_WPOBJ(wp,ipos) = 0; return Fail; } if (elm == 0) { return Fail; } return elm; }
Int IsBoundElmWPObj( Obj wp, Obj pos) { UInt ipos = INT_INTOBJ(pos); Obj elm; if ( LengthWPObj(wp) < ipos ) { return 0; } elm = ELM_WPOBJ(wp,ipos); if (IS_WEAK_DEAD_BAG(elm)) { ELM_WPOBJ(wp,ipos) = 0; return 0; } if (elm == 0) { return 0; } return 1; }
static Obj STRING_MPD(Obj self, Obj f, Obj digits) { mp_prec_t prec = mpd_get_prec(GET_MPD(f)); Obj str = NEW_STRING(2*(prec*302/1000+10)+3); int slen = 0, n; TEST_IS_INTOBJ("STRING_MPD",digits); n = INT_INTOBJ(digits); if (n == 1) n = 2; char *c = CSTR_STRING(str); slen += PRINT_MPFR(c+slen, 0, n, GET_MPD(f)->re, GMP_RNDN); c[slen++] = '+'; c[slen++] = 'I'; c[slen++] = '*'; slen += PRINT_MPFR(c+slen, 0, n, MPD_OBJ(f)->im, GMP_RNDN); SET_LEN_STRING(str, slen); SHRINK_STRING(str); return str; }
/**************************************************************************** ** *F RNamObj(<obj>) . . . . . . . . . . . convert an object to a record name ** ** 'RNamObj' returns the record name corresponding to the object <obj>, ** which currently must be a string or an integer. */ UInt RNamObj ( Obj obj ) { /* convert integer object */ if ( IS_INTOBJ(obj) ) { return RNamIntg( INT_INTOBJ(obj) ); } /* convert string object (empty string may have type T_PLIST) */ else if ( IsStringConv(obj) && IS_STRING_REP(obj) ) { return RNamName( CSTR_STRING(obj) ); } /* otherwise fail */ else { obj = ErrorReturnObj( "Record: '<rec>.(<obj>)' <obj> must be a string or an integer", 0L, 0L, "you can replace <obj> via 'return <obj>;'" ); return RNamObj( obj ); } }
static Obj AssRecHandler(Obj self, Obj rec, Obj rnam, Obj obj) { ASS_REC( rec, INT_INTOBJ(rnam), obj ); return 0; }
/* handler for function 3 */ static Obj HdlrFunc3 ( Obj self, Obj a_flags ) { Obj l_with = 0; Obj l_changed = 0; Obj l_imp = 0; Obj l_hash = 0; Obj l_hash2 = 0; Obj l_i = 0; Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; Obj t_4 = 0; Obj t_5 = 0; Obj t_6 = 0; Obj t_7 = 0; Obj t_8 = 0; Obj t_9 = 0; Obj t_10 = 0; Obj t_11 = 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); /* hash := HASH_FLAGS( flags ) mod 11001; */ t_3 = GF_HASH__FLAGS; t_2 = CALL_1ARGS( t_3, a_flags ); CHECK_FUNC_RESULT( t_2 ) t_1 = MOD( t_2, INTOBJ_INT(11001) ); l_hash = t_1; /* for i in [ 0 .. 3 ] do */ for ( t_1 = INTOBJ_INT(0); ((Int)t_1) <= ((Int)INTOBJ_INT(3)); t_1 = (Obj)(((UInt)t_1)+4) ) { l_i = t_1; /* hash2 := 2 * ((hash + 31 * i) mod 11001) + 1; */ C_PROD_INTOBJS( t_6, INTOBJ_INT(31), l_i ) C_SUM_FIA( t_5, l_hash, t_6 ) t_4 = MOD( t_5, INTOBJ_INT(11001) ); C_PROD_FIA( t_3, INTOBJ_INT(2), t_4 ) C_SUM_FIA( t_2, t_3, INTOBJ_INT(1) ) l_hash2 = t_2; /* if IsBound( WITH_IMPS_FLAGS_CACHE[hash2] ) then */ t_4 = GC_WITH__IMPS__FLAGS__CACHE; CHECK_BOUND( t_4, "WITH_IMPS_FLAGS_CACHE" ) CHECK_INT_POS( l_hash2 ) t_3 = C_ISB_LIST( t_4, l_hash2 ); t_2 = (Obj)(UInt)(t_3 != False); if ( t_2 ) { /* if IS_IDENTICAL_OBJ( WITH_IMPS_FLAGS_CACHE[hash2], flags ) then */ t_4 = GF_IS__IDENTICAL__OBJ; t_6 = GC_WITH__IMPS__FLAGS__CACHE; CHECK_BOUND( t_6, "WITH_IMPS_FLAGS_CACHE" ) C_ELM_LIST_FPL( t_5, t_6, l_hash2 ) t_3 = CALL_2ARGS( t_4, t_5, a_flags ); CHECK_FUNC_RESULT( t_3 ) CHECK_BOOL( t_3 ) t_2 = (Obj)(UInt)(t_3 != False); if ( t_2 ) { /* WITH_IMPS_FLAGS_CACHE_HIT := WITH_IMPS_FLAGS_CACHE_HIT + 1; */ t_3 = GC_WITH__IMPS__FLAGS__CACHE__HIT; CHECK_BOUND( t_3, "WITH_IMPS_FLAGS_CACHE_HIT" ) C_SUM_FIA( t_2, t_3, INTOBJ_INT(1) ) AssGVar( G_WITH__IMPS__FLAGS__CACHE__HIT, t_2 ); /* return WITH_IMPS_FLAGS_CACHE[hash2 + 1]; */ t_3 = GC_WITH__IMPS__FLAGS__CACHE; CHECK_BOUND( t_3, "WITH_IMPS_FLAGS_CACHE" ) C_SUM_FIA( t_4, l_hash2, INTOBJ_INT(1) ) CHECK_INT_POS( t_4 ) C_ELM_LIST_FPL( t_2, t_3, t_4 ) RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return t_2; } /* fi */ } /* else */ else { /* break; */ break; } /* fi */ } /* od */ /* if i = 3 then */ t_1 = (Obj)(UInt)(((Int)l_i) == ((Int)INTOBJ_INT(3))); if ( t_1 ) { /* WITH_IMPS_FLAGS_COUNT := (WITH_IMPS_FLAGS_COUNT + 1) mod 4; */ t_3 = GC_WITH__IMPS__FLAGS__COUNT; CHECK_BOUND( t_3, "WITH_IMPS_FLAGS_COUNT" ) C_SUM_FIA( t_2, t_3, INTOBJ_INT(1) ) t_1 = MOD( t_2, INTOBJ_INT(4) ); AssGVar( G_WITH__IMPS__FLAGS__COUNT, t_1 ); /* i := WITH_IMPS_FLAGS_COUNT; */ t_1 = GC_WITH__IMPS__FLAGS__COUNT; CHECK_BOUND( t_1, "WITH_IMPS_FLAGS_COUNT" ) l_i = t_1; /* hash2 := 2 * ((hash + 31 * i) mod 11001) + 1; */ C_PROD_FIA( t_5, INTOBJ_INT(31), l_i ) C_SUM_FIA( t_4, l_hash, t_5 ) t_3 = MOD( t_4, INTOBJ_INT(11001) ); C_PROD_FIA( t_2, INTOBJ_INT(2), t_3 ) C_SUM_FIA( t_1, t_2, INTOBJ_INT(1) ) l_hash2 = t_1; } /* fi */ /* WITH_IMPS_FLAGS_CACHE_MISS := WITH_IMPS_FLAGS_CACHE_MISS + 1; */ t_2 = GC_WITH__IMPS__FLAGS__CACHE__MISS; CHECK_BOUND( t_2, "WITH_IMPS_FLAGS_CACHE_MISS" ) C_SUM_FIA( t_1, t_2, INTOBJ_INT(1) ) AssGVar( G_WITH__IMPS__FLAGS__CACHE__MISS, t_1 ); /* with := flags; */ l_with = a_flags; /* changed := true; */ t_1 = True; l_changed = t_1; /* while changed od */ while ( 1 ) { t_1 = (Obj)(UInt)(l_changed != False); if ( ! t_1 ) break; /* changed := false; */ t_1 = False; l_changed = t_1; /* for imp in IMPLICATIONS do */ t_4 = GC_IMPLICATIONS; CHECK_BOUND( t_4, "IMPLICATIONS" ) if ( IS_SMALL_LIST(t_4) ) { t_3 = (Obj)(UInt)1; t_1 = INTOBJ_INT(1); } else { t_3 = (Obj)(UInt)0; t_1 = CALL_1ARGS( GF_ITERATOR, t_4 ); } while ( 1 ) { if ( t_3 ) { if ( LEN_LIST(t_4) < INT_INTOBJ(t_1) ) break; t_2 = ELMV0_LIST( t_4, INT_INTOBJ(t_1) ); t_1 = (Obj)(((UInt)t_1)+4); if ( t_2 == 0 ) continue; } else { if ( CALL_1ARGS( GF_IS_DONE_ITER, t_1 ) != False ) break; t_2 = CALL_1ARGS( GF_NEXT_ITER, t_1 ); } l_imp = t_2; /* if IS_SUBSET_FLAGS( with, imp[2] ) and not IS_SUBSET_FLAGS( with, imp[1] ) then */ t_8 = GF_IS__SUBSET__FLAGS; C_ELM_LIST_FPL( t_9, l_imp, INTOBJ_INT(2) ) t_7 = CALL_2ARGS( t_8, l_with, t_9 ); CHECK_FUNC_RESULT( t_7 ) CHECK_BOOL( t_7 ) t_6 = (Obj)(UInt)(t_7 != False); t_5 = t_6; if ( t_5 ) { t_10 = GF_IS__SUBSET__FLAGS; C_ELM_LIST_FPL( t_11, l_imp, INTOBJ_INT(1) ) t_9 = CALL_2ARGS( t_10, l_with, t_11 ); CHECK_FUNC_RESULT( t_9 ) CHECK_BOOL( t_9 ) t_8 = (Obj)(UInt)(t_9 != False); t_7 = (Obj)(UInt)( ! ((Int)t_8) ); t_5 = t_7; } if ( t_5 ) { /* with := AND_FLAGS( with, imp[1] ); */ t_6 = GF_AND__FLAGS; C_ELM_LIST_FPL( t_7, l_imp, INTOBJ_INT(1) ) t_5 = CALL_2ARGS( t_6, l_with, t_7 ); CHECK_FUNC_RESULT( t_5 ) l_with = t_5; /* changed := true; */ t_5 = True; l_changed = t_5; } /* fi */ } /* od */ } /* od */ /* WITH_IMPS_FLAGS_CACHE[hash2] := flags; */ t_1 = GC_WITH__IMPS__FLAGS__CACHE; CHECK_BOUND( t_1, "WITH_IMPS_FLAGS_CACHE" ) CHECK_INT_POS( l_hash2 ) C_ASS_LIST_FPL( t_1, l_hash2, a_flags ) /* WITH_IMPS_FLAGS_CACHE[hash2 + 1] := with; */ t_1 = GC_WITH__IMPS__FLAGS__CACHE; CHECK_BOUND( t_1, "WITH_IMPS_FLAGS_CACHE" ) C_SUM_FIA( t_2, l_hash2, INTOBJ_INT(1) ) CHECK_INT_POS( t_2 ) C_ASS_LIST_FPL( t_1, t_2, l_with ) /* return with; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return l_with; /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
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); }
Obj CollectPolycyc ( Obj pcp, Obj list, Obj word ) { Int ngens = INT_INTOBJ( CONST_ADDR_OBJ(pcp)[ PC_NUMBER_OF_GENERATORS ] ); Obj commute = CONST_ADDR_OBJ(pcp)[ PC_COMMUTE ]; Obj gens = CONST_ADDR_OBJ(pcp)[ PC_GENERATORS ]; Obj igens = CONST_ADDR_OBJ(pcp)[ PC_INVERSES ]; Obj pow = CONST_ADDR_OBJ(pcp)[ PC_POWERS ]; Obj ipow = CONST_ADDR_OBJ(pcp)[ PC_INVERSEPOWERS ]; Obj exp = CONST_ADDR_OBJ(pcp)[ PC_EXPONENTS ]; Obj wst = CFTLState()->WORD_STACK; Obj west = CFTLState()->WORD_EXPONENT_STACK; Obj sst = CFTLState()->SYLLABLE_STACK; Obj est = CFTLState()->EXPONENT_STACK; Obj conj=0, iconj=0; /*QQ initialize to please compiler */ Int st; Int g, syl, h, hh; Obj e, ee, ge, mge, we, s, t; Obj w, x = (Obj)0, y = (Obj)0; if( LEN_PLIST(word) == 0 ) return (Obj)0; if( LEN_PLIST(list) < ngens ) { ErrorQuit( "vector too short", 0L, 0L ); return (Obj)0; } if( LEN_PLIST(word) % 2 != 0 ) { ErrorQuit( "Length of word odd", 0L, 0L ); return (Obj)0; } st = 0; PUSH_STACK( word, INTOBJ_INT(1) ); while( st > 0 ) { w = ELM_PLIST( wst, st ); syl = INT_INTOBJ( ELM_PLIST( sst, st ) ); g = INT_INTOBJ( ELM_PLIST( w, syl ) ); if( st > 1 && syl==1 && g == GET_COMMUTE(g) ) { /* Collect word^exponent in one go. */ e = ELM_PLIST( west, st ); /* Add in. */ AddIn( list, w, e ); /* Reduce. */ for( h = g; h <= ngens; h++ ) { s = ELM_PLIST( list, h ); if( IS_INT_ZERO( s ) ) continue; y = (Obj)0; if( (e = GET_EXPONENT( h )) != (Obj)0 ) { if( !LtInt( s, e ) ) { t = ModInt( s, e ); SET_ELM_PLIST( list, h, t ); CHANGED_BAG( list ); if( (y = GET_POWER( h )) ) e = QuoInt( s, e ); } else if( LtInt( s, INTOBJ_INT(0) ) ) { t = ModInt( s, e ); SET_ELM_PLIST( list, h, t ); CHANGED_BAG( list ); if( (y = GET_IPOWER( h )) ) { e = QuoInt( s, e ); if( !IS_INT_ZERO( t ) ) e = DiffInt( e, INTOBJ_INT(1) ); e = AInvInt(e); } } } if( y != (Obj)0 ) AddIn( list, y, e ); } st--; } else { if( g == GET_COMMUTE( g ) ) { s = ELM_PLIST( list, g ); t = ELM_PLIST( est, st ); C_SUM_FIA( ge, s, t ); SET_ELM_PLIST( est, st, INTOBJ_INT(0) ); } else { /* Assume that the top of the exponent stack is non-zero. */ e = ELM_PLIST( est, st ); if( LtInt( INTOBJ_INT(0), e ) ) { C_DIFF_FIA( ee, e, INTOBJ_INT(1) ); e = ee; SET_ELM_PLIST( est, st, e ); CHANGED_BAG( est ); conj = CONST_ADDR_OBJ(pcp)[PC_CONJUGATES]; iconj = CONST_ADDR_OBJ(pcp)[PC_INVERSECONJUGATES]; C_SUM_FIA( ge, ELM_PLIST( list, g ), INTOBJ_INT(1) ); } else { C_SUM_FIA( ee, e, INTOBJ_INT(1) ); e = ee; SET_ELM_PLIST( est, st, e ); CHANGED_BAG( est ); conj = CONST_ADDR_OBJ(pcp)[PC_CONJUGATESINVERSE]; iconj = CONST_ADDR_OBJ(pcp)[PC_INVERSECONJUGATESINVERSE]; C_DIFF_FIA( ge, ELM_PLIST( list, g ), INTOBJ_INT(1) ); } } SET_ELM_PLIST( list, g, ge ); CHANGED_BAG( list ); /* Reduce the exponent. We delay putting the power onto the stack until all the conjugates are on the stack. The power is stored in y, its exponent in ge. */ y = (Obj)0; if( (e = GET_EXPONENT( g )) ) { if( !LtInt( ge, e ) ) { mge = ModInt( ge, e ); SET_ELM_PLIST( list, g, mge ); CHANGED_BAG( list ); if( (y = GET_POWER( g )) ) ge = QuoInt( ge, e ); } else if( LtInt( ge, INTOBJ_INT(0) ) ) { mge = ModInt( ge, e ); SET_ELM_PLIST( list, g, mge ); CHANGED_BAG( list ); if( (y = GET_IPOWER( g )) ) { ge = QuoInt( ge, e ); if( !IS_INT_ZERO( mge ) ) ge = DiffInt( ge, INTOBJ_INT(1) ); ge = AInvInt(ge); } } } hh = h = GET_COMMUTE( g ); /* Find the place where we start to collect. */ for( ; h > g; h-- ) { e = ELM_PLIST( list, h ); if( !IS_INT_ZERO(e) ) { if( LtInt( INTOBJ_INT(0), e ) ) { if( GET_CONJ( h, g ) ) break; } else { if( GET_ICONJ( h, g ) ) break; } } } /* Put those onto the stack, if necessary. */ if( h > g || y != (Obj)0 ) for( ; hh > h; hh-- ) { e = ELM_PLIST( list, hh ); if( !IS_INT_ZERO(e) ) { SET_ELM_PLIST( list, hh, INTOBJ_INT(0) ); if( LtInt( INTOBJ_INT(0), e ) ) { x = ELM_PLIST( gens, hh ); } else { x = ELM_PLIST( igens, hh ); C_PROD_FIA( ee, e, INTOBJ_INT(-1) ); e = ee; } PUSH_STACK( x, e ); } } for( ; h > g; h-- ) { e = ELM_PLIST( list, h ); if( !IS_INT_ZERO(e) ) { SET_ELM_PLIST( list, h, INTOBJ_INT(0) ); x = (Obj)0; if( LtInt( INTOBJ_INT(0), e ) ) x = GET_CONJ( h, g ); else x = GET_ICONJ( h, g ); if( x == (Obj)0 ) { if( LtInt( INTOBJ_INT(0), e ) ) x = ELM_PLIST( gens, h ); else x = ELM_PLIST( igens, h ); } if( LtInt( e, INTOBJ_INT(0) ) ) { C_PROD_FIA( ee, e, INTOBJ_INT(-1) ); e = ee; } PUSH_STACK( x, e ); } } if( y != (Obj)0 ) PUSH_STACK( y, ge ); } while( st > 0 && IS_INT_ZERO( ELM_PLIST( est, st ) ) ) { w = ELM_PLIST( wst, st ); syl = INT_INTOBJ( ELM_PLIST( sst, st ) ) + 2; if( syl > LEN_PLIST( w ) ) { we = DiffInt( ELM_PLIST( west, st ), INTOBJ_INT(1) ); if( EqInt( we, INTOBJ_INT(0) ) ) { st--; } else { SET_ELM_PLIST( west, st, we ); SET_ELM_PLIST( sst, st, INTOBJ_INT(1) ); SET_ELM_PLIST( est, st, ELM_PLIST( w, 2 ) ); CHANGED_BAG( west ); CHANGED_BAG( est ); } } else { SET_ELM_PLIST( sst, st, INTOBJ_INT(syl) ); SET_ELM_PLIST( est, st, ELM_PLIST( w, syl+1 )); CHANGED_BAG( est ); } } } return (Obj)0; }
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; }
template<> void SET_INTOBJ(Z_NR<double> &v, Obj z) { if (IS_INTOBJ(z)) v = INT_INTOBJ(z); else v = mpz_get_d(mpz_MPZ(MPZ_LONGINT(z))); }
template<> void SET_INTOBJ(Z_NR<mpz_t> &v, Obj z) { if (IS_INTOBJ(z)) v = INT_INTOBJ(z); else mpz_set(v.getData(), mpz_MPZ(MPZ_LONGINT(z))); }
int operator()(Obj recval) const { if(!isa(recval)) throw GAPException("Invalid attempt to read int"); return INT_INTOBJ(recval); }
Obj boyers_planarity_check(Obj digraph, int flags, bool krtwsk) { DIGRAPHS_ASSERT(flags == EMBEDFLAGS_PLANAR || flags == EMBEDFLAGS_OUTERPLANAR || flags == EMBEDFLAGS_SEARCHFORK23 || flags == EMBEDFLAGS_SEARCHFORK4 || flags == EMBEDFLAGS_SEARCHFORK33); if (CALL_1ARGS(IsDigraph, digraph) != True) { ErrorQuit("Digraphs: boyers_planarity_check (C): the 1st argument must be " "a digraph, not %s", (Int) TNAM_OBJ(digraph), 0L); } Obj const out = FuncOutNeighbours(0L, digraph); if (FuncIS_ANTISYMMETRIC_DIGRAPH(0L, out) != True) { ErrorQuit("Digraphs: boyers_planarity_check (C): the 1st argument must be " "an antisymmetric digraph", 0L, 0L); } Int V = DigraphNrVertices(digraph); Int E = DigraphNrEdges(digraph); if (V > INT_MAX) { // Cannot currently test this, it might always be true, depending on the // definition of Int. ErrorQuit("Digraphs: boyers_planarity_check (C): the maximum number of " "nodes is %d, found %d", INT_MAX, V); return 0L; } else if (2 * E > INT_MAX) { // Cannot currently test this ErrorQuit("Digraphs: boyers_planarity_check (C): the maximum number of " "edges is %d, found %d", INT_MAX / 2, E); return 0L; } graphP theGraph = gp_New(); switch (flags) { case EMBEDFLAGS_SEARCHFORK33: gp_AttachK33Search(theGraph); break; case EMBEDFLAGS_SEARCHFORK23: gp_AttachK23Search(theGraph); break; case EMBEDFLAGS_SEARCHFORK4: gp_AttachK4Search(theGraph); break; } if (gp_InitGraph(theGraph, V) != OK) { gp_Free(&theGraph); ErrorQuit("Digraphs: boyers_planarity_check (C): invalid number of nodes!", 0L, 0L); return 0L; } else if (gp_EnsureArcCapacity(theGraph, 2 * E) != OK) { gp_Free(&theGraph); ErrorQuit("Digraphs: boyers_planarity_check (C): invalid number of edges!", 0L, 0L); return 0L; } int status; for (Int v = 1; v <= LEN_LIST(out); ++v) { DIGRAPHS_ASSERT(gp_VertexInRange(theGraph, v)); gp_SetVertexIndex(theGraph, v, v); Obj const out_v = ELM_LIST(out, v); for (Int w = 1; w <= LEN_LIST(out_v); ++w) { DIGRAPHS_ASSERT(gp_VertexInRange(theGraph, w)); int u = INT_INTOBJ(ELM_LIST(out_v, w)); if (v != u) { status = gp_AddEdge(theGraph, v, 0, u, 0); if (status != OK) { // Cannot currently test this, i.e. it shouldn't happen (and // currently there is no example where it does happen) gp_Free(&theGraph); ErrorQuit("Digraphs: boyers_planarity_check (C): internal error, " "can't add edge from %d to %d", (Int) v, (Int) u); return 0L; } } } } status = gp_Embed(theGraph, flags); if (status == NOTOK) { // Cannot currently test this, i.e. it shouldn't happen (and // currently there is no example where it does happen) gp_Free(&theGraph); ErrorQuit("Digraphs: boyers_planarity_check (C): status is not ok", 0L, 0L); } Obj res; if (krtwsk) { // Kuratowski subgraph isolator gp_SortVertices(theGraph); Obj subgraph = NEW_PLIST_IMM(T_PLIST, theGraph->N); SET_LEN_PLIST(subgraph, theGraph->N); for (int i = 1; i <= theGraph->N; ++i) { int nr = 0; Obj list = NEW_PLIST_IMM(T_PLIST, 0); int j = theGraph->V[i].link[1]; while (j) { if (CALL_3ARGS(IsDigraphEdge, digraph, INTOBJ_INT((Int) i), INTOBJ_INT((Int) theGraph->E[j].neighbor)) == True) { AssPlist(list, ++nr, INTOBJ_INT(theGraph->E[j].neighbor)); } j = theGraph->E[j].link[1]; } if (nr == 0) { RetypeBag(list, T_PLIST_EMPTY); } SET_ELM_PLIST(subgraph, i, list); CHANGED_BAG(subgraph); } res = NEW_PLIST_IMM(T_PLIST, 2); SET_LEN_PLIST(res, 2); SET_ELM_PLIST(res, 1, (status == NONEMBEDDABLE ? False : True)); SET_ELM_PLIST(res, 2, subgraph); CHANGED_BAG(res); } else if (status == NONEMBEDDABLE) { res = False; } else { res = True; } gp_Free(&theGraph); return res; }
/* handler for function 2 */ static Obj HdlrFunc2 ( Obj self, Obj a_filter ) { Obj l_i = 0; Obj l_flags = 0; Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; Obj t_4 = 0; Obj t_5 = 0; Obj t_6 = 0; Obj t_7 = 0; Obj t_8 = 0; Obj t_9 = 0; Obj t_10 = 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); /* flags := FLAGS_FILTER( filter ); */ t_2 = GF_FLAGS__FILTER; t_1 = CALL_1ARGS( t_2, a_filter ); CHECK_FUNC_RESULT( t_1 ) l_flags = t_1; /* for i in [ 1, 3 .. LEN_LIST( WITH_HIDDEN_IMPS_FLAGS_CACHE ) - 1 ] do */ t_7 = GF_LEN__LIST; t_8 = GC_WITH__HIDDEN__IMPS__FLAGS__CACHE; CHECK_BOUND( t_8, "WITH_HIDDEN_IMPS_FLAGS_CACHE" ) t_6 = CALL_1ARGS( t_7, t_8 ); CHECK_FUNC_RESULT( t_6 ) C_DIFF_FIA( t_5, t_6, INTOBJ_INT(1) ) t_4 = Range3Check( INTOBJ_INT(1), INTOBJ_INT(3), t_5 ); if ( IS_SMALL_LIST(t_4) ) { t_3 = (Obj)(UInt)1; t_1 = INTOBJ_INT(1); } else { t_3 = (Obj)(UInt)0; t_1 = CALL_1ARGS( GF_ITERATOR, t_4 ); } while ( 1 ) { if ( t_3 ) { if ( LEN_LIST(t_4) < INT_INTOBJ(t_1) ) break; t_2 = ELMV0_LIST( t_4, INT_INTOBJ(t_1) ); t_1 = (Obj)(((UInt)t_1)+4); if ( t_2 == 0 ) continue; } else { if ( CALL_1ARGS( GF_IS_DONE_ITER, t_1 ) != False ) break; t_2 = CALL_1ARGS( GF_NEXT_ITER, t_1 ); } l_i = t_2; /* if IsBound( WITH_HIDDEN_IMPS_FLAGS_CACHE[i] ) then */ t_7 = GC_WITH__HIDDEN__IMPS__FLAGS__CACHE; CHECK_BOUND( t_7, "WITH_HIDDEN_IMPS_FLAGS_CACHE" ) CHECK_INT_POS( l_i ) t_6 = C_ISB_LIST( t_7, l_i ); t_5 = (Obj)(UInt)(t_6 != False); if ( t_5 ) { /* if IS_SUBSET_FLAGS( WITH_HIDDEN_IMPS_FLAGS_CACHE[i + 1], flags ) then */ t_7 = GF_IS__SUBSET__FLAGS; t_9 = GC_WITH__HIDDEN__IMPS__FLAGS__CACHE; CHECK_BOUND( t_9, "WITH_HIDDEN_IMPS_FLAGS_CACHE" ) C_SUM_FIA( t_10, l_i, INTOBJ_INT(1) ) CHECK_INT_POS( t_10 ) C_ELM_LIST_FPL( t_8, t_9, t_10 ) t_6 = CALL_2ARGS( t_7, t_8, l_flags ); CHECK_FUNC_RESULT( t_6 ) CHECK_BOOL( t_6 ) t_5 = (Obj)(UInt)(t_6 != False); if ( t_5 ) { /* Unbind( WITH_HIDDEN_IMPS_FLAGS_CACHE[i] ); */ t_5 = GC_WITH__HIDDEN__IMPS__FLAGS__CACHE; CHECK_BOUND( t_5, "WITH_HIDDEN_IMPS_FLAGS_CACHE" ) C_UNB_LIST( t_5, l_i ); /* Unbind( WITH_HIDDEN_IMPS_FLAGS_CACHE[i + 1] ); */ t_5 = GC_WITH__HIDDEN__IMPS__FLAGS__CACHE; CHECK_BOUND( t_5, "WITH_HIDDEN_IMPS_FLAGS_CACHE" ) C_SUM_FIA( t_6, l_i, INTOBJ_INT(1) ) CHECK_INT_POS( t_6 ) C_UNB_LIST( t_5, t_6 ); } /* fi */ } /* fi */ } /* od */ /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
/* handler for function 4 */ static Obj HdlrFunc4 ( Obj self, Obj a_filter ) { Obj l_rank = 0; Obj l_flags = 0; Obj l_i = 0; Obj t_1 = 0; Obj t_2 = 0; Obj t_3 = 0; Obj t_4 = 0; Obj t_5 = 0; Obj t_6 = 0; Obj t_7 = 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); /* rank := 0; */ l_rank = INTOBJ_INT(0); /* if IS_FUNCTION( filter ) then */ t_3 = GF_IS__FUNCTION; t_2 = CALL_1ARGS( t_3, a_filter ); CHECK_FUNC_RESULT( t_2 ) CHECK_BOOL( t_2 ) t_1 = (Obj)(UInt)(t_2 != False); if ( t_1 ) { /* flags := FLAGS_FILTER( filter ); */ t_2 = GF_FLAGS__FILTER; t_1 = CALL_1ARGS( t_2, a_filter ); CHECK_FUNC_RESULT( t_1 ) l_flags = t_1; } /* else */ else { /* flags := filter; */ l_flags = a_filter; } /* fi */ /* for i in TRUES_FLAGS( WITH_HIDDEN_IMPS_FLAGS( flags ) ) do */ t_5 = GF_TRUES__FLAGS; t_7 = GF_WITH__HIDDEN__IMPS__FLAGS; t_6 = CALL_1ARGS( t_7, l_flags ); CHECK_FUNC_RESULT( t_6 ) t_4 = CALL_1ARGS( t_5, t_6 ); CHECK_FUNC_RESULT( t_4 ) if ( IS_SMALL_LIST(t_4) ) { t_3 = (Obj)(UInt)1; t_1 = INTOBJ_INT(1); } else { t_3 = (Obj)(UInt)0; t_1 = CALL_1ARGS( GF_ITERATOR, t_4 ); } while ( 1 ) { if ( t_3 ) { if ( LEN_LIST(t_4) < INT_INTOBJ(t_1) ) break; t_2 = ELMV0_LIST( t_4, INT_INTOBJ(t_1) ); t_1 = (Obj)(((UInt)t_1)+4); if ( t_2 == 0 ) continue; } else { if ( CALL_1ARGS( GF_IS_DONE_ITER, t_1 ) != False ) break; t_2 = CALL_1ARGS( GF_NEXT_ITER, t_1 ); } l_i = t_2; /* if IsBound( RANK_FILTERS[i] ) then */ t_7 = GC_RANK__FILTERS; CHECK_BOUND( t_7, "RANK_FILTERS" ) CHECK_INT_POS( l_i ) t_6 = C_ISB_LIST( t_7, l_i ); t_5 = (Obj)(UInt)(t_6 != False); if ( t_5 ) { /* rank := rank + RANK_FILTERS[i]; */ t_7 = GC_RANK__FILTERS; CHECK_BOUND( t_7, "RANK_FILTERS" ) C_ELM_LIST_FPL( t_6, t_7, l_i ) C_SUM_FIA( t_5, l_rank, t_6 ) l_rank = t_5; } /* else */ else { /* rank := rank + 1; */ C_SUM_FIA( t_5, l_rank, INTOBJ_INT(1) ) l_rank = t_5; } /* fi */ } /* od */ /* return rank; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return l_rank; /* return; */ RES_BRK_CURR_STAT(); SWITCH_TO_OLD_FRAME(oldFrame); return 0; }
Obj SCTableEntryHandler ( Obj self, Obj table, Obj i, Obj j, Obj k ) { Obj tmp; /* temporary */ Obj basis; /* basis list */ Obj coeffs; /* coeffs list */ Int dim; /* dimension */ Int len; /* length of basis/coeffs lists */ Int l; /* loop variable */ /* check the table */ if ( ! IS_SMALL_LIST(table) ) { table = ErrorReturnObj( "SCTableEntry: <table> must be a small list (not a %s)", (Int)TNAM_OBJ(table), 0L, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } dim = LEN_LIST(table) - 2; if ( dim <= 0 ) { table = ErrorReturnObj( "SCTableEntry: <table> must be a list with at least 3 elements", 0L, 0L, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* check <i> */ if ( ! IS_INTOBJ(i) || INT_INTOBJ(i) <= 0 || dim < INT_INTOBJ(i) ) { i = ErrorReturnObj( "SCTableEntry: <i> must be an integer between 0 and %d", dim, 0L, "you can replace <i> via 'return <i>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* get and check the relevant row */ tmp = ELM_LIST( table, INT_INTOBJ(i) ); if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != dim ) { table = ErrorReturnObj( "SCTableEntry: <table>[%d] must be a list with %d elements", INT_INTOBJ(i), dim, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* check <j> */ if ( ! IS_INTOBJ(j) || INT_INTOBJ(j) <= 0 || dim < INT_INTOBJ(j) ) { j = ErrorReturnObj( "SCTableEntry: <j> must be an integer between 0 and %d", dim, 0L, "you can replace <j> via 'return <j>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* get and check the basis and coefficients list */ tmp = ELM_LIST( tmp, INT_INTOBJ(j) ); if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != 2 ) { table = ErrorReturnObj( "SCTableEntry: <table>[%d][%d] must be a basis/coeffs list", 0L, 0L, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* get and check the basis list */ basis = ELM_LIST( tmp, 1 ); if ( ! IS_SMALL_LIST(basis) ) { table = ErrorReturnObj( "SCTableEntry: <table>[%d][%d][1] must be a basis list", 0L, 0L, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* get and check the coeffs list */ coeffs = ELM_LIST( tmp, 2 ); if ( ! IS_SMALL_LIST(coeffs) ) { table = ErrorReturnObj( "SCTableEntry: <table>[%d][%d][2] must be a coeffs list", 0L, 0L, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* check that they have the same length */ len = LEN_LIST(basis); if ( LEN_LIST(coeffs) != len ) { table = ErrorReturnObj( "SCTableEntry: <table>[%d][%d][1], ~[2] must have equal length", 0L, 0L, "you can replace <table> via 'return <table>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* check <k> */ if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) { k = ErrorReturnObj( "SCTableEntry: <k> must be an integer between 0 and %d", dim, 0L, "you can replace <k> via 'return <k>;'" ); return SCTableEntryHandler( self, table, i, j, k ); } /* look for the (i,j,k) entry */ for ( l = 1; l <= len; l++ ) { if ( EQ( ELM_LIST( basis, l ), k ) ) break; } /* return the coefficient of zero */ if ( l <= len ) { return ELM_LIST( coeffs, l ); } else { return ELM_LIST( table, dim+2 ); } }
static Obj UnbRecHandler(Obj self, Obj rec, Obj rnam) { UNB_REC( rec, INT_INTOBJ(rnam) ); return 0; }