Obj MPIrecv( Obj self, Obj args ) { volatile Obj buf, source, tag; /* volatile to satisfy gcc compiler */ MPIARGCHK( 1, 3, MPI_Recv( <string buf>, <opt int source = MPI_ANY_SOURCE>[, <opt int tag = MPI_ANY_TAG> ] ) ); buf = ELM_LIST( args, 1 ); source = ( LEN_LIST(args) > 1 ? ELM_LIST( args, 2 ) : INTOBJ_INT(MPI_ANY_SOURCE) ); tag = ( LEN_LIST(args) > 2 ? ELM_LIST( args, 3 ) : INTOBJ_INT(MPI_ANY_TAG) ); if ( ! IS_STRING( buf ) ) ErrorQuit("MPI_Recv(): received a buffer that is not a string", 0L, 0L); ConvString( buf ); /* Note GET_LEN_STRING() returns GAP string length and strlen(CSTR_STRING()) returns C string length (up to '\0') */ if ( ! MPI_READ_ERROR() ) MPI_Recv( CSTR_STRING(buf), GET_LEN_STRING(buf), last_datatype=MPIdatatype_infer(buf), INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_READ_DONE(); if ( ! IS_STRING( buf ) ) { /* CLEAN THIS UP LATER */ ErrorQuit("ParGAP: panic: MPI_Recv(): result buffer is not a string", 0L, 0L); exit(1); } /* if (last_datatype != MPI_CHAR) { MPI_Get_count(&last_status, last_datatype, &count); etc. } */ return buf; }
/**************************************************************************** ** *F SCTableProduct( <table>, <list1>, <list2> ) . product wrt structure table ** ** 'SCTableProduct' returns the product of the two elements <list1> and ** <list2> with respect to the structure constants table <table>. */ void SCTableProdAdd ( Obj res, Obj coeff, Obj basis_coeffs, Int dim ) { Obj basis; Obj coeffs; Int len; Obj k; Obj c1, c2; Int l; basis = ELM_LIST( basis_coeffs, 1 ); coeffs = ELM_LIST( basis_coeffs, 2 ); len = LEN_LIST( basis ); if ( LEN_LIST( coeffs ) != len ) { ErrorQuit("SCTableProduct: corrupted <table>",0L,0L); } for ( l = 1; l <= len; l++ ) { k = ELM_LIST( basis, l ); if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) { ErrorQuit("SCTableProduct: corrupted <table>",0L,0L); } c1 = ELM_LIST( coeffs, l ); c1 = PROD( coeff, c1 ); c2 = ELM_PLIST( res, INT_INTOBJ(k) ); c2 = SUM( c2, c1 ); SET_ELM_PLIST( res, INT_INTOBJ(k), c2 ); CHANGED_BAG( res ); } }
std::pair<T,U> operator()(Obj rec) const { if(!isa(rec)) throw GAPException("Invalid attempt to read pair"); GAP_getter<T> get_T; GAP_getter<U> get_U; std::pair<T,U> p(get_T(ELM_LIST(rec, 1)), get_U(ELM_LIST(rec, 2))); return p; }
Obj MPIprobe( Obj self, Obj args ) { volatile Obj source, tag; /* volatile to satisfy gcc compiler */ MPIARGCHK( 0, 2, MPI_Probe( <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) ); if ( ! MPI_READ_ERROR() ) MPI_Probe(INT_INTOBJ(source), INT_INTOBJ(tag), MPI_COMM_WORLD, &last_status); MPI_READ_DONE(); return True; }
Obj MPIsend( Obj self, Obj args ) { Obj buf, dest, tag; MPIARGCHK(2, 3, MPI_Send( <string buf>, <int dest>[, <opt int tag = 0> ] )); buf = ELM_LIST( args, 1 ); dest = ELM_LIST( args, 2 ); tag = ( LEN_LIST(args) > 2 ? ELM_LIST( args, 3 ) : 0 ); ConvString( buf ); MPI_Send( ((char*)CSTR_STRING(buf)), strlen((const Char*)CSTR_STRING(buf)), /* don't incl. \0 */ MPIdatatype_infer(buf), INT_INTOBJ(dest), INT_INTOBJ(tag), MPI_COMM_WORLD); return 0; }
Obj MPIbinsend( Obj self, Obj args ) { Obj buf, dest, tag, size; int s,i; MPIARGCHK(3, 4, MPI_Binsend( <string buf>, <int dest>, <int size>, [, <opt int tag = 0> ] )); buf = ELM_LIST( args, 1 ); dest = ELM_LIST( args, 2 ); size = ELM_LIST (args, 3); tag = ( LEN_LIST(args) > 3 ? ELM_LIST( args, 4 ) : 0 ); s = MPI_Send( ((char*)CSTR_STRING(buf)), INT_INTOBJ(size), /* don't incl. \0 */ MPI_CHAR, INT_INTOBJ(dest), INT_INTOBJ(tag), MPI_COMM_WORLD); return 0; }
Obj FuncCREATE_PTY_IOSTREAM( Obj self, Obj dir, Obj prog, Obj args ) { Obj allargs[MAX_ARGS+1]; Char *argv[MAX_ARGS+2]; UInt i,len; Int pty; len = LEN_LIST(args); if (len > MAX_ARGS) ErrorQuit("Too many arguments",0,0); ConvString(dir); ConvString(prog); for (i = 1; i <=len; i++) { allargs[i] = ELM_LIST(args,i); ConvString(allargs[i]); } /* From here we cannot afford to have a garbage collection */ argv[0] = CSTR_STRING(prog); for (i = 1; i <=len; i++) { argv[i] = CSTR_STRING(allargs[i]); } argv[i] = (Char *)0; pty = StartChildProcess( CSTR_STRING(dir) , CSTR_STRING(prog), argv ); if (pty < 0) return Fail; else return INTOBJ_INT(pty); }
int getOrbitStart() const { // printf("getOrbitStart."); Obj o = ELM_REC(sc, RName_orbit); // ELM_REC(sc, RName_orbit); printf("!\n"); return GAP_get<int>(ELM_LIST(o, 1)); }
MPI_Datatype MPIdatatype_infer(Obj object) { if ( IS_STRING(object) ) return MPI_CHAR; /* Maybe any other kind of GAP list should assume a list of int's coming */ if ( IS_HOMOG_LIST(object) && IS_INTOBJ(ELM_LIST(object, 1) ) ) return MPI_INT; ErrorQuit("bad vector passed for message handling; must be string or gen. vec.", 0L,0L); 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; }
Con fill_container(Obj rec) { if(!(IS_SMALL_LIST(rec))) throw GAPException("Invalid attempt to read list"); int len = LEN_LIST(rec); Con v; typedef typename Con::value_type T; GAP_getter<T> getter; for(int i = 1; i <= len; ++i) { v.push_back(getter(ELM_LIST(rec, i))); } return v; }
Con fill_optional_container(Obj rec) { if(!(IS_SMALL_LIST(rec))) throw GAPException("Invalid attempt to read list"); int len = LEN_LIST(rec); Con v; GAP_getter<T> getter; for(int i = 1; i <= len; ++i) { if(ISB_LIST(rec, i)) { v.push_back(getter(ELM_LIST(rec, i))); } else { v.push_back(optional<T>()); } } return v; }
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 ); } }
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; }
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; }