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;
}
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);
}
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);
}
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;
}
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;
}
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;
}
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;
}
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;
}
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;
}
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;
}
/****************************************************************************
**
*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;
}
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;
}
static void ReserveBytesNativeString(UInt count) {
Obj target = TLS(SerializationObj);
UInt size = GET_LEN_STRING(target);
GROW_STRING(target, size + count + 1);
}
UInt GAP_LenString(Obj obj)
{
return GET_LEN_STRING(obj);
}
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);
}
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;
}
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;
}