Exemple #1
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;
}
Exemple #2
0
static void WriteBytesNativeString(void *addr, UInt count) {
  Obj target = TLS(SerializationObj);
  UInt size = GET_LEN_STRING(target);
  GROW_STRING(target, size + count + 1);
  memcpy(CSTR_STRING(target) + size, addr, count);
  SET_LEN_STRING(target, size + count);
}
Exemple #3
0
static void WriteBytesNativeString(void * addr, UInt count)
{
    Obj  target = MODULE_STATE(Serialize).obj;
    UInt size = GET_LEN_STRING(target);
    GROW_STRING(target, size + count + 1);
    memcpy(CSTR_STRING(target) + size, addr, count);
    SET_LEN_STRING(target, size + count);
}
Exemple #4
0
static UInt ReadByteBlockLengthNativeString() {
  UInt len;
  ReadBytesNativeString(&len, sizeof(len));
  /* The following is to prevent out-of-memory errors on malformed input,
   * where incorrect values can result in huge length values: */
  if (len + TLS(SerializationIndex) > GET_LEN_STRING(TLS(SerializationObj)))
    DeserializationError();
  return len;
}
Exemple #5
0
static void ReadBytesNativeString(void *addr, UInt size) {
  Obj str = TLS(SerializationObj);
  UInt max = GET_LEN_STRING(str);
  UInt off = TLS(SerializationIndex);
  if (off + size > max)
    DeserializationError();
  memcpy(addr, CSTR_STRING(str)+off, size);
  TLS(SerializationIndex) += size;
}
Exemple #6
0
static void ReadBytesNativeString(void * addr, UInt size)
{
    Obj  str = MODULE_STATE(Serialize).obj;
    UInt max = GET_LEN_STRING(str);
    UInt off = MODULE_STATE(Serialize).index;
    if (off + size > max)
        DeserializationError();
    memcpy(addr, CONST_CSTR_STRING(str) + off, size);
    MODULE_STATE(Serialize).index += size;
}
Exemple #7
0
static Obj MPD_STRING(Obj self, Obj s, Obj prec)
{
  while (!IsStringConv(s))
    {
      s = ErrorReturnObj("MPD_STRING: object to be converted must be a string, not a %s",
			 (Int)TNAM_OBJ(s),0,
			 "You can return a string to continue" );
    }
  TEST_IS_INTOBJ("MPD_STRING",prec);
  int n = INT_INTOBJ(prec);
  if (n == 0)
    n = GET_LEN_STRING(s)*1000 / 301;

  Obj g = NEW_MPD(INT_INTOBJ(prec));
  char *p = (char *) CHARS_STRING(s), *newp;
  int sign = 1;
  mpd_set_ui(MPD_OBJ(g), 0, MPD_RNDNN);
  mpfr_ptr f = MPD_OBJ(g)->re;
  Obj newg = NEW_MPFR(INT_INTOBJ(prec));

  for (;;) {
    printf("<%c>",*p);
    switch (*p) {
    case '-':
    case '+':
    case 0:
      if (!mpfr_nan_p(MPFR_OBJ(newg))) { /* drop the last read float */
	mpfr_add (f, f, MPFR_OBJ(newg), GMP_RNDN);
	mpfr_set_nan (MPFR_OBJ(newg));
	f = MPD_OBJ(g)->re;
	sign = 1;
      }
      if (!*p)
	return g;
      if (*p == '-')
	sign = -sign;
    case '*': p++; break;
    case 'i':
    case 'I': if (f == GET_MPD(g)->re) {
	f = MPD_OBJ(g)->im;
	if (mpfr_nan_p(MPFR_OBJ(newg)))
	  mpfr_set_si (MPFR_OBJ(newg), sign, GMP_RNDN); /* accept 'i' as '1*i' */
      } else return Fail;
      p++; break;
    default:
      mpfr_strtofr(MPFR_OBJ(newg), p, &newp, 10, GMP_RNDN);
      if (newp == p && f != GET_MPD(g)->im)
	return Fail; /* no valid characters read */
      if (sign == -1)
	mpfr_neg(MPFR_OBJ(newg), MPFR_OBJ(newg), GMP_RNDN);
      p = newp;
    }
  }
  return g;
}
Exemple #8
0
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;
}
Exemple #9
0
Obj MPIget_processor_name( Obj self )
{ int resultlen;
  Obj str;
  /* It was reported by Frank Celler that a value of 72 instead of 1024 below
     caused overwriting of the free block list on PC in GAP-3 */
  str = NEW_STRING( 1024 );
  MPI_Get_processor_name( (char*)CSTR_STRING(str), &resultlen);
  ((char*)CSTR_STRING(str))[resultlen] = '\0';
#ifndef PRE_GAP_4_3
  SET_LEN_STRING(str, resultlen);
  ResizeBag( str, SIZEBAG_STRINGLEN( GET_LEN_STRING(str) ) );
#endif
  return str;
}
Exemple #10
0
Obj FuncMACFLOAT_STRING( Obj self, Obj s )
{

    while (!IsStringConv(s))
    {
        s = ErrorReturnObj("MACFLOAT_STRING: object to be converted must be a string not a %s",
                           (Int)(InfoBags[TNUM_OBJ(s)].name),0,"You can return a string to continue" );
    }
    char * endptr;
    UChar *sp = CHARS_STRING(s);
    Obj res= NEW_MACFLOAT((Double) STRTOD((char *)sp,&endptr));
    if ((UChar *)endptr != sp + GET_LEN_STRING(s))
        return Fail;
    return res;
}
Exemple #11
0
/****************************************************************************
**
*F  AppendBufToString()
**
**  Append 'bufsize' bytes from the string buffer 'buf' to the string object
**  'string'. If 'string' is 0, then a new string object is allocated first.
**
**  The string object is returned at the end, regardless of whether it was
**  given as an argument, or created from scratch.
**
*/
static Obj AppendBufToString(Obj string, const char * buf, UInt bufsize)
{
    char *s;
    if (string == 0) {
        string = NEW_STRING(bufsize);
        s = CSTR_STRING(string);
    }
    else {
        const UInt len = GET_LEN_STRING(string);
        GROW_STRING(string, len + bufsize);
        SET_LEN_STRING(string, len + bufsize);
        s = CSTR_STRING(string) + len;
    }
    memcpy(s, buf, bufsize);
    s[bufsize] = '\0';
    return string;
}
Exemple #12
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;
}
Exemple #13
0
static void ReserveBytesNativeString(UInt count) {
  Obj target = TLS(SerializationObj);
  UInt size = GET_LEN_STRING(target);
  GROW_STRING(target, size + count + 1);
}
Exemple #14
0
UInt GAP_LenString(Obj obj)
{
    return GET_LEN_STRING(obj);
}
Exemple #15
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);
}
Exemple #16
0
static UInt GetNumber(Int readDecimalPoint)
{
  UInt symbol = S_ILLEGAL;
  UInt i = 0;
  Char c;
  UInt seenADigit = 0;
  UInt seenExp = 0;
  UInt seenExpDigit = 0;

  STATE(ValueObj) = 0;

  c = PEEK_CURR_CHAR();
  if (readDecimalPoint) {
    STATE(Value)[i++] = '.';
  }
  else {
    // read initial sequence of digits into 'Value'
    while (IsDigit(c)) {
      i = AddCharToValue(i, c);
      seenADigit = 1;
      c = GET_NEXT_CHAR();
    }

    // maybe we saw an identifier character and realised that this is an
    // identifier we are reading
    if (IsIdent(c) || c == '\\') {
      // if necessary, copy back from STATE(ValueObj) to STATE(Value)
      if (STATE(ValueObj)) {
        i = GET_LEN_STRING(STATE(ValueObj));
        GAP_ASSERT(i >= MAX_VALUE_LEN - 1);
        memcpy(STATE(Value), CONST_CSTR_STRING(STATE(ValueObj)), MAX_VALUE_LEN);
        STATE(ValueObj) = 0;
      }
      // this looks like an identifier, scan the rest of it
      return GetIdent(i);
    }

    // Or maybe we saw a '.' which could indicate one of two things: a
    // float literal or S_DOT, i.e., '.' used to access a record entry.
    if (c == '.') {
      GAP_ASSERT(i < MAX_VALUE_LEN - 1);

      // If the symbol before this integer was S_DOT then we must be in
      // a nested record element expression, so don't look for a float.
      // This is a bit fragile
      if (STATE(Symbol) == S_DOT || STATE(Symbol) == S_BDOT) {
        symbol = S_INT;
        goto finish;
      }

      // peek ahead to decide which
      if (PEEK_NEXT_CHAR() == '.') {
        // It was '.', so this looks like '..' and we are probably
        // inside a range expression.
        symbol = S_INT;
        goto finish;
      }

      // Now the '.' must be part of our number; store it and move on
      i = AddCharToValue(i, '.');
      c = GET_NEXT_CHAR();
    }

    else {
      // Anything else we see tells us that the token is done
      symbol = S_INT;
      goto finish;
    }
  }


  // When we get here we have read possibly some digits, a . and possibly
  // some more digits, but not an e,E,d,D,q or Q

    // read digits
    while (IsDigit(c)) {
      i = AddCharToValue(i, c);
      seenADigit = 1;
      c = GET_NEXT_CHAR();
    }
    if (!seenADigit)
      SyntaxError("Badly formed number: need a digit before or after the "
                  "decimal point");
    if (c == '\\')
      SyntaxError("Badly formed number");

    // If we found an identifier type character in this context could be an
    // error or the start of one of the allowed trailing marker sequences
    if (IsIdent(c) && c != 'e' && c != 'E' && c != 'd' && c != 'D' &&
        c != 'q' && c != 'Q') {

      // Allow one letter on the end of the numbers -- could be an i, C99
      // style
      if (IsAlpha(c)) {
        i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
      }
      // independently of that, we allow an _ signalling immediate conversion
      if (c == '_') {
        i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
        // After which there may be one character signifying the
        // conversion style
        if (IsAlpha(c)) {
          i = AddCharToValue(i, c);
          c = GET_NEXT_CHAR();
        }
      }
      // Now if the next character is alphanumerical, or an identifier type
      // symbol then we really do have an error, otherwise we return a result
      if (IsIdent(c) || IsDigit(c)) {
        SyntaxError("Badly formed number");
      }
      else {
        symbol = S_FLOAT;
        goto finish;
      }
    }

    // If the next thing is the start of the exponential notation, read it now.

    if (IsAlpha(c)) {
      if (!seenADigit)
        SyntaxError("Badly formed number: need a digit before or after "
                    "the decimal point");
      seenExp = 1;
      i = AddCharToValue(i, c);
      c = GET_NEXT_CHAR();
      if (c == '+' || c == '-') {
        i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
      }
    }

    // Either we saw an exponent indicator, or we hit end of token deal with
    // the end of token case
    if (!seenExp) {
      if (!seenADigit)
        SyntaxError("Badly formed number: need a digit before or after "
                    "the decimal point");
      // Might be a conversion marker
      if (IsAlpha(c) && c != 'e' && c != 'E' && c != 'd' && c != 'D' &&
          c != 'q' && c != 'Q') {
        i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
      }
      // independently of that, we allow an _ signalling immediate conversion
      if (c == '_') {
        i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
        // After which there may be one character signifying the
        // conversion style
        if (IsAlpha(c))
          i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
      }
      // Now if the next character is alphanumerical, or an identifier type
      // symbol then we really do have an error, otherwise we return a result
      if (!IsIdent(c) && !IsDigit(c)) {
        symbol = S_FLOAT;
        goto finish;
      }
      SyntaxError("Badly formed number");
    }

  // Here we are into the unsigned exponent of a number in scientific
  // notation, so we just read digits

  while (IsDigit(c)) {
    i = AddCharToValue(i, c);
    seenExpDigit = 1;
    c = GET_NEXT_CHAR();
  }

  // Look out for a single alphabetic character on the end
  // which could be a conversion marker
  if (seenExpDigit) {
    if (IsAlpha(c)) {
      i = AddCharToValue(i, c);
      c = GET_NEXT_CHAR();
      symbol = S_FLOAT;
      goto finish;
    }
    if (c == '_') {
      i = AddCharToValue(i, c);
      c = GET_NEXT_CHAR();
      // After which there may be one character signifying the
      // conversion style
      if (IsAlpha(c)) {
        i = AddCharToValue(i, c);
        c = GET_NEXT_CHAR();
      }
      symbol = S_FLOAT;
      goto finish;
    }
  }

  // Otherwise this is the end of the token
  if (!seenExpDigit)
    SyntaxError(
        "Badly formed number: need at least one digit in the exponent");
  symbol = S_FLOAT;

finish:
  i = AddCharToValue(i, '\0');
  if (STATE(ValueObj)) {
    // flush buffer
    AppendBufToString(STATE(ValueObj), STATE(Value), i - 1);
  }
  return symbol;
}
Exemple #17
0
static inline int EqString(Obj str, const Char * name, UInt len)
{
    if (GET_LEN_STRING(str) != len)
        return 0;
    return memcmp(CONST_CSTR_STRING(str), name, len) == 0;
}