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);
}
Obj UNIX_Chdir( Obj self, Obj string )
{ int result;
ConvString( string );
result = chdir( (char*)CSTR_STRING(string) );
if (result == -1) {
fprintf( stderr, "UNIX_Chdir: %s\n", (char*)CSTR_STRING(string) );
perror("UNIX_Chdir");
}
return ( 0 == result ? True : False ) ;
}
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 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 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 FuncINTFLOOR_MACFLOAT( Obj self, Obj obj )
{
#if HAVE_TRUNC
Double f = trunc(VAL_MACFLOAT(obj));
#else
Double f = VAL_MACFLOAT(obj);
if (f >= 0.0)
f = floor(f);
else
f = -floor(-f);
#endif
if (fabs(f) < (Double) (1L<<NR_SMALL_INT_BITS))
return INTOBJ_INT((Int)f);
int str_len = (int) (log(fabs(f)) / log(16.0)) + 3;
Obj str = NEW_STRING(str_len);
char *s = CSTR_STRING(str), *p = s+str_len-1;
if (f < 0.0)
f = -f, s[0] = '-';
while (p > s || (p == s && s[0] != '-')) {
int d = (int) fmod(f,16.0);
*p-- = d < 10 ? '0'+d : 'a'+d-10;
f /= 16.0;
}
return FuncIntHexString(self,str);
}
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 Obj VIEWSTRING_MPD(Obj self, Obj f, Obj digits)
{
mp_prec_t prec = mpd_get_prec(GET_MPD(f));
Obj str = NEW_STRING(2*(prec*302/1000+10)+3);
int slen = 0, n;
TEST_IS_INTOBJ("STRING_MPD",digits);
n = INT_INTOBJ(digits);
if (n == 1) n = 2;
char *c = CSTR_STRING(str);
slen += PRINT_MPFR(c+slen, 0, n, GET_MPD(f)->re, GMP_RNDN);
Obj im = NEW_MPFR(prec);
mpfr_add(MPFR_OBJ(im), GET_MPD(f)->re, GET_MPD(f)->im, GMP_RNDN);
mpfr_sub(MPFR_OBJ(im), MPFR_OBJ(im), MPD_OBJ(f)->re, GMP_RNDN); /* round off small im */
if (!mpfr_zero_p(MPFR_OBJ(im))) {
if (mpfr_sgn(MPFR_OBJ(im)) < 0)
c[slen++] = '-';
else
c[slen++] = '+';
mpfr_abs (MPFR_OBJ(im), MPD_OBJ(f)->im, GMP_RNDN);
c[slen++] = 'I';
c[slen++] = '*';
slen += PRINT_MPFR(c+slen, 0, n, MPFR_OBJ(im), GMP_RNDN);
}
SET_LEN_STRING(str, slen);
SHRINK_STRING(str);
return str;
}
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);
}
/****************************************************************************
**
*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;
}
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;
}
Obj FuncWRITE_IOSTREAM( Obj self, Obj stream, Obj string, Obj len )
{
UInt pty = INT_INTOBJ(stream);
ConvString(string);
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
HandleChildStatusChanges(pty);
return INTOBJ_INT(WriteToPty(pty, CSTR_STRING(string), INT_INTOBJ(len)));
}
Obj UNIX_Hostname( Obj self )
{ char buf[100];
Obj host;
int res;
res = gethostname( buf, 100 );
if (res == -1) {
perror("UNIX_Hostname: ");
sprintf( buf, "<unknown name>"); }
host = NEW_STRING( strlen(buf) ); /* NEW_STRING() allows for extra '\0' */
strncat( CSTR_STRING(host), buf, strlen(buf) );
return host;
}
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 FuncREAD_IOSTREAM_NOWAIT(Obj self, Obj stream, Obj len)
{
Obj string;
UInt pty = INT_INTOBJ(stream);
Int ret;
string = NEW_STRING(INT_INTOBJ(len));
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
/* HandleChildStatusChanges(pty); Omit this to allow picking up "trailing" bytes*/
ret = ReadFromPty2(pty, CSTR_STRING(string), INT_INTOBJ(len), 0);
if (ret == -1)
return Fail;
SET_LEN_STRING(string, ret);
ResizeBag(string, SIZEBAG_STRINGLEN(ret));
return string;
}
static Obj STRING_MPD(Obj self, Obj f, Obj digits)
{
mp_prec_t prec = mpd_get_prec(GET_MPD(f));
Obj str = NEW_STRING(2*(prec*302/1000+10)+3);
int slen = 0, n;
TEST_IS_INTOBJ("STRING_MPD",digits);
n = INT_INTOBJ(digits);
if (n == 1) n = 2;
char *c = CSTR_STRING(str);
slen += PRINT_MPFR(c+slen, 0, n, GET_MPD(f)->re, GMP_RNDN);
c[slen++] = '+';
c[slen++] = 'I';
c[slen++] = '*';
slen += PRINT_MPFR(c+slen, 0, n, MPD_OBJ(f)->im, GMP_RNDN);
SET_LEN_STRING(str, slen);
SHRINK_STRING(str);
return str;
}
/****************************************************************************
**
*F RNamObj(<obj>) . . . . . . . . . . . convert an object to a record name
**
** 'RNamObj' returns the record name corresponding to the object <obj>,
** which currently must be a string or an integer.
*/
UInt RNamObj (
Obj obj )
{
/* convert integer object */
if ( IS_INTOBJ(obj) ) {
return RNamIntg( INT_INTOBJ(obj) );
}
/* convert string object (empty string may have type T_PLIST) */
else if ( IsStringConv(obj) && IS_STRING_REP(obj) ) {
return RNamName( CSTR_STRING(obj) );
}
/* otherwise fail */
else {
obj = ErrorReturnObj(
"Record: '<rec>.(<obj>)' <obj> must be a string or an integer",
0L, 0L,
"you can replace <obj> via 'return <obj>;'" );
return RNamObj( obj );
}
}
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;
}
//
// Returns a pointer to the
// contents of the GAP string object <string>
char * GAP_CSTR_STRING(Obj string)
{
return CSTR_STRING(string);
}
char * GAP_CSTR_STRING(Obj string)
{
if (!IS_STRING_REP(string))
return 0;
return CSTR_STRING(string);
}
