/**************************************************************************** ** *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 ); } }
void HandleChildStatusChanges( UInt pty) { /* common error handling, when we are asked to read or write to a stopped or dead child */ HashLock(PtyIOStreams); if (PtyIOStreams[pty].alive == 0) { PtyIOStreams[pty].changed = 0; PtyIOStreams[pty].blocked = 0; HashUnlock(PtyIOStreams); ErrorQuit("Child Process is unexpectedly dead", (Int) 0L, (Int) 0L); return; } if (PtyIOStreams[pty].blocked) { HashUnlock(PtyIOStreams); ErrorQuit("Child Process is still dead", (Int)0L,(Int)0L); return; } if (PtyIOStreams[pty].changed) { PtyIOStreams[pty].blocked = 1; PtyIOStreams[pty].changed = 0; Int cPID = PtyIOStreams[pty].childPID; Int status = PtyIOStreams[pty].status; HashUnlock(PtyIOStreams); ErrorQuit("Child Process %d has stopped or died, status %d", cPID, status); return; } HashUnlock(PtyIOStreams); }
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; }
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); }
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; }
SpriteObject::SpriteObject(const char* path, RenderSystem* renderSystem) throw(IOError) : m_Sprite(NULL), renderSystem(renderSystem) { try { loadFromFile(path); } catch (const IOError& e) { ErrorQuit(e); } }
void HandleChildStatusChanges( UInt pty) { /* common error handling, when we are asked to read or write to a stopped or dead child */ if (PtyIOStreams[pty].alive == 0) { PtyIOStreams[pty].changed = 0; PtyIOStreams[pty].blocked = 0; ErrorQuit("Child Process is unexpectedly dead", (Int) 0L, (Int) 0L); } if (PtyIOStreams[pty].blocked) { ErrorQuit("Child Process is still dead", (Int)0L,(Int)0L); } if (PtyIOStreams[pty].changed) { PtyIOStreams[pty].blocked = 1; PtyIOStreams[pty].changed = 0; ErrorQuit("Child Process %d has stopped or died, status %d", (Int) PtyIOStreams[pty].childPID, (Int) PtyIOStreams[pty].status); } }
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; }
static void DeserializationError() { ErrorQuit("Bad deserialization input", 0L, 0L); }
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; }
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); }
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); }