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;
}
