Esempio n. 1
0
/****************************************************************************
**
*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 );
    }
}
Esempio n. 2
0
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);
}
Esempio n. 3
0
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;
}
Esempio n. 4
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);
}
Esempio n. 5
0
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;
}
Esempio n. 6
0
	SpriteObject::SpriteObject(const char* path, RenderSystem* renderSystem) throw(IOError) :
		m_Sprite(NULL),
		renderSystem(renderSystem)
	{
		try
		{
			loadFromFile(path);
		}
		catch (const IOError& e)
		{
			ErrorQuit(e);
		}
	}
Esempio n. 7
0
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);
  }
}
Esempio n. 8
0
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;
}
Esempio n. 9
0
static void DeserializationError() {
  ErrorQuit("Bad deserialization input", 0L, 0L);
}
Esempio n. 10
0
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;
}
Esempio n. 11
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);
}
Esempio n. 12
0
File: records.c Progetto: vbraun/gap
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);
}